module Life.Main.Push
( lifePush
) where
import Path (Abs, Path, Rel, toFilePath, (</>))
import Path.IO (doesDirExist, doesFileExist, removeDirRecur, removeFile)
import Relude.Extra.Lens ((^.))
import Validation (Validation (..))
import Life.Configuration (LifeConfiguration (..), directoriesL, filesL, lifeConfigMinus,
parseHomeLife, parseRepoLife)
import Life.Core (CommitMsg (..), master)
import Life.Github (updateDotfilesRepo, withSynced)
import Life.Main.Init (lifeInitQuestion)
import Life.Message (abortCmd)
import Life.Path (LifeExistence (..), relativeToHome, repoName, whatIsLife)
import qualified Data.Set as Set
import qualified Data.Text as Text
lifePush :: IO ()
lifePush :: IO ()
lifePush = IO LifeExistence
whatIsLife IO LifeExistence -> (LifeExistence -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
OnlyRepo _ -> Text -> Text -> IO ()
abortCmd "push" ".life file doesn't exist"
OnlyLife _ -> Text -> Text -> IO ()
abortCmd "push" "dotfiles file doesn't exist"
NoLife -> Text -> IO () -> IO ()
lifeInitQuestion "push" IO ()
pushProcess
Both _ _ -> Branch -> IO () -> IO ()
forall a. Branch -> IO a -> IO a
withSynced Branch
master IO ()
pushProcess
where
pushProcess :: IO ()
pushProcess :: IO ()
pushProcess = do
LifeConfiguration
globalConf <- IO LifeConfiguration
parseHomeLife
LifeConfiguration -> IO (Validation [Text] LifeConfiguration)
checkLife LifeConfiguration
globalConf IO (Validation [Text] LifeConfiguration)
-> (Validation [Text] LifeConfiguration -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Failure msgs :: [Text]
msgs -> Text -> Text -> IO ()
abortCmd "push" (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
"Following files/directories are missing:\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate "\n" [Text]
msgs
Success _ -> do
LifeConfiguration
repoConf <- IO LifeConfiguration
parseRepoLife
let removeConfig :: LifeConfiguration
removeConfig = LifeConfiguration -> LifeConfiguration -> LifeConfiguration
lifeConfigMinus LifeConfiguration
repoConf LifeConfiguration
globalConf
LifeConfiguration -> IO ()
removeAll LifeConfiguration
removeConfig
CommitMsg -> LifeConfiguration -> IO ()
updateDotfilesRepo (Text -> CommitMsg
CommitMsg "Push updates") LifeConfiguration
globalConf
checkLife :: LifeConfiguration -> IO (Validation [Text] LifeConfiguration)
checkLife :: LifeConfiguration -> IO (Validation [Text] LifeConfiguration)
checkLife lf :: LifeConfiguration
lf = do
[(Path Rel File, Bool)]
eFiles <- (Path Rel File -> IO (Path Rel File, Bool))
-> [Path Rel File] -> IO [(Path Rel File, Bool)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Path Abs File -> IO Bool)
-> Path Rel File -> IO (Path Rel File, Bool)
forall f.
(Path Abs f -> IO Bool) -> Path Rel f -> IO (Path Rel f, Bool)
withExist Path Abs File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist) ([Path Rel File] -> IO [(Path Rel File, Bool)])
-> [Path Rel File] -> IO [(Path Rel File, Bool)]
forall a b. (a -> b) -> a -> b
$ Set (Path Rel File) -> [Path Rel File]
forall a. Set a -> [a]
Set.toList (LifeConfiguration
lf LifeConfiguration
-> Lens' LifeConfiguration (Set (Path Rel File))
-> Set (Path Rel File)
forall s a. s -> Lens' s a -> a
^. Lens' LifeConfiguration (Set (Path Rel File))
filesL)
[(Path Rel Dir, Bool)]
eDirs <- (Path Rel Dir -> IO (Path Rel Dir, Bool))
-> [Path Rel Dir] -> IO [(Path Rel Dir, Bool)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Path Abs Dir -> IO Bool)
-> Path Rel Dir -> IO (Path Rel Dir, Bool)
forall f.
(Path Abs f -> IO Bool) -> Path Rel f -> IO (Path Rel f, Bool)
withExist Path Abs Dir -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist) ([Path Rel Dir] -> IO [(Path Rel Dir, Bool)])
-> [Path Rel Dir] -> IO [(Path Rel Dir, Bool)]
forall a b. (a -> b) -> a -> b
$ Set (Path Rel Dir) -> [Path Rel Dir]
forall a. Set a -> [a]
Set.toList (LifeConfiguration
lf LifeConfiguration
-> Lens' LifeConfiguration (Set (Path Rel Dir))
-> Set (Path Rel Dir)
forall s a. s -> Lens' s a -> a
^. Lens' LifeConfiguration (Set (Path Rel Dir))
directoriesL)
Validation [Text] LifeConfiguration
-> IO (Validation [Text] LifeConfiguration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Validation [Text] LifeConfiguration
-> IO (Validation [Text] LifeConfiguration))
-> Validation [Text] LifeConfiguration
-> IO (Validation [Text] LifeConfiguration)
forall a b. (a -> b) -> a -> b
$ Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration
(Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration)
-> Validation [Text] (Set (Path Rel File))
-> Validation
[Text] (Set (Path Rel Dir) -> Last Branch -> LifeConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Path Rel File, Bool)] -> Validation [Text] (Set (Path Rel File))
forall f.
[(Path Rel f, Bool)] -> Validation [Text] (Set (Path Rel f))
checkPaths [(Path Rel File, Bool)]
eFiles
Validation
[Text] (Set (Path Rel Dir) -> Last Branch -> LifeConfiguration)
-> Validation [Text] (Set (Path Rel Dir))
-> Validation [Text] (Last Branch -> LifeConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Path Rel Dir, Bool)] -> Validation [Text] (Set (Path Rel Dir))
forall f.
[(Path Rel f, Bool)] -> Validation [Text] (Set (Path Rel f))
checkPaths [(Path Rel Dir, Bool)]
eDirs
Validation [Text] (Last Branch -> LifeConfiguration)
-> Validation [Text] (Last Branch)
-> Validation [Text] LifeConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Last Branch -> Validation [Text] (Last Branch)
forall e a. a -> Validation e a
Success (Maybe Branch -> Last Branch
forall a. Maybe a -> Last a
Last (Maybe Branch -> Last Branch) -> Maybe Branch -> Last Branch
forall a b. (a -> b) -> a -> b
$ Branch -> Maybe Branch
forall a. a -> Maybe a
Just Branch
master)
where
withExist :: (Path Abs f -> IO Bool) -> Path Rel f -> IO (Path Rel f, Bool)
withExist :: (Path Abs f -> IO Bool) -> Path Rel f -> IO (Path Rel f, Bool)
withExist doesExist :: Path Abs f -> IO Bool
doesExist path :: Path Rel f
path = (Path Rel f
path,) (Bool -> (Path Rel f, Bool)) -> IO Bool -> IO (Path Rel f, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Rel f -> IO (Path Abs f)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel f
path IO (Path Abs f) -> (Path Abs f -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs f -> IO Bool
doesExist)
checkPaths :: [(Path Rel f, Bool)] -> Validation [Text] (Set (Path Rel f))
checkPaths :: [(Path Rel f, Bool)] -> Validation [Text] (Set (Path Rel f))
checkPaths = ([Path Rel f] -> Set (Path Rel f))
-> Validation [Text] [Path Rel f]
-> Validation [Text] (Set (Path Rel f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Path Rel f] -> Set (Path Rel f)
forall a. Ord a => [a] -> Set a
Set.fromList (Validation [Text] [Path Rel f]
-> Validation [Text] (Set (Path Rel f)))
-> ([(Path Rel f, Bool)] -> Validation [Text] [Path Rel f])
-> [(Path Rel f, Bool)]
-> Validation [Text] (Set (Path Rel f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path Rel f, Bool) -> Validation [Text] (Path Rel f))
-> [(Path Rel f, Bool)] -> Validation [Text] [Path Rel f]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Path Rel f, Bool) -> Validation [Text] (Path Rel f)
forall t. (Path Rel t, Bool) -> Validation [Text] (Path Rel t)
checkPath
checkPath :: (Path Rel t, Bool) -> Validation [Text] (Path Rel t)
checkPath :: (Path Rel t, Bool) -> Validation [Text] (Path Rel t)
checkPath (f :: Path Rel t
f, is :: Bool
is) = if Bool
is then Path Rel t -> Validation [Text] (Path Rel t)
forall e a. a -> Validation e a
Success Path Rel t
f else [Text] -> Validation [Text] (Path Rel t)
forall e a. e -> Validation e a
Failure [FilePath -> Text
forall a. ToText a => a -> Text
toText (Path Rel t -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel t
f)]
removeAll :: LifeConfiguration -> IO ()
removeAll :: LifeConfiguration -> IO ()
removeAll conf :: LifeConfiguration
conf = do
Set (Path Rel File) -> (Path Rel File -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (LifeConfiguration
conf LifeConfiguration
-> Lens' LifeConfiguration (Set (Path Rel File))
-> Set (Path Rel File)
forall s a. s -> Lens' s a -> a
^. Lens' LifeConfiguration (Set (Path Rel File))
filesL) ((Path Rel File -> IO ()) -> IO ())
-> (Path Rel File -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \f :: Path Rel File
f ->
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
f) IO (Path Abs File) -> (Path Abs File -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs File -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile
Set (Path Rel Dir) -> (Path Rel Dir -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (LifeConfiguration
conf LifeConfiguration
-> Lens' LifeConfiguration (Set (Path Rel Dir))
-> Set (Path Rel Dir)
forall s a. s -> Lens' s a -> a
^. Lens' LifeConfiguration (Set (Path Rel Dir))
directoriesL) ((Path Rel Dir -> IO ()) -> IO ())
-> (Path Rel Dir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \d :: Path Rel Dir
d ->
Path Rel Dir -> IO (Path Abs Dir)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome (Path Rel Dir
repoName Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
d) IO (Path Abs Dir) -> (Path Abs Dir -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur