module Argo.Codec.List where

import qualified Argo.Codec.Codec as Codec
import qualified Argo.Codec.Value as Codec
import qualified Argo.Schema.Schema as Schema
import qualified Argo.Type.Permission as Permission
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 -> Schema.Schema)
    -> Codec.Value [e]
    -> Permission.Permission
    -> List s e a
    -> Codec.Value a
fromListCodec :: (Permission -> s -> Schema)
-> Value [e] -> Permission -> List s e a -> Value a
fromListCodec Permission -> s -> 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 :: Schema
Codec.schema = Permission -> s -> Schema
f Permission
p (s -> Schema) -> s -> 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
    }