module Argo.Internal.Codec.Array where

import qualified Argo.Internal.Codec.Codec as Codec
import qualified Argo.Internal.Codec.List as Codec
import qualified Argo.Internal.Codec.Value as Codec
import qualified Argo.Internal.Json.Array as Array
import qualified Argo.Internal.Json.Value as Value
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 Data.Functor.Identity as Identity
import qualified Data.List.NonEmpty as NonEmpty

type Array a = Element a a

type Element a b
    = Codec.Item
          ( Trans.AccumT
                (Map.Map Identifier.Identifier Schema.Schema)
                Identity.Identity
                [(Maybe Identifier.Identifier, Schema.Schema)]
          )
          Value.Value
          a
          b

fromArrayCodec :: Permission.Permission -> Array a -> Codec.Value a
fromArrayCodec :: forall a. Permission -> Array a -> Value a
fromArrayCodec =
    forall s e a.
(Permission
 -> s
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> Value [e] -> Permission -> List s e a -> Value a
Codec.fromListCodec
            (\Permission
permission AccumT
  (Map Identifier Schema) Identity [(Maybe Identifier, Schema)]
schemasM -> do
                [(Maybe Identifier, Schema)]
schemas <- AccumT
  (Map Identifier Schema) Identity [(Maybe Identifier, Schema)]
schemasM
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> (Maybe Identifier, Schema)
Schema.unidentified forall a b. (a -> b) -> a -> b
$ Maybe Natural
-> Maybe Natural
-> Either Schema (NonEmpty Schema)
-> Maybe Schema
-> Schema
Schema.Array
                    (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe Identifier, Schema)]
schemas)
                    (case Permission
permission of
                        Permission
Permission.Allow -> forall a. Maybe a
Nothing
                        Permission
Permission.Forbid ->
                            forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe Identifier, Schema)]
schemas
                    )
                    (case forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Identifier, Schema) -> Schema
Schema.maybeRef [(Maybe Identifier, Schema)]
schemas of
                        Maybe (NonEmpty Schema)
Nothing -> forall a b. a -> Either a b
Left Schema
Schema.False
                        Just NonEmpty Schema
xs -> forall a b. b -> Either a b
Right NonEmpty Schema
xs
                    )
                    forall a. Maybe a
Nothing
            )
        forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) (w :: * -> *) a b s.
(Functor r, Functor w) =>
(a -> b) -> (b -> a) -> Codec r w s a a -> Codec r w s b b
Codec.map forall value. Array value -> [value]
Array.toList forall value. [value] -> Array value
Array.fromList Value (Array Value)
Codec.arrayCodec

element :: Codec.Value a -> Array a
element :: forall a. Value a -> Array a
element Value a
c = Codec.Codec
    { decode :: StateT [Value] (ExceptT String Identity) a
Codec.decode = do
        [Value]
l <- forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
        case [Value]
l of
            [] -> 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
"unexpected empty list"
            Value
h : [Value]
t -> case forall a. Value a -> Value -> Either String a
Codec.decodeWith Value a
c Value
h of
                Left String
y -> 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
y
                Right a
y -> do
                    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put [Value]
t
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
y
    , encode :: a -> WriterT [Value] Identity a
Codec.encode = \a
x -> do
        forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell [forall a. Value a -> a -> Value
Codec.encodeWith Value a
c a
x]
        forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    , schema :: AccumT
  (Map Identifier Schema) Identity [(Maybe Identifier, Schema)]
Codec.schema = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> (Maybe Identifier, Schema)
Schema.unidentified forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Value a -> AccumT (Map Identifier Schema) Identity Schema
Codec.getRef Value a
c
    }