{-# 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 Bool
useDefault 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 a. a -> IO a
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    [FilePath]
custom <- case Maybe FilePath
mFile of
        Maybe FilePath
Nothing -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just 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 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
fp]) ([FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

getTomlConfig :: Bool -> Bool -> Maybe FilePath -> IO PartialConfig
getTomlConfig :: Bool -> Bool -> Maybe FilePath -> IO PartialConfig
getTomlConfig Bool
isLoud Bool
useDefault 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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Result DList Text
_ PartialConfig
r -> PartialConfig -> IO PartialConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartialConfig
r
            Trial Text PartialConfig
resCur -> IO FilePath
defaultHomeConfigFile IO FilePath
-> (FilePath -> IO (Trial Text PartialConfig))
-> IO (Trial Text PartialConfig)
forall a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Trial Text PartialConfig
resHome ->
                PartialConfig -> IO PartialConfig
forall a. a -> IO a
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 Text
"Selected NOT to use any default .stan.toml configuration files"
             in PartialConfig -> IO PartialConfig
forall a. a -> IO a
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]
Trial Text (Text, [Check])
forall {a}. Trial Text a
e 'Partial ::- [Scope]
Trial Text (Text, [Scope])
forall {a}. Trial Text a
e 'Partial ::- [Id Observation]
Trial Text (Text, [Id Observation])
forall {a}. Trial Text a
e
    case Maybe FilePath
mTomlFile of
        Just 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
        Maybe FilePath
Nothing       -> PartialConfig -> IO PartialConfig
forall a. a -> IO a
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 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
$ Text
"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
<> Text
" ..."
            PartialConfig -> Trial Text PartialConfig
forall a. a -> Trial Text a
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 a. a -> IO a
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
$ Text
"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 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]
Trial Text (Text, [Check])
forall {a}. Trial Text a
e 'Partial ::- [Scope]
Trial Text (Text, [Scope])
forall {a}. Trial Text a
e 'Partial ::- [Id Observation]
Trial Text (Text, [Id Observation])
forall {a}. Trial Text a
e
        Result DList Text
_ PartialConfig
res -> PartialConfig
res

defaultTomlFile :: FilePath
defaultTomlFile :: FilePath
defaultTomlFile = FilePath
".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 = ('Partial ::- [Check])
-> ('Partial ::- [Scope])
-> ('Partial ::- [Id Observation])
-> PartialConfig
Trial Text (Text, [Check])
-> Trial Text (Text, [Scope])
-> Trial Text (Text, [Id Observation])
-> PartialConfig
forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP
    (Trial Text (Text, [Check])
 -> Trial Text (Text, [Scope])
 -> Trial Text (Text, [Id Observation])
 -> PartialConfig)
-> Codec PartialConfig (Trial Text (Text, [Check]))
-> Codec
     PartialConfig
     (Trial Text (Text, [Scope])
      -> Trial Text (Text, [Id Observation]) -> PartialConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlCodec (Trial Text (Text, [Check]))
checksCodec  TomlCodec (Trial Text (Text, [Check]))
-> (PartialConfig -> Trial Text (Text, [Check]))
-> Codec PartialConfig (Trial Text (Text, [Check]))
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= PartialConfig -> 'Partial ::- [Check]
PartialConfig -> Trial Text (Text, [Check])
forall (p :: Phase Text). ConfigP p -> p ::- [Check]
configChecks
    Codec
  PartialConfig
  (Trial Text (Text, [Scope])
   -> Trial Text (Text, [Id Observation]) -> PartialConfig)
-> Codec PartialConfig (Trial Text (Text, [Scope]))
-> Codec
     PartialConfig
     (Trial Text (Text, [Id Observation]) -> PartialConfig)
forall a b.
Codec PartialConfig (a -> b)
-> Codec PartialConfig a -> Codec PartialConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec (Trial Text (Text, [Scope]))
removedCodec TomlCodec (Trial Text (Text, [Scope]))
-> (PartialConfig -> Trial Text (Text, [Scope]))
-> Codec PartialConfig (Trial Text (Text, [Scope]))
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= PartialConfig -> 'Partial ::- [Scope]
PartialConfig -> Trial Text (Text, [Scope])
forall (p :: Phase Text). ConfigP p -> p ::- [Scope]
configRemoved
    Codec
  PartialConfig
  (Trial Text (Text, [Id Observation]) -> PartialConfig)
-> Codec PartialConfig (Trial Text (Text, [Id Observation]))
-> TomlCodec PartialConfig
forall a b.
Codec PartialConfig (a -> b)
-> Codec PartialConfig a -> Codec PartialConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec (Trial Text (Text, [Id Observation]))
ignoredCodec TomlCodec (Trial Text (Text, [Id Observation]))
-> (PartialConfig -> Trial Text (Text, [Id Observation]))
-> Codec PartialConfig (Trial Text (Text, [Id Observation]))
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= PartialConfig -> 'Partial ::- [Id Observation]
PartialConfig -> Trial Text (Text, [Id Observation])
forall (p :: Phase Text). ConfigP p -> p ::- [Id Observation]
configIgnored

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

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

checksCodec :: TomlCodec (TaggedTrial Text [Check])
checksCodec :: TomlCodec (Trial Text (Text, [Check]))
checksCodec = Key -> TomlCodec Check -> TomlCodec (Trial Text (Text, [Check]))
forall e a.
(IsString e, Semigroup e) =>
Key -> TomlCodec a -> TomlCodec (TaggedTrial e [a])
taggedTrialListCodec Key
"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 a b. Codec Check (a -> b) -> Codec Check a -> Codec Check b
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 a b. Codec Check (a -> b) -> Codec Check a -> Codec Check b
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 Key
"type"

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

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

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

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

checkAll :: CheckFilter -> Maybe ()
checkAll :: CheckFilter -> Maybe ()
checkAll = \case
    CheckFilter
CheckAll -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
    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 a.
Codec CheckFilter a -> Codec CheckFilter a -> Codec CheckFilter a
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 Key
"severity")
    TomlCodec CheckFilter
-> TomlCodec CheckFilter -> TomlCodec CheckFilter
forall a.
Codec CheckFilter a -> Codec CheckFilter a -> Codec CheckFilter a
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 Key
"category"))
    TomlCodec CheckFilter
-> TomlCodec CheckFilter -> TomlCodec CheckFilter
forall a.
Codec CheckFilter a -> Codec CheckFilter a -> Codec CheckFilter a
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 Key
"filter")

idCodec :: TomlCodec (Id a)
idCodec :: forall a. 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 Key
"id"

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

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

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

scopeAll :: Scope -> Maybe ()
scopeAll :: Scope -> Maybe ()
scopeAll = \case
    Scope
ScopeAll -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
    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 Key
"file")
    TomlCodec Scope -> TomlCodec Scope -> TomlCodec Scope
forall a. Codec Scope a -> Codec Scope a -> Codec Scope a
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 Key
"directory")
    TomlCodec Scope -> TomlCodec Scope -> TomlCodec Scope
forall a. Codec Scope a -> Codec Scope a -> Codec Scope a
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 Key
"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
        { forward :: () -> Either TomlBiMapError Text
forward  = \() -> Text -> Either TomlBiMapError Text
forall a b. b -> Either a b
Right Text
"all"
        , backward :: Text -> Either TomlBiMapError ()
backward = \case
            Text
"all" -> () -> Either TomlBiMapError ()
forall a b. b -> Either a b
Right ()
            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
$ Text
"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