{-# LANGUAGE Rank2Types #-}
module Life.Main.Add
( lifeAdd
) where
import Colourista (errorMessage, infoMessage, warningMessage)
import Path (Abs, Dir, File, Path, Rel, parent, toFilePath, (</>))
import Path.IO (copyDirRecur, copyFile, doesDirExist, doesFileExist, ensureDir, getHomeDir,
makeRelative, resolveDir, resolveFile)
import Relude.Extra.Lens (Lens', (%~))
import Life.Configuration (LifeConfiguration, directoriesL, filesL, parseHomeLife, writeGlobalLife)
import Life.Core (LifePath (..), master)
import Life.Github (addToRepo, withSynced)
import Life.Main.Init (lifeInitQuestion)
import Life.Message (abortCmd)
import Life.Path (LifeExistence (..), relativeToHome, repoName, whatIsLife)
import qualified Data.Set as Set
lifeAdd :: LifePath -> IO ()
lifeAdd :: LifePath -> IO ()
lifeAdd lPath :: LifePath
lPath = IO LifeExistence
whatIsLife IO LifeExistence -> (LifeExistence -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Both _ _ -> Branch -> IO () -> IO ()
forall a. Branch -> IO a -> IO a
withSynced Branch
master IO ()
addingProcess
OnlyRepo _ -> Text -> Text -> IO ()
abortCmd "add" ".life file doesn't exist"
OnlyLife _ -> Text -> Text -> IO ()
abortCmd "add" "dotfiles/ directory doesn't exist"
NoLife -> Text -> IO () -> IO ()
lifeInitQuestion "add" IO ()
addingProcess
where
addingProcess :: IO ()
addingProcess :: IO ()
addingProcess = do
Path Abs Dir
homeDirPath <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getHomeDir
case LifePath
lPath of
(File path :: FilePath
path) -> do
Path Abs File
filePath <- Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
homeDirPath FilePath
path
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
filePath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Path Rel File
relativeFile <- Path Abs Dir -> Path Abs File -> IO (RelPath (Path Abs File))
forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
makeRelative Path Abs Dir
homeDirPath Path Abs File
filePath
Lens' LifeConfiguration (Set (Path Rel File))
-> (Path Rel File -> IO Bool)
-> (Path Abs File -> Path Abs File -> IO ())
-> Path Rel File
-> IO ()
forall t.
Lens' LifeConfiguration (Set (Path Rel t))
-> (Path Rel t -> IO Bool)
-> (Path Abs t -> Path Abs t -> IO ())
-> Path Rel t
-> IO ()
resolveConfiguration Lens' LifeConfiguration (Set (Path Rel File))
filesL Path Rel File -> IO Bool
checkEqualFiles Path Abs File -> Path Abs File -> IO ()
copyFileWithDir Path Rel File
relativeFile
(Dir path :: FilePath
path) -> do
Path Abs Dir
dirPath <- Path Abs Dir -> FilePath -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
resolveDir Path Abs Dir
homeDirPath FilePath
path
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs Dir -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
dirPath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Path Rel Dir
relativeDir <- Path Abs Dir -> Path Abs Dir -> IO (RelPath (Path Abs Dir))
forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
makeRelative Path Abs Dir
homeDirPath Path Abs Dir
dirPath
Lens' LifeConfiguration (Set (Path Rel Dir))
-> (Path Rel Dir -> IO Bool)
-> (Path Abs Dir -> Path Abs Dir -> IO ())
-> Path Rel Dir
-> IO ()
forall t.
Lens' LifeConfiguration (Set (Path Rel t))
-> (Path Rel t -> IO Bool)
-> (Path Abs t -> Path Abs t -> IO ())
-> Path Rel t
-> IO ()
resolveConfiguration Lens' LifeConfiguration (Set (Path Rel Dir))
directoriesL Path Rel Dir -> IO Bool
checkEqualDirs Path Abs Dir -> Path Abs Dir -> IO ()
forall (m :: * -> *) b0 b1.
(MonadIO m, MonadCatch m) =>
Path b0 Dir -> Path b1 Dir -> m ()
copyDirRecur Path Rel Dir
relativeDir
Text -> IO ()
errorMessage "The file/directory doesn't exist" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
resolveConfiguration
:: Lens' LifeConfiguration (Set (Path Rel t))
-> (Path Rel t -> IO Bool)
-> (Path Abs t -> Path Abs t -> IO ())
-> Path Rel t
-> IO ()
resolveConfiguration :: Lens' LifeConfiguration (Set (Path Rel t))
-> (Path Rel t -> IO Bool)
-> (Path Abs t -> Path Abs t -> IO ())
-> Path Rel t
-> IO ()
resolveConfiguration confLens :: Lens' LifeConfiguration (Set (Path Rel t))
confLens checkContent :: Path Rel t -> IO Bool
checkContent copyFun :: Path Abs t -> Path Abs t -> IO ()
copyFun path :: Path Rel t
path = do
LifeConfiguration
configuration <- IO LifeConfiguration
parseHomeLife
let newConfiguration :: LifeConfiguration
newConfiguration = LifeConfiguration
configuration LifeConfiguration
-> (LifeConfiguration -> LifeConfiguration) -> LifeConfiguration
forall a b. a -> (a -> b) -> b
& Lens' LifeConfiguration (Set (Path Rel t))
confLens Lens' LifeConfiguration (Set (Path Rel t))
-> (Set (Path Rel t) -> Set (Path Rel t))
-> LifeConfiguration
-> LifeConfiguration
forall s a. Lens' s a -> (a -> a) -> s -> s
%~ Path Rel t -> Set (Path Rel t) -> Set (Path Rel t)
forall a. Ord a => a -> Set a -> Set a
Set.insert Path Rel t
path
Bool
isSameAsInRepo <- Path Rel t -> IO Bool
checkContent Path Rel t
path
if Bool
isSameAsInRepo
then do
let pathText :: Text
pathText = FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel t -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel t
path
Text -> IO ()
infoMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Path " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " is already latest version in repository"
else do
LifeConfiguration -> IO ()
writeGlobalLife LifeConfiguration
newConfiguration
(Path Abs t -> Path Abs t -> IO ()) -> Path Rel t -> IO ()
forall t.
(Path Abs t -> Path Abs t -> IO ()) -> Path Rel t -> IO ()
addToRepo Path Abs t -> Path Abs t -> IO ()
copyFun Path Rel t
path
IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess
checkEqualFiles :: Path Rel File -> IO Bool
checkEqualFiles :: Path Rel File -> IO Bool
checkEqualFiles path :: Path Rel File
path = do
Path Abs File
homeFilePath <- Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel File
path
Path Abs File
repoFilePath <- Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome (Path Rel Dir
repoName Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
path)
Bool
isRepoFile <- Path Abs File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
repoFilePath
if Bool
isRepoFile
then do
LByteString
originContent <- FilePath -> IO LByteString
forall (m :: * -> *). MonadIO m => FilePath -> m LByteString
readFileLBS (FilePath -> IO LByteString) -> FilePath -> IO LByteString
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
homeFilePath
LByteString
repoContent <- FilePath -> IO LByteString
forall (m :: * -> *). MonadIO m => FilePath -> m LByteString
readFileLBS (FilePath -> IO LByteString) -> FilePath -> IO LByteString
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
repoFilePath
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ LByteString
originContent LByteString -> LByteString -> Bool
forall a. Eq a => a -> a -> Bool
== LByteString
repoContent
else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
checkEqualDirs :: Path Rel Dir -> IO Bool
checkEqualDirs :: Path Rel Dir -> IO Bool
checkEqualDirs _ = do
Text -> IO ()
warningMessage "TODO: check directories to be equal"
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
copyFileWithDir :: Path Abs File -> Path Abs File -> IO ()
copyFileWithDir :: Path Abs File -> Path Abs File -> IO ()
copyFileWithDir from :: Path Abs File
from to :: Path Abs File
to = Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
to) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path Abs File -> Path Abs File -> IO ()
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
copyFile Path Abs File
from Path Abs File
to