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 = forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall i o. Codec i o -> TomlEnv o
codecRead TomlCodec (NonEmpty a)
nonEmptyCodec TOML
toml of
Success NonEmpty a
ne -> forall e a. a -> Validation e a
Success forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty a
ne
Failure [TableArrayNotFound Key
errKey]
| Key
errKey forall a. Eq a => a -> a -> Bool
== Key
key -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Failure [TomlDecodeError]
errs -> forall e a. e -> Validation e a
Failure [TomlDecodeError]
errs
, codecWrite :: [a] -> TomlState [a]
codecWrite = \case
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
l :: [a]
l@(a
x:[a]
xs) -> [a]
l forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall i o. Codec i o -> i -> TomlState o
codecWrite TomlCodec (NonEmpty a)
nonEmptyCodec (a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
}
where
nonEmptyCodec :: TomlCodec (NonEmpty a)
nonEmptyCodec :: TomlCodec (NonEmpty a)
nonEmptyCodec = 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 = 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 forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
t of
Maybe (NonEmpty TOML)
Nothing -> forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
TableArrayNotFound Key
key]
Just NonEmpty TOML
tomls -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec a
codec) NonEmpty a
as
Maybe (NonEmpty TOML)
mTables <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key 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 forall a. Semigroup a => a -> a -> a
<> NonEmpty TOML
tomls
NonEmpty a
as forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key NonEmpty TOML
newTomls)