{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides TOML configuration.
module Charon.Runner.Toml
  ( TomlConfig (..),
    mergeConfigs,
    defaultTomlConfig,
  )
where

import Charon.Backend.Data (Backend)
import Charon.Data.Paths (PathI (MkPathI), PathIndex (TrashHome))
import Charon.Prelude
import Charon.Runner.Args (Args)
import Charon.Runner.Command (CommandP2)
import Charon.Runner.FileSizeMode (FileSizeMode, parseFileSizeMode)
import Charon.Runner.Phase (advancePhase)
import Charon.Utils qualified as U
import TOML
  ( DecodeTOML (),
    getFieldOpt,
    getFieldOptWith,
  )
import TOML.Decode (tomlDecoder)

-- | Holds TOML configuration.
data TomlConfig = MkTomlConfig
  { -- | Trash home.
    TomlConfig -> Maybe (PathI 'TrashHome)
trashHome :: !(Maybe (PathI TrashHome)),
    -- | Backend.
    TomlConfig -> Maybe Backend
backend :: Maybe Backend,
    -- | Log level. The double Maybe is so we distinguish between
    -- unspecified (Nothing) and explicitly disabled (Just Nothing).
    TomlConfig -> Maybe (Maybe LogLevel)
logLevel :: !(Maybe (Maybe LogLevel)),
    -- | Whether to warn/delete large log files.
    TomlConfig -> Maybe FileSizeMode
logSizeMode :: Maybe FileSizeMode
  }
  deriving stock (TomlConfig -> TomlConfig -> Bool
(TomlConfig -> TomlConfig -> Bool)
-> (TomlConfig -> TomlConfig -> Bool) -> Eq TomlConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TomlConfig -> TomlConfig -> Bool
== :: TomlConfig -> TomlConfig -> Bool
$c/= :: TomlConfig -> TomlConfig -> Bool
/= :: TomlConfig -> TomlConfig -> Bool
Eq, Int -> TomlConfig -> ShowS
[TomlConfig] -> ShowS
TomlConfig -> String
(Int -> TomlConfig -> ShowS)
-> (TomlConfig -> String)
-> ([TomlConfig] -> ShowS)
-> Show TomlConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TomlConfig -> ShowS
showsPrec :: Int -> TomlConfig -> ShowS
$cshow :: TomlConfig -> String
show :: TomlConfig -> String
$cshowList :: [TomlConfig] -> ShowS
showList :: [TomlConfig] -> ShowS
Show)

makeFieldLabelsNoPrefix ''TomlConfig

defaultTomlConfig :: TomlConfig
defaultTomlConfig :: TomlConfig
defaultTomlConfig = Maybe (PathI 'TrashHome)
-> Maybe Backend
-> Maybe (Maybe LogLevel)
-> Maybe FileSizeMode
-> TomlConfig
MkTomlConfig Maybe (PathI 'TrashHome)
forall a. Maybe a
Nothing Maybe Backend
forall a. Maybe a
Nothing Maybe (Maybe LogLevel)
forall a. Maybe a
Nothing Maybe FileSizeMode
forall a. Maybe a
Nothing

instance DecodeTOML TomlConfig where
  tomlDecoder :: Decoder TomlConfig
tomlDecoder =
    Maybe (PathI 'TrashHome)
-> Maybe Backend
-> Maybe (Maybe LogLevel)
-> Maybe FileSizeMode
-> TomlConfig
MkTomlConfig
      (Maybe (PathI 'TrashHome)
 -> Maybe Backend
 -> Maybe (Maybe LogLevel)
 -> Maybe FileSizeMode
 -> TomlConfig)
-> Decoder (Maybe (PathI 'TrashHome))
-> Decoder
     (Maybe Backend
      -> Maybe (Maybe LogLevel) -> Maybe FileSizeMode -> TomlConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Maybe (PathI 'TrashHome))
forall {i :: PathIndex}. Decoder (Maybe (PathI i))
decodeTrashHome
      Decoder
  (Maybe Backend
   -> Maybe (Maybe LogLevel) -> Maybe FileSizeMode -> TomlConfig)
-> Decoder (Maybe Backend)
-> Decoder
     (Maybe (Maybe LogLevel) -> Maybe FileSizeMode -> TomlConfig)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder (Maybe Backend)
decodeBackend
      Decoder
  (Maybe (Maybe LogLevel) -> Maybe FileSizeMode -> TomlConfig)
-> Decoder (Maybe (Maybe LogLevel))
-> Decoder (Maybe FileSizeMode -> TomlConfig)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder (Maybe (Maybe LogLevel))
decodeLogLevel
      Decoder (Maybe FileSizeMode -> TomlConfig)
-> Decoder (Maybe FileSizeMode) -> Decoder TomlConfig
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder (Maybe FileSizeMode)
decodeSizeMode
    where
      decodeTrashHome :: Decoder (Maybe (PathI i))
decodeTrashHome = do
        Maybe String
mh <- Text -> Decoder (Maybe String)
forall a. DecodeTOML a => Text -> Decoder (Maybe a)
getFieldOpt Text
"trash-home"
        case Maybe String
mh of
          Maybe String
Nothing -> Maybe (PathI i) -> Decoder (Maybe (PathI i))
forall a. a -> Decoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PathI i)
forall a. Maybe a
Nothing
          Just String
h ->
            case String -> Either EncodingException OsPath
encodeFpToOs String
h of
              Right OsPath
p -> Maybe (PathI i) -> Decoder (Maybe (PathI i))
forall a. a -> Decoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PathI i) -> Decoder (Maybe (PathI i)))
-> Maybe (PathI i) -> Decoder (Maybe (PathI i))
forall a b. (a -> b) -> a -> b
$ PathI i -> Maybe (PathI i)
forall a. a -> Maybe a
Just (PathI i -> Maybe (PathI i)) -> PathI i -> Maybe (PathI i)
forall a b. (a -> b) -> a -> b
$ OsPath -> PathI i
forall (i :: PathIndex). OsPath -> PathI i
MkPathI OsPath
p
              Left EncodingException
ex -> String -> Decoder (Maybe (PathI i))
forall a. String -> Decoder a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder (Maybe (PathI i)))
-> String -> Decoder (Maybe (PathI i))
forall a b. (a -> b) -> a -> b
$ String
"Could not encode trash-home: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex
      decodeBackend :: Decoder (Maybe Backend)
decodeBackend = Decoder Backend -> Text -> Decoder (Maybe Backend)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder Backend
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"backend"
      decodeLogLevel :: Decoder (Maybe (Maybe LogLevel))
decodeLogLevel =
        Decoder (Maybe LogLevel)
-> Text -> Decoder (Maybe (Maybe LogLevel))
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith (Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Text
-> (Text -> Decoder (Maybe LogLevel)) -> Decoder (Maybe LogLevel)
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Decoder (Maybe LogLevel)
forall (m :: * -> *). MonadFail m => Text -> m (Maybe LogLevel)
U.readLogLevel) Text
"log-level"
      decodeSizeMode :: Decoder (Maybe FileSizeMode)
decodeSizeMode = Decoder FileSizeMode -> Text -> Decoder (Maybe FileSizeMode)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith (Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder Decoder Text
-> (Text -> Decoder FileSizeMode) -> Decoder FileSizeMode
forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Decoder FileSizeMode
forall (m :: * -> *). MonadFail m => Text -> m FileSizeMode
parseFileSizeMode) Text
"log-size-mode"

-- | Merges the args and toml config into a single toml config. If some field
-- F is specified by both args and toml config, then args takes precedence.
mergeConfigs :: Args -> TomlConfig -> (TomlConfig, CommandP2)
mergeConfigs :: Args -> TomlConfig -> (TomlConfig, CommandP2)
mergeConfigs Args
args TomlConfig
toml = (TomlConfig
mergedConfig, CommandP1 -> NextPhase CommandP1
forall a. AdvancePhase a => a -> NextPhase a
advancePhase CommandP1
cmd)
  where
    cmd :: CommandP1
cmd = Args
args Args -> Optic' A_Lens NoIx Args CommandP1 -> CommandP1
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Args CommandP1
#command
    mergedConfig :: TomlConfig
mergedConfig =
      MkTomlConfig
        { $sel:trashHome:MkTomlConfig :: Maybe (PathI 'TrashHome)
trashHome = Lens' Args (Maybe (PathI 'TrashHome))
-> Lens' TomlConfig (Maybe (PathI 'TrashHome))
-> Args
-> TomlConfig
-> Maybe (PathI 'TrashHome)
forall (f :: * -> *) s a t.
Alternative f =>
Lens' s (f a) -> Lens' t (f a) -> s -> t -> f a
U.mergeAlt Lens' Args (Maybe (PathI 'TrashHome))
#trashHome Lens' TomlConfig (Maybe (PathI 'TrashHome))
#trashHome Args
args TomlConfig
toml,
          $sel:backend:MkTomlConfig :: Maybe Backend
backend = Lens' Args (Maybe Backend)
-> Lens' TomlConfig (Maybe Backend)
-> Args
-> TomlConfig
-> Maybe Backend
forall (f :: * -> *) s a t.
Alternative f =>
Lens' s (f a) -> Lens' t (f a) -> s -> t -> f a
U.mergeAlt Lens' Args (Maybe Backend)
#backend Lens' TomlConfig (Maybe Backend)
#backend Args
args TomlConfig
toml,
          $sel:logLevel:MkTomlConfig :: Maybe (Maybe LogLevel)
logLevel = Lens' Args (Maybe (Maybe LogLevel))
-> Lens' TomlConfig (Maybe (Maybe LogLevel))
-> Args
-> TomlConfig
-> Maybe (Maybe LogLevel)
forall (f :: * -> *) s a t.
Alternative f =>
Lens' s (f a) -> Lens' t (f a) -> s -> t -> f a
U.mergeAlt Lens' Args (Maybe (Maybe LogLevel))
#logLevel Lens' TomlConfig (Maybe (Maybe LogLevel))
#logLevel Args
args TomlConfig
toml,
          $sel:logSizeMode:MkTomlConfig :: Maybe FileSizeMode
logSizeMode = Lens' Args (Maybe FileSizeMode)
-> Lens' TomlConfig (Maybe FileSizeMode)
-> Args
-> TomlConfig
-> Maybe FileSizeMode
forall (f :: * -> *) s a t.
Alternative f =>
Lens' s (f a) -> Lens' t (f a) -> s -> t -> f a
U.mergeAlt Lens' Args (Maybe FileSizeMode)
#logSizeMode Lens' TomlConfig (Maybe FileSizeMode)
#logSizeMode Args
args TomlConfig
toml
        }