module Toml.Codec.Combinator.Table
(
table
, handleTableErrors
, mapTableErrors
) where
import Control.Monad.State (gets, modify)
import Data.Maybe (fromMaybe)
import Validation (Validation (..))
import Toml.Codec.Error (TomlDecodeError (..))
import Toml.Codec.Types (Codec (..), TomlCodec, TomlEnv, TomlState (..))
import Toml.Type.Key (Key)
import Toml.Type.TOML (TOML (..), insertTable)
import qualified Toml.Type.PrefixTree as Prefix
handleTableErrors :: TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors :: forall a.
TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors TomlCodec a
codec Key
key TOML
toml = case TomlCodec a -> TomlEnv a
forall i o. Codec i o -> TomlEnv o
codecRead TomlCodec a
codec TOML
toml of
Success a
res -> a -> Validation [TomlDecodeError] a
forall e a. a -> Validation e a
Success a
res
Failure [TomlDecodeError]
errs -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure ([TomlDecodeError] -> Validation [TomlDecodeError] a)
-> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall a b. (a -> b) -> a -> b
$ Key -> [TomlDecodeError] -> [TomlDecodeError]
mapTableErrors Key
key [TomlDecodeError]
errs
mapTableErrors :: Key -> [TomlDecodeError] -> [TomlDecodeError]
mapTableErrors :: Key -> [TomlDecodeError] -> [TomlDecodeError]
mapTableErrors Key
key = (TomlDecodeError -> TomlDecodeError)
-> [TomlDecodeError] -> [TomlDecodeError]
forall a b. (a -> b) -> [a] -> [b]
map (\case
KeyNotFound Key
name -> Key -> TomlDecodeError
KeyNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
TableNotFound Key
name -> Key -> TomlDecodeError
TableNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
TableArrayNotFound Key
name -> Key -> TomlDecodeError
TableArrayNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
TomlDecodeError
e -> TomlDecodeError
e
)
table :: forall a . TomlCodec a -> Key -> TomlCodec a
table :: forall a. TomlCodec a -> Key -> TomlCodec a
table TomlCodec a
codec Key
key = TomlEnv a -> (a -> TomlState a) -> TomlCodec a
forall i o. TomlEnv o -> (i -> TomlState o) -> Codec i o
Codec TomlEnv a
input a -> TomlState a
output
where
input :: TomlEnv a
input :: TomlEnv a
input = \TOML
t -> case Key -> PrefixMap TOML -> Maybe TOML
forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
key (PrefixMap TOML -> Maybe TOML) -> PrefixMap TOML -> Maybe TOML
forall a b. (a -> b) -> a -> b
$ TOML -> PrefixMap TOML
tomlTables TOML
t of
Maybe TOML
Nothing -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
TableNotFound Key
key]
Just TOML
toml -> TomlCodec a -> Key -> TomlEnv a
forall a.
TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors TomlCodec a
codec Key
key TOML
toml
output :: a -> TomlState a
output :: a -> TomlState a
output a
a = do
Maybe TOML
mTable <- (TOML -> Maybe TOML) -> TomlState (Maybe TOML)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TOML -> Maybe TOML) -> TomlState (Maybe TOML))
-> (TOML -> Maybe TOML) -> TomlState (Maybe TOML)
forall a b. (a -> b) -> a -> b
$ Key -> PrefixMap TOML -> Maybe TOML
forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
key (PrefixMap TOML -> Maybe TOML)
-> (TOML -> PrefixMap TOML) -> TOML -> Maybe TOML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> PrefixMap TOML
tomlTables
let toml :: TOML
toml = TOML -> Maybe TOML -> TOML
forall a. a -> Maybe a -> a
fromMaybe TOML
forall a. Monoid a => a
mempty Maybe TOML
mTable
let (Maybe a
_, TOML
newToml) = TomlState a -> TOML -> (Maybe a, TOML)
forall a. TomlState a -> TOML -> (Maybe a, TOML)
unTomlState (TomlCodec a -> a -> TomlState a
forall i o. Codec i o -> i -> TomlState o
codecWrite TomlCodec a
codec a
a) TOML
toml
a
a a -> TomlState () -> TomlState a
forall a b. a -> TomlState b -> TomlState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TOML -> TOML) -> TomlState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key -> TOML -> TOML -> TOML
insertTable Key
key TOML
newToml)