{-# options_haddock prune #-}
module Helic.Config.File where
import Data.Yaml (decodeFileEither, prettyPrintParseException)
import Exon (exon)
import Path (Abs, File, Path, absfile, relfile, toFilePath, (</>))
import Path.IO (XdgDirectory (XdgConfig), doesFileExist, getXdgDir)
import qualified Polysemy.Log as Log
import Helic.Data.Config (Config)
parseFileConfig ::
Members [Log, Error Text, Embed IO] r =>
Path Abs File ->
Sem r Config
parseFileConfig :: forall (r :: EffectRow).
Members '[Log, Error Text, Embed IO] r =>
Path Abs File -> Sem r Config
parseFileConfig (forall b t. Path b t -> FilePath
toFilePath -> FilePath
path) = do
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|Reading config file #{toText path}|]
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ParseException -> Text
formatError (forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
path)
where
formatError :: ParseException -> Text
formatError ParseException
exc =
forall a. ToText a => a -> Text
toText [exon|invalid config file: #{prettyPrintParseException exc}|]
findConfigPath ::
Members [Log, Error Text, Embed IO] r =>
Maybe (Path Abs File) ->
Sem r (Maybe (Path Abs File))
findConfigPath :: forall (r :: EffectRow).
Members '[Log, Error Text, Embed IO] r =>
Maybe (Path Abs File) -> Sem r (Maybe (Path Abs File))
findConfigPath = \case
Just Path Abs File
f ->
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Path Abs File
f)
Bool
False -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw [exon|config file doesn't exist: #{toText (toFilePath f)}|]
Maybe (Path Abs File)
Nothing -> do
Path Abs Dir
xdgConf <- forall (m :: * -> *).
MonadIO m =>
XdgDirectory -> Maybe (Path Rel Dir) -> m (Path Abs Dir)
getXdgDir XdgDirectory
XdgConfig forall a. Maybe a
Nothing
let
xdgFile :: Path Abs File
xdgFile =
Path Abs Dir
xdgConf forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|helic.yaml|]
etcFile :: Path Abs File
etcFile =
[absfile|/etc/helic.yaml|]
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
xdgFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Path Abs File
xdgFile)
Bool
False ->
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
etcFile forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Bool
True -> forall a. a -> Maybe a
Just Path Abs File
etcFile
Bool
False -> forall a. Maybe a
Nothing
findFileConfig ::
Members [Log, Error Text, Embed IO] r =>
Maybe (Path Abs File) ->
Sem r Config
findFileConfig :: forall (r :: EffectRow).
Members '[Log, Error Text, Embed IO] r =>
Maybe (Path Abs File) -> Sem r Config
findFileConfig Maybe (Path Abs File)
cliFile = do
Maybe (Path Abs File)
f <- forall (r :: EffectRow).
Members '[Log, Error Text, Embed IO] r =>
Maybe (Path Abs File) -> Sem r (Maybe (Path Abs File))
findConfigPath Maybe (Path Abs File)
cliFile
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Default a => a
def) forall (r :: EffectRow).
Members '[Log, Error Text, Embed IO] r =>
Path Abs File -> Sem r Config
parseFileConfig Maybe (Path Abs File)
f