{-# LANGUAGE ApplicativeDo #-}

{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

@tomland@ library integration. 'TomlCodec's for the 'Config' data type.
-}

module Stan.Toml
    ( getTomlConfig
      -- * Codecs
    , configCodec
      -- * Files
    , usedTomlFiles
    ) where

import Colourista (infoMessage)
import System.Directory (doesFileExist, getCurrentDirectory, getHomeDirectory)
import System.FilePath ((</>))
import Toml (AnyValue, BiMap (..), Key, TomlBiMap, TomlCodec, (.=))
import Trial (TaggedTrial, Trial (..), fiasco)
import Trial.Tomland (taggedTrialListCodec)

import Stan.Category (Category (..))
import Stan.Config (Check (..), CheckFilter (..), CheckType (..), ConfigP (..), PartialConfig,
                    Scope (..))
import Stan.Core.Id (Id (..))
import Stan.Inspection (Inspection (..))
import Stan.Observation (Observation (..))
import Stan.Severity (Severity (..))

import qualified Toml


{- | Based on the incoming settings returns the TOML configuration files that
were used to get the final config.
-}
usedTomlFiles :: Bool -> Maybe FilePath -> IO [FilePath]
usedTomlFiles :: Bool -> Maybe FilePath -> IO [FilePath]
usedTomlFiles useDefault :: Bool
useDefault mFile :: Maybe FilePath
mFile = do
    [FilePath]
def <-
        if Bool
useDefault
        then do
            FilePath
cur <- IO FilePath
defaultCurConfigFile
            IO Bool -> IO [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
cur) ([FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
cur]) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
                FilePath
home <- IO FilePath
defaultHomeConfigFile
                FilePath -> IO [FilePath]
memptyIfNotExist FilePath
home
        else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    [FilePath]
custom <- case Maybe FilePath
mFile of
        Nothing -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just f :: FilePath
f  -> FilePath -> IO [FilePath]
memptyIfNotExist FilePath
f
    pure $ [FilePath]
def [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
custom
  where
    memptyIfNotExist :: FilePath -> IO [FilePath]
    memptyIfNotExist :: FilePath -> IO [FilePath]
memptyIfNotExist fp :: FilePath
fp = IO Bool -> IO [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
fp) ([FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
fp]) ([FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

getTomlConfig :: Bool -> Bool -> Maybe FilePath -> IO PartialConfig
getTomlConfig :: Bool -> Bool -> Maybe FilePath -> IO PartialConfig
getTomlConfig isLoud :: Bool
isLoud useDefault :: Bool
useDefault mTomlFile :: Maybe FilePath
mTomlFile = do
    PartialConfig
def <-
        if Bool
useDefault
        then IO FilePath
defaultCurConfigFile IO FilePath
-> (FilePath -> IO (Trial Text PartialConfig))
-> IO (Trial Text PartialConfig)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (Trial Text PartialConfig)
readToml IO (Trial Text PartialConfig)
-> (Trial Text PartialConfig -> IO PartialConfig)
-> IO PartialConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Result _ r :: PartialConfig
r -> PartialConfig -> IO PartialConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartialConfig
r
            resCur :: Trial Text PartialConfig
resCur -> IO FilePath
defaultHomeConfigFile IO FilePath
-> (FilePath -> IO (Trial Text PartialConfig))
-> IO (Trial Text PartialConfig)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (Trial Text PartialConfig)
readToml IO (Trial Text PartialConfig)
-> (Trial Text PartialConfig -> IO PartialConfig)
-> IO PartialConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ resHome :: Trial Text PartialConfig
resHome ->
                PartialConfig -> IO PartialConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialConfig -> IO PartialConfig)
-> PartialConfig -> IO PartialConfig
forall a b. (a -> b) -> a -> b
$ Trial Text PartialConfig -> PartialConfig
inline (Trial Text PartialConfig -> PartialConfig)
-> Trial Text PartialConfig -> PartialConfig
forall a b. (a -> b) -> a -> b
$ Trial Text PartialConfig
resCur Trial Text PartialConfig
-> Trial Text PartialConfig -> Trial Text PartialConfig
forall a. Semigroup a => a -> a -> a
<> Trial Text PartialConfig
resHome
        else let e :: Trial Text a
e = Text -> Trial Text a
forall e a. e -> Trial e a
fiasco "Selected NOT to use any default .stan.toml configuration files"
             in PartialConfig -> IO PartialConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialConfig -> IO PartialConfig)
-> PartialConfig -> IO PartialConfig
forall a b. (a -> b) -> a -> b
$ ('Partial ::- [Check])
-> ('Partial ::- [Scope])
-> ('Partial ::- [Id Observation])
-> PartialConfig
forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP 'Partial ::- [Check]
forall a. Trial Text a
e 'Partial ::- [Scope]
forall a. Trial Text a
e 'Partial ::- [Id Observation]
forall a. Trial Text a
e
    case Maybe FilePath
mTomlFile of
        Just tomlFile :: FilePath
tomlFile -> (PartialConfig
def PartialConfig -> PartialConfig -> PartialConfig
forall a. Semigroup a => a -> a -> a
<>) (PartialConfig -> PartialConfig)
-> (Trial Text PartialConfig -> PartialConfig)
-> Trial Text PartialConfig
-> PartialConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trial Text PartialConfig -> PartialConfig
inline (Trial Text PartialConfig -> PartialConfig)
-> IO (Trial Text PartialConfig) -> IO PartialConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Trial Text PartialConfig)
readToml FilePath
tomlFile
        Nothing       -> PartialConfig -> IO PartialConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartialConfig
def
  where
    readToml :: FilePath -> IO (Trial Text PartialConfig)
    readToml :: FilePath -> IO (Trial Text PartialConfig)
readToml file :: FilePath
file = do
        Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
file
        if Bool
isFile
        then do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
infoMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Reading Configurations from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " ..."
            PartialConfig -> Trial Text PartialConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialConfig -> Trial Text PartialConfig)
-> IO PartialConfig -> IO (Trial Text PartialConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlCodec PartialConfig -> FilePath -> IO PartialConfig
forall a (m :: * -> *). MonadIO m => TomlCodec a -> FilePath -> m a
Toml.decodeFile TomlCodec PartialConfig
configCodec FilePath
file
        else Trial Text PartialConfig -> IO (Trial Text PartialConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Trial Text PartialConfig -> IO (Trial Text PartialConfig))
-> Trial Text PartialConfig -> IO (Trial Text PartialConfig)
forall a b. (a -> b) -> a -> b
$ Text -> Trial Text PartialConfig
forall e a. e -> Trial e a
fiasco (Text -> Trial Text PartialConfig)
-> Text -> Trial Text PartialConfig
forall a b. (a -> b) -> a -> b
$ "TOML Configurations file doesn't exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
file

    inline :: Trial Text PartialConfig -> PartialConfig
    inline :: Trial Text PartialConfig -> PartialConfig
inline = \case
        Fiasco f :: DList (Fatality, Text)
f     -> let e :: Trial Text a
e = DList (Fatality, Text) -> Trial Text a
forall e a. DList (Fatality, e) -> Trial e a
Fiasco DList (Fatality, Text)
f in ('Partial ::- [Check])
-> ('Partial ::- [Scope])
-> ('Partial ::- [Id Observation])
-> PartialConfig
forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP 'Partial ::- [Check]
forall a. Trial Text a
e 'Partial ::- [Scope]
forall a. Trial Text a
e 'Partial ::- [Id Observation]
forall a. Trial Text a
e
        Result _ res :: PartialConfig
res -> PartialConfig
res

defaultTomlFile :: FilePath
defaultTomlFile :: FilePath
defaultTomlFile = ".stan.toml"

defaultHomeConfigFile :: IO FilePath
defaultHomeConfigFile :: IO FilePath
defaultHomeConfigFile = (FilePath -> FilePath -> FilePath
</> FilePath
defaultTomlFile) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getHomeDirectory

defaultCurConfigFile :: IO FilePath
defaultCurConfigFile :: IO FilePath
defaultCurConfigFile = (FilePath -> FilePath -> FilePath
</> FilePath
defaultTomlFile) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory

configCodec :: TomlCodec PartialConfig
configCodec :: TomlCodec PartialConfig
configCodec = TaggedTrial Text [Check]
-> TaggedTrial Text [Scope]
-> TaggedTrial Text [Id Observation]
-> PartialConfig
forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP
    (TaggedTrial Text [Check]
 -> TaggedTrial Text [Scope]
 -> TaggedTrial Text [Id Observation]
 -> PartialConfig)
-> Codec PartialConfig (TaggedTrial Text [Check])
-> Codec
     PartialConfig
     (TaggedTrial Text [Scope]
      -> TaggedTrial Text [Id Observation] -> PartialConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlCodec (TaggedTrial Text [Check])
checksCodec  TomlCodec (TaggedTrial Text [Check])
-> (PartialConfig -> TaggedTrial Text [Check])
-> Codec PartialConfig (TaggedTrial Text [Check])
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= PartialConfig -> TaggedTrial Text [Check]
forall (p :: Phase Text). ConfigP p -> p ::- [Check]
configChecks
    Codec
  PartialConfig
  (TaggedTrial Text [Scope]
   -> TaggedTrial Text [Id Observation] -> PartialConfig)
-> Codec PartialConfig (TaggedTrial Text [Scope])
-> Codec
     PartialConfig (TaggedTrial Text [Id Observation] -> PartialConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec (TaggedTrial Text [Scope])
removedCodec TomlCodec (TaggedTrial Text [Scope])
-> (PartialConfig -> TaggedTrial Text [Scope])
-> Codec PartialConfig (TaggedTrial Text [Scope])
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= PartialConfig -> TaggedTrial Text [Scope]
forall (p :: Phase Text). ConfigP p -> p ::- [Scope]
configRemoved
    Codec
  PartialConfig (TaggedTrial Text [Id Observation] -> PartialConfig)
-> Codec PartialConfig (TaggedTrial Text [Id Observation])
-> TomlCodec PartialConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec (TaggedTrial Text [Id Observation])
ignoredCodec TomlCodec (TaggedTrial Text [Id Observation])
-> (PartialConfig -> TaggedTrial Text [Id Observation])
-> Codec PartialConfig (TaggedTrial Text [Id Observation])
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= PartialConfig -> TaggedTrial Text [Id Observation]
forall (p :: Phase Text). ConfigP p -> p ::- [Id Observation]
configIgnored

removedCodec :: TomlCodec (TaggedTrial Text [Scope])
removedCodec :: TomlCodec (TaggedTrial Text [Scope])
removedCodec = Key -> TomlCodec Scope -> TomlCodec (TaggedTrial Text [Scope])
forall e a.
(IsString e, Semigroup e) =>
Key -> TomlCodec a -> TomlCodec (TaggedTrial e [a])
taggedTrialListCodec "remove" TomlCodec Scope
scopeCodec

ignoredCodec :: TomlCodec (TaggedTrial Text [Id Observation])
ignoredCodec :: TomlCodec (TaggedTrial Text [Id Observation])
ignoredCodec = Key
-> TomlCodec (Id Observation)
-> TomlCodec (TaggedTrial Text [Id Observation])
forall e a.
(IsString e, Semigroup e) =>
Key -> TomlCodec a -> TomlCodec (TaggedTrial e [a])
taggedTrialListCodec "ignore" TomlCodec (Id Observation)
forall a. TomlCodec (Id a)
idCodec

checksCodec :: TomlCodec (TaggedTrial Text [Check])
checksCodec :: TomlCodec (TaggedTrial Text [Check])
checksCodec = Key -> TomlCodec Check -> TomlCodec (TaggedTrial Text [Check])
forall e a.
(IsString e, Semigroup e) =>
Key -> TomlCodec a -> TomlCodec (TaggedTrial e [a])
taggedTrialListCodec "check" TomlCodec Check
checkCodec

checkCodec :: TomlCodec Check
checkCodec :: TomlCodec Check
checkCodec = CheckType -> CheckFilter -> Scope -> Check
Check
    (CheckType -> CheckFilter -> Scope -> Check)
-> Codec Check CheckType
-> Codec Check (CheckFilter -> Scope -> Check)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlCodec CheckType
checkTypeCodec   TomlCodec CheckType
-> (Check -> CheckType) -> Codec Check CheckType
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Check -> CheckType
checkType
    Codec Check (CheckFilter -> Scope -> Check)
-> Codec Check CheckFilter -> Codec Check (Scope -> Check)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec CheckFilter
checkFilterCodec TomlCodec CheckFilter
-> (Check -> CheckFilter) -> Codec Check CheckFilter
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Check -> CheckFilter
checkFilter
    Codec Check (Scope -> Check)
-> Codec Check Scope -> TomlCodec Check
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec Scope
scopeCodec       TomlCodec Scope -> (Check -> Scope) -> Codec Check Scope
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Check -> Scope
checkScope

checkTypeCodec :: TomlCodec CheckType
checkTypeCodec :: TomlCodec CheckType
checkTypeCodec = Key -> TomlCodec CheckType
forall a. (Bounded a, Enum a, Show a) => Key -> TomlCodec a
Toml.enumBounded "type"

----------------------------------------------------------------------------
-- CheckFilter
----------------------------------------------------------------------------

checkInspection :: CheckFilter -> Maybe (Id Inspection)
checkInspection :: CheckFilter -> Maybe (Id Inspection)
checkInspection = \case
    CheckInspection idI :: Id Inspection
idI -> Id Inspection -> Maybe (Id Inspection)
forall a. a -> Maybe a
Just Id Inspection
idI
    _other :: CheckFilter
_other -> Maybe (Id Inspection)
forall a. Maybe a
Nothing

checkSeverity :: CheckFilter -> Maybe Severity
checkSeverity :: CheckFilter -> Maybe Severity
checkSeverity = \case
    CheckSeverity sev :: Severity
sev -> Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
sev
    _other :: CheckFilter
_other -> Maybe Severity
forall a. Maybe a
Nothing

checkCategory :: CheckFilter -> Maybe Category
checkCategory :: CheckFilter -> Maybe Category
checkCategory = \case
    CheckCategory category :: Category
category -> Category -> Maybe Category
forall a. a -> Maybe a
Just Category
category
    _other :: CheckFilter
_other -> Maybe Category
forall a. Maybe a
Nothing

checkAll :: CheckFilter -> Maybe ()
checkAll :: CheckFilter -> Maybe ()
checkAll = \case
    CheckAll -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
    _other :: CheckFilter
_other -> Maybe ()
forall a. Maybe a
Nothing

checkFilterCodec :: TomlCodec CheckFilter
checkFilterCodec :: TomlCodec CheckFilter
checkFilterCodec =
        (CheckFilter -> Maybe (Id Inspection))
-> (Id Inspection -> CheckFilter)
-> TomlCodec (Id Inspection)
-> TomlCodec CheckFilter
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimatch CheckFilter -> Maybe (Id Inspection)
checkInspection Id Inspection -> CheckFilter
CheckInspection  TomlCodec (Id Inspection)
forall a. TomlCodec (Id a)
idCodec
    TomlCodec CheckFilter
-> TomlCodec CheckFilter -> TomlCodec CheckFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CheckFilter -> Maybe Severity)
-> (Severity -> CheckFilter)
-> TomlCodec Severity
-> TomlCodec CheckFilter
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimatch CheckFilter -> Maybe Severity
checkSeverity   Severity -> CheckFilter
CheckSeverity    (Key -> TomlCodec Severity
forall a. (Bounded a, Enum a, Show a) => Key -> TomlCodec a
Toml.enumBounded "severity")
    TomlCodec CheckFilter
-> TomlCodec CheckFilter -> TomlCodec CheckFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CheckFilter -> Maybe Category)
-> (Category -> CheckFilter)
-> TomlCodec Category
-> TomlCodec CheckFilter
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimatch CheckFilter -> Maybe Category
checkCategory   Category -> CheckFilter
CheckCategory    (TomlCodec Text -> TomlCodec Category
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (Key -> TomlCodec Text
Toml.text "category"))
    TomlCodec CheckFilter
-> TomlCodec CheckFilter -> TomlCodec CheckFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (CheckFilter -> Maybe ())
-> (() -> CheckFilter) -> TomlCodec () -> TomlCodec CheckFilter
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimatch CheckFilter -> Maybe ()
checkAll        (CheckFilter -> () -> CheckFilter
forall a b. a -> b -> a
const CheckFilter
CheckAll) (Key -> TomlCodec ()
allCodec "filter")

idCodec :: TomlCodec (Id a)
idCodec :: TomlCodec (Id a)
idCodec = TomlCodec Text -> TomlCodec (Id a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec Text -> TomlCodec (Id a))
-> TomlCodec Text -> TomlCodec (Id a)
forall a b. (a -> b) -> a -> b
$ Key -> TomlCodec Text
Toml.text "id"

----------------------------------------------------------------------------
-- CheckScope
----------------------------------------------------------------------------

scopeFile :: Scope -> Maybe FilePath
scopeFile :: Scope -> Maybe FilePath
scopeFile = \case
    ScopeFile filePath :: FilePath
filePath -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
filePath
    _other :: Scope
_other -> Maybe FilePath
forall a. Maybe a
Nothing

scopeDir :: Scope -> Maybe FilePath
scopeDir :: Scope -> Maybe FilePath
scopeDir = \case
    ScopeDirectory dir :: FilePath
dir -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir
    _other :: Scope
_other -> Maybe FilePath
forall a. Maybe a
Nothing

scopeAll :: Scope -> Maybe ()
scopeAll :: Scope -> Maybe ()
scopeAll = \case
    ScopeAll -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
    _other :: Scope
_other -> Maybe ()
forall a. Maybe a
Nothing

scopeCodec :: TomlCodec Scope
scopeCodec :: TomlCodec Scope
scopeCodec =
        (Scope -> Maybe FilePath)
-> (FilePath -> Scope) -> TomlCodec FilePath -> TomlCodec Scope
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimatch Scope -> Maybe FilePath
scopeFile FilePath -> Scope
ScopeFile        (Key -> TomlCodec FilePath
Toml.string "file")
    TomlCodec Scope -> TomlCodec Scope -> TomlCodec Scope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Scope -> Maybe FilePath)
-> (FilePath -> Scope) -> TomlCodec FilePath -> TomlCodec Scope
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimatch Scope -> Maybe FilePath
scopeDir  FilePath -> Scope
ScopeDirectory   (Key -> TomlCodec FilePath
Toml.string "directory")
    TomlCodec Scope -> TomlCodec Scope -> TomlCodec Scope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Scope -> Maybe ())
-> (() -> Scope) -> TomlCodec () -> TomlCodec Scope
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimatch Scope -> Maybe ()
scopeAll  (Scope -> () -> Scope
forall a b. a -> b -> a
const Scope
ScopeAll) (Key -> TomlCodec ()
allCodec "scope")

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

-- | Helper 'BiMap' for the hardcoded string @"all"@.
_All :: TomlBiMap () AnyValue
_All :: TomlBiMap () AnyValue
_All = TomlBiMap () Text
_AllText TomlBiMap () Text
-> BiMap TomlBiMapError Text AnyValue -> TomlBiMap () AnyValue
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BiMap TomlBiMapError Text AnyValue
Toml._Text
  where
    _AllText :: TomlBiMap () Text
    _AllText :: TomlBiMap () Text
_AllText = BiMap :: forall e a b. (a -> Either e b) -> (b -> Either e a) -> BiMap e a b
BiMap
        { forward :: () -> Either TomlBiMapError Text
forward  = \() -> Text -> Either TomlBiMapError Text
forall a b. b -> Either a b
Right "all"
        , backward :: Text -> Either TomlBiMapError ()
backward = \case
            "all" -> () -> Either TomlBiMapError ()
forall a b. b -> Either a b
Right ()
            t :: Text
t -> TomlBiMapError -> Either TomlBiMapError ()
forall a b. a -> Either a b
Left (TomlBiMapError -> Either TomlBiMapError ())
-> TomlBiMapError -> Either TomlBiMapError ()
forall a b. (a -> b) -> a -> b
$ Text -> TomlBiMapError
Toml.ArbitraryError (Text -> TomlBiMapError) -> Text -> TomlBiMapError
forall a b. (a -> b) -> a -> b
$ "Expected Text value \"all\" but got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
        }

allCodec :: Key -> TomlCodec ()
allCodec :: Key -> TomlCodec ()
allCodec = TomlBiMap () AnyValue -> Key -> TomlCodec ()
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
Toml.match TomlBiMap () AnyValue
_All