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.Boolean as Boolean
import qualified Argo.Json.Member as Member
import qualified Argo.Json.Name as Name
import qualified Argo.Json.Object as Object
import qualified Argo.Json.String as String
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.Text as Text
import qualified Argo.Vendor.Transformers as Trans
import qualified Data.Functor.Identity as Identity

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))
-> (Object Value -> (Maybe Identifier, Schema))
-> Object Value
-> 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 -> (Maybe Identifier, Schema))
-> (Object Value -> Schema)
-> Object Value
-> (Maybe Identifier, Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Schema
Schema.fromValue
                    (Value -> Schema)
-> (Object Value -> Value) -> Object Value -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object Value -> Value
Value.Object
                    (Object Value
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> Object Value
-> AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema)
forall a b. (a -> b) -> a -> b
$ [Member Value] -> Object Value
forall value. [Member value] -> Object value
Object.fromList
                          [ (Name, Value) -> Member Value
forall value. (Name, value) -> Member value
Member.fromTuple
                              ( String -> Name
Name.fromString (String -> Name) -> (Text -> String) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack
                                  String
"type"
                              , String -> Value
Value.String (String -> Value) -> (Text -> String) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack
                                  String
"array"
                              )
                          , (Name, Value) -> Member Value
forall value. (Name, value) -> Member value
Member.fromTuple
                              ( String -> Name
Name.fromString (String -> Name) -> (Text -> String) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack
                                  String
"items"
                              , Array Value -> Value
Value.Array (Array Value -> Value)
-> ([Value] -> Array Value) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array Value
forall value. [value] -> Array value
Array.fromList ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ ((Maybe Identifier, Schema) -> Value)
-> [(Maybe Identifier, Schema)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                                  (Schema -> Value
Schema.toValue (Schema -> Value)
-> ((Maybe Identifier, Schema) -> Schema)
-> (Maybe Identifier, Schema)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Identifier, Schema) -> Schema
forall a b. (a, b) -> b
snd)
                                  [(Maybe Identifier, Schema)]
schemas
                              )
                          , (Name, Value) -> Member Value
forall value. (Name, value) -> Member value
Member.fromTuple
                              ( String -> Name
Name.fromString (String -> Name) -> (Text -> String) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack
                                  String
"additionalItems"
                              , Boolean -> Value
Value.Boolean
                              (Boolean -> Value) -> (Bool -> Boolean) -> Bool -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Boolean
Boolean.fromBool
                              (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ case Permission
permission of
                                    Permission
Permission.Allow -> Bool
True
                                    Permission
Permission.Forbid -> Bool
False
                              )
                          ]
            )
        (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)])
-> (Either Schema Identifier -> (Maybe Identifier, Schema))
-> Either Schema Identifier
-> [(Maybe Identifier, Schema)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> (Maybe Identifier, Schema)
Schema.unidentified
        (Schema -> (Maybe Identifier, Schema))
-> (Either Schema Identifier -> Schema)
-> Either Schema Identifier
-> (Maybe Identifier, Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Schema
Schema.fromValue
        (Value -> Schema)
-> (Either Schema Identifier -> Value)
-> Either Schema Identifier
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Schema Identifier -> Value
Codec.ref
        (Either Schema Identifier -> [(Maybe Identifier, Schema)])
-> AccumT
     (Map Identifier Schema) Identity (Either Schema Identifier)
-> 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 (Either Schema Identifier)
forall a.
Value a
-> AccumT
     (Map Identifier Schema) Identity (Either Schema Identifier)
Codec.getRef Value a
c
    }