module Toml.Codec.Combinator.List
(
arrayOf
, arrayNonEmptyOf
, list
, nonEmpty
) where
import Control.Monad.State (gets, modify)
import Data.List.NonEmpty (NonEmpty (..), toList)
import Validation (Validation (..))
import Toml.Codec.BiMap (TomlBiMap)
import Toml.Codec.BiMap.Conversion (_Array, _NonEmpty)
import Toml.Codec.Code (execTomlCodec)
import Toml.Codec.Combinator.Common (match)
import Toml.Codec.Combinator.Table (handleTableErrors)
import Toml.Codec.Error (TomlDecodeError (..))
import Toml.Codec.Types (Codec (..), TomlCodec, TomlEnv, TomlState)
import Toml.Type.AnyValue (AnyValue (..))
import Toml.Type.Key (Key)
import Toml.Type.TOML (TOML (..), insertTableArrays)
import qualified Data.HashMap.Strict as HashMap
arrayOf :: TomlBiMap a AnyValue -> Key -> TomlCodec [a]
arrayOf :: TomlBiMap a AnyValue -> Key -> TomlCodec [a]
arrayOf = TomlBiMap [a] AnyValue -> Key -> TomlCodec [a]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match (TomlBiMap [a] AnyValue -> Key -> TomlCodec [a])
-> (TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue)
-> TomlBiMap a AnyValue
-> Key
-> TomlCodec [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array
{-# INLINE arrayOf #-}
arrayNonEmptyOf :: TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
arrayNonEmptyOf :: TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
arrayNonEmptyOf = TomlBiMap (NonEmpty a) AnyValue -> Key -> TomlCodec (NonEmpty a)
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match (TomlBiMap (NonEmpty a) AnyValue -> Key -> TomlCodec (NonEmpty a))
-> (TomlBiMap a AnyValue -> TomlBiMap (NonEmpty a) AnyValue)
-> TomlBiMap a AnyValue
-> Key
-> TomlCodec (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlBiMap a AnyValue -> TomlBiMap (NonEmpty a) AnyValue
forall a. TomlBiMap a AnyValue -> TomlBiMap (NonEmpty a) AnyValue
_NonEmpty
{-# INLINE arrayNonEmptyOf #-}
list :: forall a . TomlCodec a -> Key -> TomlCodec [a]
list :: TomlCodec a -> Key -> TomlCodec [a]
list codec :: TomlCodec a
codec key :: Key
key = Codec :: forall i o. TomlEnv o -> (i -> TomlState o) -> Codec i o
Codec
{ codecRead :: TomlEnv [a]
codecRead = \toml :: TOML
toml -> case Codec (NonEmpty a) (NonEmpty a) -> TomlEnv (NonEmpty a)
forall i o. Codec i o -> TomlEnv o
codecRead Codec (NonEmpty a) (NonEmpty a)
nonEmptyCodec TOML
toml of
Success ne :: NonEmpty a
ne -> [a] -> Validation [TomlDecodeError] [a]
forall e a. a -> Validation e a
Success ([a] -> Validation [TomlDecodeError] [a])
-> [a] -> Validation [TomlDecodeError] [a]
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
toList NonEmpty a
ne
Failure [TableArrayNotFound errKey :: Key
errKey]
| Key
errKey Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key -> [a] -> Validation [TomlDecodeError] [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Failure errs :: [TomlDecodeError]
errs -> [TomlDecodeError] -> Validation [TomlDecodeError] [a]
forall e a. e -> Validation e a
Failure [TomlDecodeError]
errs
, codecWrite :: [a] -> TomlState [a]
codecWrite = \case
[] -> [a] -> TomlState [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
l :: [a]
l@(x :: a
x:xs :: [a]
xs) -> [a]
l [a] -> TomlState (NonEmpty a) -> TomlState [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Codec (NonEmpty a) (NonEmpty a)
-> NonEmpty a -> TomlState (NonEmpty a)
forall i o. Codec i o -> i -> TomlState o
codecWrite Codec (NonEmpty a) (NonEmpty a)
nonEmptyCodec (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
}
where
nonEmptyCodec :: TomlCodec (NonEmpty a)
nonEmptyCodec :: Codec (NonEmpty a) (NonEmpty a)
nonEmptyCodec = TomlCodec a -> Key -> Codec (NonEmpty a) (NonEmpty a)
forall a. TomlCodec a -> Key -> TomlCodec (NonEmpty a)
nonEmpty TomlCodec a
codec Key
key
nonEmpty :: forall a . TomlCodec a -> Key -> TomlCodec (NonEmpty a)
nonEmpty :: TomlCodec a -> Key -> TomlCodec (NonEmpty a)
nonEmpty codec :: TomlCodec a
codec key :: Key
key = TomlEnv (NonEmpty a)
-> (NonEmpty a -> TomlState (NonEmpty a)) -> TomlCodec (NonEmpty a)
forall i o. TomlEnv o -> (i -> TomlState o) -> Codec i o
Codec TomlEnv (NonEmpty a)
input NonEmpty a -> TomlState (NonEmpty a)
output
where
input :: TomlEnv (NonEmpty a)
input :: TomlEnv (NonEmpty a)
input = \t :: TOML
t -> case Key -> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML))
-> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
t of
Nothing -> [TomlDecodeError] -> Validation [TomlDecodeError] (NonEmpty a)
forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
TableArrayNotFound Key
key]
Just tomls :: NonEmpty TOML
tomls -> (TOML -> Validation [TomlDecodeError] a)
-> NonEmpty TOML -> Validation [TomlDecodeError] (NonEmpty a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
forall a.
TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors TomlCodec a
codec Key
key) NonEmpty TOML
tomls
output :: NonEmpty a -> TomlState (NonEmpty a)
output :: NonEmpty a -> TomlState (NonEmpty a)
output as :: NonEmpty a
as = do
let tomls :: NonEmpty TOML
tomls = (a -> TOML) -> NonEmpty a -> NonEmpty TOML
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TomlCodec a -> a -> TOML
forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec a
codec) NonEmpty a
as
Maybe (NonEmpty TOML)
mTables <- (TOML -> Maybe (NonEmpty TOML))
-> TomlState (Maybe (NonEmpty TOML))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TOML -> Maybe (NonEmpty TOML))
-> TomlState (Maybe (NonEmpty TOML)))
-> (TOML -> Maybe (NonEmpty TOML))
-> TomlState (Maybe (NonEmpty TOML))
forall a b. (a -> b) -> a -> b
$ Key -> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML))
-> (TOML -> HashMap Key (NonEmpty TOML))
-> TOML
-> Maybe (NonEmpty TOML)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays
let newTomls :: NonEmpty TOML
newTomls = case Maybe (NonEmpty TOML)
mTables of
Nothing -> NonEmpty TOML
tomls
Just oldTomls :: NonEmpty TOML
oldTomls -> NonEmpty TOML
oldTomls NonEmpty TOML -> NonEmpty TOML -> NonEmpty TOML
forall a. Semigroup a => a -> a -> a
<> NonEmpty TOML
tomls
NonEmpty a
as NonEmpty a -> TomlState () -> TomlState (NonEmpty 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 -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key NonEmpty TOML
newTomls)