module Life.Configuration
( LifeConfiguration (..)
, singleDirConfig
, singleFileConfig
, defaultLifeConfig
, lifeConfigMinus
, filesL
, directoriesL
, branchL
, parseHomeLife
, parseRepoLife
, parseLifeConfiguration
, renderLifeConfiguration
, writeGlobalLife
) where
import Control.Monad.Catch (MonadThrow (..))
import Path (Dir, File, Path, Rel, fromAbsFile, parseRelDir, parseRelFile, toFilePath, (</>))
import Relude.Extra.Lens (Lens', lens, (.~), (^.))
import Toml (TomlCodec, (.=))
import Life.Core (Branch (..), master)
import Life.Path (lifePath, relativeToHome, repoName)
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Text.Show as Show
import qualified Toml
data LifeConfiguration = LifeConfiguration
{ LifeConfiguration -> Set (Path Rel File)
lifeConfigurationFiles :: !(Set (Path Rel File))
, LifeConfiguration -> Set (Path Rel Dir)
lifeConfigurationDirectories :: !(Set (Path Rel Dir))
, LifeConfiguration -> Last Branch
lifeConfigurationBranch :: !(Last Branch)
} deriving stock (Int -> LifeConfiguration -> ShowS
[LifeConfiguration] -> ShowS
LifeConfiguration -> String
(Int -> LifeConfiguration -> ShowS)
-> (LifeConfiguration -> String)
-> ([LifeConfiguration] -> ShowS)
-> Show LifeConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LifeConfiguration] -> ShowS
$cshowList :: [LifeConfiguration] -> ShowS
show :: LifeConfiguration -> String
$cshow :: LifeConfiguration -> String
showsPrec :: Int -> LifeConfiguration -> ShowS
$cshowsPrec :: Int -> LifeConfiguration -> ShowS
Show, LifeConfiguration -> LifeConfiguration -> Bool
(LifeConfiguration -> LifeConfiguration -> Bool)
-> (LifeConfiguration -> LifeConfiguration -> Bool)
-> Eq LifeConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LifeConfiguration -> LifeConfiguration -> Bool
$c/= :: LifeConfiguration -> LifeConfiguration -> Bool
== :: LifeConfiguration -> LifeConfiguration -> Bool
$c== :: LifeConfiguration -> LifeConfiguration -> Bool
Eq)
filesL :: Lens' LifeConfiguration (Set (Path Rel File))
filesL :: (Set (Path Rel File) -> f (Set (Path Rel File)))
-> LifeConfiguration -> f LifeConfiguration
filesL = (LifeConfiguration -> Set (Path Rel File))
-> (LifeConfiguration -> Set (Path Rel File) -> LifeConfiguration)
-> Lens' LifeConfiguration (Set (Path Rel File))
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
LifeConfiguration -> Set (Path Rel File)
lifeConfigurationFiles
(\config :: LifeConfiguration
config newFiles :: Set (Path Rel File)
newFiles -> LifeConfiguration
config {lifeConfigurationFiles :: Set (Path Rel File)
lifeConfigurationFiles = Set (Path Rel File)
newFiles})
directoriesL :: Lens' LifeConfiguration (Set (Path Rel Dir))
directoriesL :: (Set (Path Rel Dir) -> f (Set (Path Rel Dir)))
-> LifeConfiguration -> f LifeConfiguration
directoriesL = (LifeConfiguration -> Set (Path Rel Dir))
-> (LifeConfiguration -> Set (Path Rel Dir) -> LifeConfiguration)
-> Lens' LifeConfiguration (Set (Path Rel Dir))
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
LifeConfiguration -> Set (Path Rel Dir)
lifeConfigurationDirectories
(\config :: LifeConfiguration
config newDirs :: Set (Path Rel Dir)
newDirs -> LifeConfiguration
config {lifeConfigurationDirectories :: Set (Path Rel Dir)
lifeConfigurationDirectories = Set (Path Rel Dir)
newDirs})
branchL :: Lens' LifeConfiguration (Last Branch)
branchL :: (Last Branch -> f (Last Branch))
-> LifeConfiguration -> f LifeConfiguration
branchL = (LifeConfiguration -> Last Branch)
-> (LifeConfiguration -> Last Branch -> LifeConfiguration)
-> Lens' LifeConfiguration (Last Branch)
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens
LifeConfiguration -> Last Branch
lifeConfigurationBranch
(\config :: LifeConfiguration
config newBr :: Last Branch
newBr -> LifeConfiguration
config {lifeConfigurationBranch :: Last Branch
lifeConfigurationBranch = Last Branch
newBr})
instance Semigroup LifeConfiguration where
life1 :: LifeConfiguration
life1 <> :: LifeConfiguration -> LifeConfiguration -> LifeConfiguration
<> life2 :: LifeConfiguration
life2 = $WLifeConfiguration :: Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration
{ lifeConfigurationFiles :: Set (Path Rel File)
lifeConfigurationFiles = (LifeConfiguration
life1 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) Set (Path Rel File) -> Set (Path Rel File) -> Set (Path Rel File)
forall a. Semigroup a => a -> a -> a
<> (LifeConfiguration
life2 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)
, lifeConfigurationDirectories :: Set (Path Rel Dir)
lifeConfigurationDirectories = (LifeConfiguration
life1 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) Set (Path Rel Dir) -> Set (Path Rel Dir) -> Set (Path Rel Dir)
forall a. Semigroup a => a -> a -> a
<> (LifeConfiguration
life2 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)
, lifeConfigurationBranch :: Last Branch
lifeConfigurationBranch = (LifeConfiguration
life1 LifeConfiguration
-> Lens' LifeConfiguration (Last Branch) -> Last Branch
forall s a. s -> Lens' s a -> a
^. Lens' LifeConfiguration (Last Branch)
branchL) Last Branch -> Last Branch -> Last Branch
forall a. Semigroup a => a -> a -> a
<> (LifeConfiguration
life2 LifeConfiguration
-> Lens' LifeConfiguration (Last Branch) -> Last Branch
forall s a. s -> Lens' s a -> a
^. Lens' LifeConfiguration (Last Branch)
branchL)
}
instance Monoid LifeConfiguration where
mempty :: LifeConfiguration
mempty = Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration Set (Path Rel File)
forall a. Monoid a => a
mempty Set (Path Rel Dir)
forall a. Monoid a => a
mempty Last Branch
forall a. Monoid a => a
mempty
mappend :: LifeConfiguration -> LifeConfiguration -> LifeConfiguration
mappend = LifeConfiguration -> LifeConfiguration -> LifeConfiguration
forall a. Semigroup a => a -> a -> a
(<>)
defaultLifeConfig :: LifeConfiguration
defaultLifeConfig :: LifeConfiguration
defaultLifeConfig = $WLifeConfiguration :: Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration
{ lifeConfigurationFiles :: Set (Path Rel File)
lifeConfigurationFiles = Set (Path Rel File)
forall a. Monoid a => a
mempty
, lifeConfigurationDirectories :: Set (Path Rel Dir)
lifeConfigurationDirectories = Set (Path Rel Dir)
forall a. Monoid a => a
mempty
, lifeConfigurationBranch :: Last Branch
lifeConfigurationBranch = 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
}
singleFileConfig :: Path Rel File -> LifeConfiguration
singleFileConfig :: Path Rel File -> LifeConfiguration
singleFileConfig file :: Path Rel File
file = LifeConfiguration
forall a. Monoid a => a
mempty LifeConfiguration
-> (LifeConfiguration -> LifeConfiguration) -> LifeConfiguration
forall a b. a -> (a -> b) -> b
& Lens' LifeConfiguration (Set (Path Rel File))
filesL Lens' LifeConfiguration (Set (Path Rel File))
-> Set (Path Rel File) -> LifeConfiguration -> LifeConfiguration
forall s a. Lens' s a -> a -> s -> s
.~ OneItem (Set (Path Rel File)) -> Set (Path Rel File)
forall x. One x => OneItem x -> x
one Path Rel File
OneItem (Set (Path Rel File))
file
singleDirConfig :: Path Rel Dir -> LifeConfiguration
singleDirConfig :: Path Rel Dir -> LifeConfiguration
singleDirConfig dir :: Path Rel Dir
dir = LifeConfiguration
forall a. Monoid a => a
mempty LifeConfiguration
-> (LifeConfiguration -> LifeConfiguration) -> LifeConfiguration
forall a b. a -> (a -> b) -> b
& Lens' LifeConfiguration (Set (Path Rel Dir))
directoriesL Lens' LifeConfiguration (Set (Path Rel Dir))
-> Set (Path Rel Dir) -> LifeConfiguration -> LifeConfiguration
forall s a. Lens' s a -> a -> s -> s
.~ OneItem (Set (Path Rel Dir)) -> Set (Path Rel Dir)
forall x. One x => OneItem x -> x
one Path Rel Dir
OneItem (Set (Path Rel Dir))
dir
lifeConfigMinus
:: LifeConfiguration
-> LifeConfiguration
-> LifeConfiguration
lifeConfigMinus :: LifeConfiguration -> LifeConfiguration -> LifeConfiguration
lifeConfigMinus dotfiles :: LifeConfiguration
dotfiles global :: LifeConfiguration
global = Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration
(Set (Path Rel File) -> Set (Path Rel File) -> Set (Path Rel File)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (LifeConfiguration
dotfiles 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) (LifeConfiguration
global 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))
(Set (Path Rel Dir) -> Set (Path Rel Dir) -> Set (Path Rel Dir)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (LifeConfiguration
dotfiles 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) (LifeConfiguration
global 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))
(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)
data CorpseConfiguration = CorpseConfiguration
{ CorpseConfiguration -> [String]
corpseFiles :: [FilePath]
, CorpseConfiguration -> [String]
corpseDirectories :: [FilePath]
}
corpseConfiguationT :: TomlCodec CorpseConfiguration
corpseConfiguationT :: TomlCodec CorpseConfiguration
corpseConfiguationT = [String] -> [String] -> CorpseConfiguration
CorpseConfiguration
([String] -> [String] -> CorpseConfiguration)
-> Codec Env St CorpseConfiguration [String]
-> Codec
Env St CorpseConfiguration ([String] -> CorpseConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlBiMap String AnyValue -> Key -> TomlCodec [String]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec [a]
Toml.arrayOf TomlBiMap String AnyValue
Toml._String "files" TomlCodec [String]
-> (CorpseConfiguration -> [String])
-> Codec Env St CorpseConfiguration [String]
forall (r :: * -> *) (w :: * -> *) field a object.
Codec r w field a -> (object -> field) -> Codec r w object a
.= CorpseConfiguration -> [String]
corpseFiles
Codec Env St CorpseConfiguration ([String] -> CorpseConfiguration)
-> Codec Env St CorpseConfiguration [String]
-> TomlCodec CorpseConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlBiMap String AnyValue -> Key -> TomlCodec [String]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec [a]
Toml.arrayOf TomlBiMap String AnyValue
Toml._String "directories" TomlCodec [String]
-> (CorpseConfiguration -> [String])
-> Codec Env St CorpseConfiguration [String]
forall (r :: * -> *) (w :: * -> *) field a object.
Codec r w field a -> (object -> field) -> Codec r w object a
.= CorpseConfiguration -> [String]
corpseDirectories
resurrect :: MonadThrow m => CorpseConfiguration -> m LifeConfiguration
resurrect :: CorpseConfiguration -> m LifeConfiguration
resurrect CorpseConfiguration{..} = do
[Path Rel File]
filePaths <- (String -> m (Path Rel File)) -> [String] -> m [Path Rel File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile [String]
corpseFiles
[Path Rel Dir]
dirPaths <- (String -> m (Path Rel Dir)) -> [String] -> m [Path Rel Dir]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir [String]
corpseDirectories
LifeConfiguration -> m LifeConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LifeConfiguration -> m LifeConfiguration)
-> LifeConfiguration -> m LifeConfiguration
forall a b. (a -> b) -> a -> b
$ $WLifeConfiguration :: Set (Path Rel File)
-> Set (Path Rel Dir) -> Last Branch -> LifeConfiguration
LifeConfiguration
{ lifeConfigurationFiles :: Set (Path Rel File)
lifeConfigurationFiles = [Path Rel File] -> Set (Path Rel File)
forall a. Ord a => [a] -> Set a
Set.fromList [Path Rel File]
filePaths
, lifeConfigurationDirectories :: Set (Path Rel Dir)
lifeConfigurationDirectories = [Path Rel Dir] -> Set (Path Rel Dir)
forall a. Ord a => [a] -> Set a
Set.fromList [Path Rel Dir]
dirPaths
, lifeConfigurationBranch :: Last Branch
lifeConfigurationBranch = Maybe Branch -> Last Branch
forall a. Maybe a -> Last a
Last (Branch -> Maybe Branch
forall a. a -> Maybe a
Just Branch
master)
}
renderLifeConfiguration :: Bool
-> LifeConfiguration
-> Text
renderLifeConfiguration :: Bool -> LifeConfiguration -> Text
renderLifeConfiguration printIfEmpty :: Bool
printIfEmpty LifeConfiguration{..} = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Text -> Set (Path Rel Dir) -> Maybe Text
forall b t. Text -> Set (Path b t) -> Maybe Text
render "directories" Set (Path Rel Dir)
lifeConfigurationDirectories)
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "\n" ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Text -> Set (Path Rel File) -> Maybe Text
forall b t. Text -> Set (Path b t) -> Maybe Text
render "files" Set (Path Rel File)
lifeConfigurationFiles)
where
render :: Text -> Set (Path b t) -> Maybe Text
render :: Text -> Set (Path b t) -> Maybe Text
render key :: Text
key paths :: Set (Path b t)
paths = do
let prefix :: Text
prefix = Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " = "
let array :: Text
array = [Text] -> Text
renderStringArray ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Path b t -> Text) -> [Path b t] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Path b t -> Text
forall b a. (Show a, IsString b) => a -> b
show ([Path b t] -> [Text]) -> [Path b t] -> [Text]
forall a b. (a -> b) -> a -> b
$ Set (Path b t) -> [Path b t]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (Path b t)
paths
if Bool -> Bool
not Bool
printIfEmpty Bool -> Bool -> Bool
&& Set (Path b t) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (Path b t)
paths
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
array
renderStringArray :: [Text] -> Text
renderStringArray :: [Text] -> Text
renderStringArray = \case
[] -> "[]"
[x :: Text
x] -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
l :: [Text]
l -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ "\n [ "
, Text -> [Text] -> Text
T.intercalate "\n , " [Text]
l
, "\n ]"
]
writeGlobalLife :: LifeConfiguration -> IO ()
writeGlobalLife :: LifeConfiguration -> IO ()
writeGlobalLife config :: LifeConfiguration
config = do
Path Abs File
lifeFilePath <- Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel File
lifePath
String -> Text -> IO ()
forall (m :: * -> *). MonadIO m => String -> Text -> m ()
writeFileText (Path Abs File -> String
fromAbsFile Path Abs File
lifeFilePath) (Bool -> LifeConfiguration -> Text
renderLifeConfiguration Bool
True LifeConfiguration
config)
parseLifeConfiguration :: MonadThrow m => Text -> m LifeConfiguration
parseLifeConfiguration :: Text -> m LifeConfiguration
parseLifeConfiguration tomlText :: Text
tomlText = case TomlCodec CorpseConfiguration
-> Text -> Either DecodeException CorpseConfiguration
forall a. TomlCodec a -> Text -> Either DecodeException a
Toml.decode TomlCodec CorpseConfiguration
corpseConfiguationT Text
tomlText of
Left err :: DecodeException
err -> LoadTomlException -> m LifeConfiguration
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (LoadTomlException -> m LifeConfiguration)
-> LoadTomlException -> m LifeConfiguration
forall a b. (a -> b) -> a -> b
$ String -> Text -> LoadTomlException
LoadTomlException (Path Rel File -> String
forall b t. Path b t -> String
toFilePath Path Rel File
lifePath) (Text -> LoadTomlException) -> Text -> LoadTomlException
forall a b. (a -> b) -> a -> b
$ DecodeException -> Text
Toml.prettyException DecodeException
err
Right cfg :: CorpseConfiguration
cfg -> CorpseConfiguration -> m LifeConfiguration
forall (m :: * -> *).
MonadThrow m =>
CorpseConfiguration -> m LifeConfiguration
resurrect CorpseConfiguration
cfg
parseLife :: Path Rel File -> IO LifeConfiguration
parseLife :: Path Rel File -> IO LifeConfiguration
parseLife path :: Path Rel File
path = Path Rel File -> IO (Path Abs File)
forall (m :: * -> *) t. MonadIO m => Path Rel t -> m (Path Abs t)
relativeToHome Path Rel File
path
IO (Path Abs File) -> (Path Abs File -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO Text
forall (m :: * -> *). MonadIO m => String -> m Text
readFileText (String -> IO Text)
-> (Path Abs File -> String) -> Path Abs File -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
fromAbsFile
IO Text -> (Text -> IO LifeConfiguration) -> IO LifeConfiguration
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO LifeConfiguration
forall (m :: * -> *). MonadThrow m => Text -> m LifeConfiguration
parseLifeConfiguration
parseHomeLife :: IO LifeConfiguration
parseHomeLife :: IO LifeConfiguration
parseHomeLife = Path Rel File -> IO LifeConfiguration
parseLife Path Rel File
lifePath
parseRepoLife :: IO LifeConfiguration
parseRepoLife :: IO LifeConfiguration
parseRepoLife = Path Rel File -> IO LifeConfiguration
parseLife (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
lifePath)
data LoadTomlException = LoadTomlException FilePath Text
instance Show.Show LoadTomlException where
show :: LoadTomlException -> String
show (LoadTomlException filePath :: String
filePath msg :: Text
msg) = "Couldnt parse file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filePath String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
msg
instance Exception LoadTomlException