{-# LANGUAGE TemplateHaskell #-}
module Life.Main.Init
( lifeInit
, lifeInitQuestion
) where
import Path (mkRelFile)
import Path.IO (doesDirExist, doesFileExist)
import Life.Configuration (LifeConfiguration (..), parseHomeLife, renderLifeConfiguration,
singleFileConfig, writeGlobalLife)
import Life.Core (CopyDirection (..), Owner (..), Repo (..), master)
import Life.Github (copyLife, createRepository, insideRepo)
import Life.Message (abortCmd, chooseYesNo, infoMessage, promptNonEmpty, skipMessage,
successMessage, warningMessage)
import Life.Path (LifeExistence (..), createDirInHome, lifePath, relativeToHome, repoName,
whatIsLife)
import qualified Data.Set as Set
predefinedLifeConfig :: LifeConfiguration
predefinedLifeConfig :: LifeConfiguration
predefinedLifeConfig = LifeConfiguration
forall a. Monoid a => a
mempty
{ lifeConfigurationFiles :: Set (Path Rel File)
lifeConfigurationFiles = [Path Rel File] -> Set (Path Rel File)
forall a. Ord a => [a] -> Set a
Set.fromList
[ $(mkRelFile ".bash_profile")
, $(mkRelFile ".profile")
, $(mkRelFile ".vimrc")
, $(mkRelFile ".emacs")
, $(mkRelFile ".spacemacs")
, $(mkRelFile ".gitconfig")
, $(mkRelFile ".ghc/ghci.conf")
, $(mkRelFile ".stylish-haskell.yaml")
]
}
lifeInit :: Maybe Owner -> IO ()
lifeInit :: Maybe Owner -> IO ()
lifeInit owner :: Maybe Owner
owner = IO LifeExistence
whatIsLife IO LifeExistence -> (LifeExistence -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
NoLife -> IO LifeConfiguration
createLifeFile IO LifeConfiguration -> (LifeConfiguration -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LifeConfiguration -> IO ()
createDotfilesDir
OnlyLife _ -> IO LifeConfiguration
askCreateLife IO LifeConfiguration -> (LifeConfiguration -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LifeConfiguration -> IO ()
createDotfilesDir
OnlyRepo _ -> Text -> Text -> IO ()
abortCmd "init" "'~/dotfiles' directory already exist"
Both _ _ -> Text -> Text -> IO ()
abortCmd "init" "'~/.life' file and '~/.dotfiles' directory are already initialized"
where
askCreateLife :: IO LifeConfiguration
askCreateLife :: IO LifeConfiguration
askCreateLife = do
Text -> IO ()
warningMessage ".life file is already exist."
Bool
useIt <- Text -> IO Bool
chooseYesNo "Would you like to use it?"
if Bool
useIt then IO LifeConfiguration
parseHomeLife else IO LifeConfiguration
createLifeFile
createLifeFile :: IO LifeConfiguration
createLifeFile :: IO LifeConfiguration
createLifeFile = do
Text -> IO ()
infoMessage "Checking existence of some commonly used predefined files..."
(exist :: LifeConfiguration
exist, noExist :: LifeConfiguration
noExist) <- LifeConfiguration -> IO (LifeConfiguration, LifeConfiguration)
scanConfig LifeConfiguration
predefinedLifeConfig
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LifeConfiguration
noExist LifeConfiguration -> LifeConfiguration -> Bool
forall a. Eq a => a -> a -> Bool
== LifeConfiguration
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
infoMessage "The following files and directories weren't found; they won't be added to '~/.life' file:"
Text -> IO ()
skipMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> LifeConfiguration -> Text
renderLifeConfiguration Bool
False LifeConfiguration
noExist
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LifeConfiguration
exist LifeConfiguration -> LifeConfiguration -> Bool
forall a. Eq a => a -> a -> Bool
== LifeConfiguration
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
infoMessage "Found the following files and directories:"
Text -> IO ()
successMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> LifeConfiguration -> Text
renderLifeConfiguration Bool
False LifeConfiguration
exist
Bool
useDiscovered <- Text -> IO Bool
chooseYesNo "Would you like to add all discovered existing files and directories to .life configuration?"
let lifeConfig :: LifeConfiguration
lifeConfig = Path Rel File -> LifeConfiguration
singleFileConfig Path Rel File
lifePath LifeConfiguration -> LifeConfiguration -> LifeConfiguration
forall a. Semigroup a => a -> a -> a
<> (if Bool
useDiscovered then LifeConfiguration
exist else LifeConfiguration
forall a. Monoid a => a
mempty)
Text -> IO ()
infoMessage "Initializing global .life configuration file..."
LifeConfiguration -> IO ()
writeGlobalLife LifeConfiguration
lifeConfig
LifeConfiguration -> IO LifeConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure LifeConfiguration
lifeConfig
createDotfilesDir :: LifeConfiguration -> IO ()
createDotfilesDir :: LifeConfiguration -> IO ()
createDotfilesDir lifeConfig :: LifeConfiguration
lifeConfig = do
() () -> IO (Path Abs Dir) -> IO ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Path Rel Dir -> IO (Path Abs Dir)
createDirInHome Path Rel Dir
repoName
IO () -> IO ()
forall a. IO a -> IO a
insideRepo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
CopyDirection -> LifeConfiguration -> IO ()
copyLife CopyDirection
FromHomeToRepo LifeConfiguration
lifeConfig
Maybe Owner -> Repo -> IO ()
createRepository Maybe Owner
owner (Text -> Repo
Repo "dotfiles")
scanConfig :: LifeConfiguration -> IO (LifeConfiguration, LifeConfiguration)
scanConfig :: LifeConfiguration -> IO (LifeConfiguration, LifeConfiguration)
scanConfig LifeConfiguration{..} = do
(existingFiles :: [Path Rel File]
existingFiles, nonExistingFiles :: [Path Rel File]
nonExistingFiles) <- (Path Rel File -> IO Bool)
-> Set (Path Rel File) -> IO ([Path Rel File], [Path Rel File])
forall (f :: * -> *) (m :: * -> *) a.
(Monad m, Foldable f) =>
(a -> m Bool) -> f a -> m ([a], [a])
partitionM (Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome (Path Rel File -> IO (Path Abs File))
-> (Path Abs File -> IO Bool) -> Path Rel File -> IO Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Path Abs File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist) Set (Path Rel File)
lifeConfigurationFiles
(existingDirs :: [Path Rel Dir]
existingDirs, nonExistingDirs :: [Path Rel Dir]
nonExistingDirs) <- (Path Rel Dir -> IO Bool)
-> Set (Path Rel Dir) -> IO ([Path Rel Dir], [Path Rel Dir])
forall (f :: * -> *) (m :: * -> *) a.
(Monad m, Foldable f) =>
(a -> m Bool) -> f a -> m ([a], [a])
partitionM (Path Rel Dir -> IO (Path Abs Dir)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome (Path Rel Dir -> IO (Path Abs Dir))
-> (Path Abs Dir -> IO Bool) -> Path Rel Dir -> IO Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Path Abs Dir -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist) Set (Path Rel Dir)
lifeConfigurationDirectories
(LifeConfiguration, LifeConfiguration)
-> IO (LifeConfiguration, LifeConfiguration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration ([Path Rel File] -> Set (Path Rel File)
forall a. Ord a => [a] -> Set a
Set.fromList [Path Rel File]
existingFiles) ([Path Rel Dir] -> Set (Path Rel Dir)
forall a. Ord a => [a] -> Set a
Set.fromList [Path Rel Dir]
existingDirs) (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)
, Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration ([Path Rel File] -> Set (Path Rel File)
forall a. Ord a => [a] -> Set a
Set.fromList [Path Rel File]
nonExistingFiles) ([Path Rel Dir] -> Set (Path Rel Dir)
forall a. Ord a => [a] -> Set a
Set.fromList [Path Rel Dir]
nonExistingDirs) (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)
)
partitionM :: forall f m a . (Monad m, Foldable f) => (a -> m Bool) -> f a -> m ([a], [a])
partitionM :: (a -> m Bool) -> f a -> m ([a], [a])
partitionM check :: a -> m Bool
check = (([a], [a]) -> a -> m ([a], [a]))
-> ([a], [a]) -> f a -> m ([a], [a])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ([a], [a]) -> a -> m ([a], [a])
partitionAction ([], [])
where
partitionAction :: ([a], [a]) -> a -> m ([a], [a])
partitionAction :: ([a], [a]) -> a -> m ([a], [a])
partitionAction (ifTrue :: [a]
ifTrue, ifFalse :: [a]
ifFalse) a :: a
a = a -> m Bool
check a
a m Bool -> (Bool -> m ([a], [a])) -> m ([a], [a])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
True -> ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ifTrue, [a]
ifFalse)
False -> ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
ifTrue, a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ifFalse)
lifeInitQuestion :: Text
-> IO ()
-> IO ()
lifeInitQuestion :: Text -> IO () -> IO ()
lifeInitQuestion cmd :: Text
cmd process :: IO ()
process = do
Text -> IO ()
warningMessage ".life file and dotfiles/ do not exist"
Bool
toInit <- Text -> IO Bool
chooseYesNo "Would you like to proceed initialization process?"
if Bool
toInit then do
Text -> IO ()
infoMessage "Initialization process starts.."
Text -> IO ()
skipMessage "Insert your GitHub username:"
Text
owner <- IO Text
promptNonEmpty
Maybe Owner -> IO ()
lifeInit (Maybe Owner -> IO ()) -> Maybe Owner -> IO ()
forall a b. (a -> b) -> a -> b
$ Owner -> Maybe Owner
forall a. a -> Maybe a
Just (Owner -> Maybe Owner) -> Owner -> Maybe Owner
forall a b. (a -> b) -> a -> b
$ Text -> Owner
Owner Text
owner
IO ()
process
else Text -> Text -> IO ()
abortCmd Text
cmd "'~/.life' file is not initialized"