module Argo.Internal.Codec.List where

import qualified Argo.Internal.Codec.Codec as Codec
import qualified Argo.Internal.Codec.Value as Codec
import qualified Argo.Internal.Schema.Identifier as Identifier
import qualified Argo.Internal.Schema.Schema as Schema
import qualified Argo.Internal.Type.Permission as Permission
import qualified Argo.Vendor.Map as Map
import qualified Argo.Vendor.Transformers as Trans
import qualified Control.Monad as Monad
import qualified Data.Functor.Identity as Identity

type List s e a = Item s e a a

type Item s e a b
    = Codec.Codec
          (Trans.StateT [e] (Trans.ExceptT String Identity.Identity))
          (Trans.WriterT [e] Identity.Identity)
          s
          a
          b

fromListCodec
    :: ( Permission.Permission
       -> s
       -> Trans.AccumT
              (Map.Map Identifier.Identifier Schema.Schema)
              Identity.Identity
              (Maybe Identifier.Identifier, Schema.Schema)
       )
    -> Codec.Value [e]
    -> Permission.Permission
    -> List s e a
    -> Codec.Value a
fromListCodec :: forall s e a.
(Permission
 -> s
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> Value [e] -> Permission -> List s e a -> Value a
fromListCodec Permission
-> s
-> AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema)
f Value [e]
ce Permission
p List s e a
ca = Codec.Codec
    { decode :: ReaderT Value (ExceptT String Identity) a
Codec.decode = do
        [e]
xs <- forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
Codec.decode Value [e]
ce
        case
                forall a. Identity a -> a
Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Trans.runExceptT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Trans.runStateT
                    (forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
Codec.decode List s e a
ca)
                    [e]
xs
            of
                Left String
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
x
                Right (a
x, [e]
ys) -> do
                    case (Permission
p, [e]
ys) of
                        (Permission
Permission.Forbid, e
_ : [e]
_) ->
                            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"leftover elements"
                        (Permission, [e])
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    , encode :: a -> MaybeT (StateT Value Identity) a
Codec.encode = \a
x -> do
        forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *) (w :: * -> *) s i o.
Codec r w s i o -> i -> w o
Codec.encode Value [e]
ce
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
Identity.runIdentity
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Trans.runWriterT
            forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) (w :: * -> *) s i o.
Codec r w s i o -> i -> w o
Codec.encode List s e a
ca a
x
        forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    , schema :: AccumT (Map Identifier Schema) Identity (Maybe Identifier, Schema)
Codec.schema = Permission
-> s
-> AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema)
f Permission
p forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s
Codec.schema List s e a
ca
    }