module Argo.Codec.List where

import qualified Argo.Codec.Codec as Codec
import qualified Argo.Codec.Value as Codec
import qualified Argo.Schema.Identifier as Identifier
import qualified Argo.Schema.Schema as Schema
import qualified Argo.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
    = Codec.Codec
          (Trans.StateT [e] (Trans.ExceptT String Identity.Identity))
          (Trans.WriterT [e] Identity.Identity)
          s
          a
          a

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