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 :: forall a. 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 :: forall a. 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 :: forall a. TomlCodec a -> Key -> TomlCodec [a]
list TomlCodec a
codec Key
key = Codec
{ codecRead :: TomlEnv [a]
codecRead = \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 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 Key
errKey]
| Key
errKey Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key -> [a] -> Validation [TomlDecodeError] [a]
forall a. a -> Validation [TomlDecodeError] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Failure [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 a. a -> TomlState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
l :: [a]
l@(a
x:[a]
xs) -> [a]
l [a] -> TomlState (NonEmpty a) -> TomlState [a]
forall a b. a -> TomlState b -> 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 :: forall a. TomlCodec a -> Key -> TomlCodec (NonEmpty a)
nonEmpty TomlCodec a
codec Key
key = TomlEnv (NonEmpty a)
-> (NonEmpty a -> TomlState (NonEmpty a))
-> Codec (NonEmpty a) (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 = \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
Maybe (NonEmpty TOML)
Nothing -> [TomlDecodeError] -> Validation [TomlDecodeError] (NonEmpty a)
forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
TableArrayNotFound Key
key]
Just 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty 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 NonEmpty a
as = do
let tomls :: NonEmpty TOML
tomls = (a -> TOML) -> NonEmpty a -> NonEmpty TOML
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
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
Maybe (NonEmpty TOML)
Nothing -> NonEmpty TOML
tomls
Just 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 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 -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key NonEmpty TOML
newTomls)