module Argo.Codec.Array where

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

type Array a
    = Codec.List
          ( Trans.AccumT
                (Map.Map Identifier.Identifier Schema.Schema)
                Identity.Identity
                [(Maybe Identifier.Identifier, Schema.Schema)]
          )
          Value.Value
          a

fromArrayCodec :: Permission.Permission -> Array a -> Codec.Value a
fromArrayCodec :: Permission -> Array a -> Value a
fromArrayCodec =
    (Permission
 -> AccumT
      (Map Identifier Schema) Identity [(Maybe Identifier, Schema)]
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> Value [Value] -> Permission -> Array a -> Value a
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
                (Maybe Identifier, Schema)
-> AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Identifier, Schema)
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> (Schema -> (Maybe Identifier, Schema))
-> Schema
-> AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> (Maybe Identifier, Schema)
Schema.unidentified (Schema
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> Schema
-> AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema)
forall a b. (a -> b) -> a -> b
$ Maybe Natural
-> Maybe Natural
-> Either Schema (NonEmpty Schema)
-> Maybe Schema
-> Schema
Schema.Array
                    (Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural)
-> (Int -> Natural) -> Int -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Natural) -> Int -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ [(Maybe Identifier, Schema)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe Identifier, Schema)]
schemas)
                    (case Permission
permission of
                        Permission
Permission.Allow -> Maybe Natural
forall a. Maybe a
Nothing
                        Permission
Permission.Forbid ->
                            Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural)
-> (Int -> Natural) -> Int -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Maybe Natural) -> Int -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ [(Maybe Identifier, Schema)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe Identifier, Schema)]
schemas
                    )
                    (case [Schema] -> Maybe (NonEmpty Schema)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([Schema] -> Maybe (NonEmpty Schema))
-> [Schema] -> Maybe (NonEmpty Schema)
forall a b. (a -> b) -> a -> b
$ ((Maybe Identifier, Schema) -> Schema)
-> [(Maybe Identifier, Schema)] -> [Schema]
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 -> Schema -> Either Schema (NonEmpty Schema)
forall a b. a -> Either a b
Left Schema
Schema.False
                        Just NonEmpty Schema
xs -> NonEmpty Schema -> Either Schema (NonEmpty Schema)
forall a b. b -> Either a b
Right NonEmpty Schema
xs
                    )
                    Maybe Schema
forall a. Maybe a
Nothing
            )
        (Value [Value] -> Permission -> Array a -> Value a)
-> Value [Value] -> Permission -> Array a -> Value a
forall a b. (a -> b) -> a -> b
$ (Array Value -> [Value])
-> ([Value] -> Array Value)
-> Codec
     (ReaderT Value (ExceptT String Identity))
     (MaybeT (StateT Value Identity))
     (AccumT
        (Map Identifier Schema) Identity (Maybe Identifier, Schema))
     (Array Value)
     (Array Value)
-> Value [Value]
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 Array Value -> [Value]
forall value. Array value -> [value]
Array.toList [Value] -> Array Value
forall value. [value] -> Array value
Array.fromList Codec
  (ReaderT Value (ExceptT String Identity))
  (MaybeT (StateT Value Identity))
  (AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema))
  (Array Value)
  (Array Value)
Codec.arrayCodec

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