{-# LANGUAGE ApplicativeDo #-}
module Trial.Tomland
( trialCodec
, trialStrCodec
, trialMaybeCodec
, taggedTrialCodec
, taggedTrialStrCodec
, taggedTrialMaybeCodec
, taggedTrialListCodec
) where
import Control.Monad (join)
import Data.String (IsString (..))
import Toml (Key, TomlCodec)
import Trial (TaggedTrial, Trial (..), fiasco, maybeToTrial, trialToMaybe, unTag, withTag)
import qualified Data.Text as Text
import qualified Toml
trialCodec :: e -> TomlCodec a -> TomlCodec (Trial e a)
trialCodec :: e -> TomlCodec a -> TomlCodec (Trial e a)
trialCodec e :: e
e = (Trial e a -> Maybe a)
-> (Maybe a -> Trial e a)
-> TomlCodec (Maybe a)
-> TomlCodec (Trial e a)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap Trial e a -> Maybe a
forall e a. Trial e a -> Maybe a
trialToMaybe (e -> Maybe a -> Trial e a
forall e a. e -> Maybe a -> Trial e a
maybeToTrial e
e) (TomlCodec (Maybe a) -> TomlCodec (Trial e a))
-> (TomlCodec a -> TomlCodec (Maybe a))
-> TomlCodec a
-> TomlCodec (Trial e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> TomlCodec (Maybe a)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional
trialStrCodec
:: forall e a
. (IsString e, Semigroup e)
=> (Key -> TomlCodec a)
-> Key
-> TomlCodec (Trial e a)
trialStrCodec :: (Key -> TomlCodec a) -> Key -> TomlCodec (Trial e a)
trialStrCodec codecA :: Key -> TomlCodec a
codecA key :: Key
key =
(Trial e a -> TaggedTrial e a)
-> (TaggedTrial e a -> Trial e a)
-> TomlCodec (TaggedTrial e a)
-> TomlCodec (Trial e a)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap (e -> Trial e a -> TaggedTrial e a
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag "TOML") TaggedTrial e a -> Trial e a
forall tag a. TaggedTrial tag a -> Trial tag a
unTag (TomlCodec (TaggedTrial e a) -> TomlCodec (Trial e a))
-> TomlCodec (TaggedTrial e a) -> TomlCodec (Trial e a)
forall a b. (a -> b) -> a -> b
$ (Key -> TomlCodec a) -> Key -> TomlCodec (TaggedTrial e a)
forall tag a.
(IsString tag, Semigroup tag) =>
(Key -> TomlCodec a) -> Key -> TomlCodec (TaggedTrial tag a)
taggedTrialStrCodec Key -> TomlCodec a
codecA Key
key
trialMaybeCodec :: TomlCodec a -> TomlCodec (Trial e (Maybe a))
trialMaybeCodec :: TomlCodec a -> TomlCodec (Trial e (Maybe a))
trialMaybeCodec = (Trial e (Maybe a) -> Maybe a)
-> (Maybe a -> Trial e (Maybe a))
-> TomlCodec (Maybe a)
-> TomlCodec (Trial e (Maybe a))
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> (Trial e (Maybe a) -> Maybe (Maybe a))
-> Trial e (Maybe a)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trial e (Maybe a) -> Maybe (Maybe a)
forall e a. Trial e a -> Maybe a
trialToMaybe) Maybe a -> Trial e (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TomlCodec (Maybe a) -> TomlCodec (Trial e (Maybe a)))
-> (TomlCodec a -> TomlCodec (Maybe a))
-> TomlCodec a
-> TomlCodec (Trial e (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> TomlCodec (Maybe a)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional
taggedTrialCodec
:: forall tag a
. tag
-> (Key -> TomlCodec a)
-> Key
-> TomlCodec (TaggedTrial tag a)
taggedTrialCodec :: tag -> (Key -> TomlCodec a) -> Key -> TomlCodec (TaggedTrial tag a)
taggedTrialCodec tag :: tag
tag codecA :: Key -> TomlCodec a
codecA key :: Key
key =
(TaggedTrial tag a -> Maybe a)
-> (Maybe a -> TaggedTrial tag a)
-> TomlCodec (Maybe a)
-> TomlCodec (TaggedTrial tag a)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap (((tag, a) -> a) -> Maybe (tag, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (tag, a) -> a
forall a b. (a, b) -> b
snd (Maybe (tag, a) -> Maybe a)
-> (TaggedTrial tag a -> Maybe (tag, a))
-> TaggedTrial tag a
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaggedTrial tag a -> Maybe (tag, a)
forall e a. Trial e a -> Maybe a
trialToMaybe) Maybe a -> TaggedTrial tag a
handleMaybe
(TomlCodec (Maybe a) -> TomlCodec (TaggedTrial tag a))
-> TomlCodec (Maybe a) -> TomlCodec (TaggedTrial tag a)
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> TomlCodec (Maybe a)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional (Key -> TomlCodec a
codecA Key
key)
where
handleMaybe :: Maybe a -> TaggedTrial tag a
handleMaybe :: Maybe a -> TaggedTrial tag a
handleMaybe = \case
Nothing -> tag -> TaggedTrial tag a
forall e a. e -> Trial e a
fiasco tag
tag
Just a :: a
a -> tag -> Trial tag a -> TaggedTrial tag a
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag tag
tag (Trial tag a -> TaggedTrial tag a)
-> Trial tag a -> TaggedTrial tag a
forall a b. (a -> b) -> a -> b
$ a -> Trial tag a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
taggedTrialStrCodec
:: forall tag a
. (IsString tag, Semigroup tag)
=> (Key -> TomlCodec a)
-> Key
-> TomlCodec (TaggedTrial tag a)
taggedTrialStrCodec :: (Key -> TomlCodec a) -> Key -> TomlCodec (TaggedTrial tag a)
taggedTrialStrCodec codecA :: Key -> TomlCodec a
codecA key :: Key
key =
(TaggedTrial tag a -> Maybe a)
-> (Maybe a -> TaggedTrial tag a)
-> TomlCodec (Maybe a)
-> TomlCodec (TaggedTrial tag a)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap (((tag, a) -> a) -> Maybe (tag, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (tag, a) -> a
forall a b. (a, b) -> b
snd (Maybe (tag, a) -> Maybe a)
-> (TaggedTrial tag a -> Maybe (tag, a))
-> TaggedTrial tag a
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaggedTrial tag a -> Maybe (tag, a)
forall e a. Trial e a -> Maybe a
trialToMaybe) Maybe a -> TaggedTrial tag a
handleMaybe
(TomlCodec (Maybe a) -> TomlCodec (TaggedTrial tag a))
-> TomlCodec (Maybe a) -> TomlCodec (TaggedTrial tag a)
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> TomlCodec (Maybe a)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional (Key -> TomlCodec a
codecA Key
key)
where
keyS :: tag
keyS :: tag
keyS = String -> tag
forall a. IsString a => String -> a
fromString (String -> tag) -> String -> tag
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Key -> Text
Toml.prettyKey Key
key
handleMaybe :: Maybe a -> TaggedTrial tag a
handleMaybe :: Maybe a -> TaggedTrial tag a
handleMaybe = \case
Nothing -> tag -> TaggedTrial tag a
forall e a. e -> Trial e a
fiasco (tag -> TaggedTrial tag a) -> tag -> TaggedTrial tag a
forall a b. (a -> b) -> a -> b
$ "No TOML option specified for key: " tag -> tag -> tag
forall a. Semigroup a => a -> a -> a
<> tag
keyS
Just a :: a
a -> tag -> Trial tag a -> TaggedTrial tag a
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag "TOML" (Trial tag a -> TaggedTrial tag a)
-> Trial tag a -> TaggedTrial tag a
forall a b. (a -> b) -> a -> b
$ a -> Trial tag a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
taggedTrialMaybeCodec :: IsString e => TomlCodec a -> TomlCodec (TaggedTrial e (Maybe a))
taggedTrialMaybeCodec :: TomlCodec a -> TomlCodec (TaggedTrial e (Maybe a))
taggedTrialMaybeCodec =
(TaggedTrial e (Maybe a) -> Maybe a)
-> (Maybe a -> TaggedTrial e (Maybe a))
-> TomlCodec (Maybe a)
-> TomlCodec (TaggedTrial e (Maybe a))
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap TaggedTrial e (Maybe a) -> Maybe a
forall e a. TaggedTrial e (Maybe a) -> Maybe a
taggedTrialToMaybe (e -> Trial e (Maybe a) -> TaggedTrial e (Maybe a)
forall tag a. tag -> Trial tag a -> TaggedTrial tag a
withTag "TOML" (Trial e (Maybe a) -> TaggedTrial e (Maybe a))
-> (Maybe a -> Trial e (Maybe a))
-> Maybe a
-> TaggedTrial e (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Trial e (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (TomlCodec (Maybe a) -> TomlCodec (TaggedTrial e (Maybe a)))
-> (TomlCodec a -> TomlCodec (Maybe a))
-> TomlCodec a
-> TomlCodec (TaggedTrial e (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> TomlCodec (Maybe a)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional
where
taggedTrialToMaybe :: TaggedTrial e (Maybe a) -> Maybe a
taggedTrialToMaybe :: TaggedTrial e (Maybe a) -> Maybe a
taggedTrialToMaybe = Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> (TaggedTrial e (Maybe a) -> Maybe (Maybe a))
-> TaggedTrial e (Maybe a)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e, Maybe a) -> Maybe a) -> Maybe (e, Maybe a) -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e, Maybe a) -> Maybe a
forall a b. (a, b) -> b
snd (Maybe (e, Maybe a) -> Maybe (Maybe a))
-> (TaggedTrial e (Maybe a) -> Maybe (e, Maybe a))
-> TaggedTrial e (Maybe a)
-> Maybe (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaggedTrial e (Maybe a) -> Maybe (e, Maybe a)
forall e a. Trial e a -> Maybe a
trialToMaybe
taggedTrialListCodec
:: forall e a
. (IsString e, Semigroup e)
=> Key
-> TomlCodec a
-> TomlCodec (TaggedTrial e [a])
taggedTrialListCodec :: Key -> TomlCodec a -> TomlCodec (TaggedTrial e [a])
taggedTrialListCodec key :: Key
key aCodec :: TomlCodec a
aCodec = do
TaggedTrial e [a]
res <- (Key -> TomlCodec [a]) -> Key -> TomlCodec (TaggedTrial e [a])
forall tag a.
(IsString tag, Semigroup tag) =>
(Key -> TomlCodec a) -> Key -> TomlCodec (TaggedTrial tag a)
taggedTrialStrCodec (TomlCodec a -> Key -> TomlCodec [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec a
aCodec) Key
key
pure $ case TaggedTrial e [a]
res of
Result _ (_, []) ->
TaggedTrial e [a]
res TaggedTrial e [a] -> TaggedTrial e [a] -> TaggedTrial e [a]
forall a. Semigroup a => a -> a -> a
<> e -> TaggedTrial e [a]
forall e a. e -> Trial e a
fiasco ("No TOML value is specified for key: " e -> e -> e
forall a. Semigroup a => a -> a -> a
<> Key -> e
keyToStr Key
key)
Result _ _ -> TaggedTrial e [a]
res
Fiasco _ -> TaggedTrial e [a]
res
where
keyToStr :: Key -> e
keyToStr :: Key -> e
keyToStr = String -> e
forall a. IsString a => String -> a
fromString (String -> e) -> (Key -> String) -> Key -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Key -> Text) -> Key -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Toml.prettyKey