{-# options_haddock prune #-}

-- |Config File Parsing, Internal
module Helic.Config.File where

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

findFileConfig ::
  Members [Log, Error Text, Embed IO] r =>
  Maybe (Path Abs File) ->
  Sem r Config
findFileConfig :: Maybe (Path Abs File) -> Sem r Config
findFileConfig Maybe (Path Abs File)
cliFile = do
  Maybe (Path Abs File)
f <- Maybe (Path Abs File) -> Sem r (Maybe (Path Abs File))
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
  Sem r Config
-> (Path Abs File -> Sem r Config)
-> Maybe (Path Abs File)
-> Sem r Config
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Config -> Sem r Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
forall a. Default a => a
def) Path Abs File -> Sem r Config
forall (r :: EffectRow).
Members '[Log, Error Text, Embed IO] r =>
Path Abs File -> Sem r Config
parseFileConfig Maybe (Path Abs File)
f