module Argo.Codec.Object 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.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.Optional as Optional
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 Control.Monad as Monad
import qualified Data.Functor.Identity as Identity
import qualified Data.List as List
import qualified Data.Maybe as Maybe

type Object a
    = Codec.List
          ( Trans.AccumT
                (Map.Map Identifier.Identifier Schema.Schema)
                Identity.Identity
                [ ( (Name.Name, Bool)
                  , (Maybe Identifier.Identifier, Schema.Schema)
                  )
                ]
          )
          (Member.Member Value.Value)
          a

fromObjectCodec :: Permission.Permission -> Object a -> Codec.Value a
fromObjectCodec :: Permission -> Object a -> Value a
fromObjectCodec =
    (Permission
 -> AccumT
      (Map Identifier Schema)
      Identity
      [((Name, Bool), (Maybe Identifier, Schema))]
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> Value [Member Value] -> Permission -> Object 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
  [((Name, Bool), (Maybe Identifier, Schema))]
schemasM -> do
                [((Name, Bool), (Maybe Identifier, Schema))]
schemas <- AccumT
  (Map Identifier Schema)
  Identity
  [((Name, Bool), (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))
-> (Maybe Schema -> (Maybe Identifier, Schema))
-> Maybe 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 -> (Maybe Identifier, Schema))
-> (Maybe Schema -> Schema)
-> Maybe Schema
-> (Maybe Identifier, Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Schema)] -> [Name] -> Maybe Schema -> Schema
Schema.Object
                          ((((Name, Bool), (Maybe Identifier, Schema)) -> (Name, Schema))
-> [((Name, Bool), (Maybe Identifier, Schema))] -> [(Name, Schema)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                              (\((Name
k, Bool
_), (Maybe Identifier, Schema)
s) -> (Name
k, (Maybe Identifier, Schema) -> Schema
Schema.maybeRef (Maybe Identifier, Schema)
s))
                              [((Name, Bool), (Maybe Identifier, Schema))]
schemas
                          )
                          ((((Name, Bool), (Maybe Identifier, Schema)) -> Maybe Name)
-> [((Name, Bool), (Maybe Identifier, Schema))] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
                              (\((Name
k, Bool
r), (Maybe Identifier, Schema)
_) -> if Bool
r then Name -> Maybe Name
forall a. a -> Maybe a
Just Name
k else Maybe Name
forall a. Maybe a
Nothing)
                              [((Name, Bool), (Maybe Identifier, Schema))]
schemas
                          )
                    (Maybe Schema
 -> AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
-> Maybe Schema
-> AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema)
forall a b. (a -> b) -> a -> b
$ case Permission
permission of
                          Permission
Permission.Allow -> Maybe Schema
forall a. Maybe a
Nothing
                          Permission
Permission.Forbid -> Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
Schema.False
            )
        (Value [Member Value] -> Permission -> Object a -> Value a)
-> Value [Member Value] -> Permission -> Object a -> Value a
forall a b. (a -> b) -> a -> b
$ (Object Value -> [Member Value])
-> ([Member Value] -> Object Value)
-> Codec
     (ReaderT Value (ExceptT String Identity))
     (MaybeT (StateT Value Identity))
     (AccumT
        (Map Identifier Schema) Identity (Maybe Identifier, Schema))
     (Object Value)
     (Object Value)
-> Value [Member 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 Object Value -> [Member Value]
forall value. Object value -> [Member value]
Object.toList [Member Value] -> Object Value
forall value. [Member value] -> Object value
Object.fromList Codec
  (ReaderT Value (ExceptT String Identity))
  (MaybeT (StateT Value Identity))
  (AccumT
     (Map Identifier Schema) Identity (Maybe Identifier, Schema))
  (Object Value)
  (Object Value)
Codec.objectCodec

required :: Name.Name -> Codec.Value a -> Object a
required :: Name -> Value a -> Object a
required Name
k 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 [Member Value] (ExceptT String Identity) a
Codec.decode = do
        Optional a
m <- Codec
  (StateT [Member Value] (ExceptT String Identity))
  (WriterT [Member Value] Identity)
  (AccumT
     (Map Identifier Schema)
     Identity
     [((Name, Bool), (Maybe Identifier, Schema))])
  (Optional a)
  (Optional a)
-> StateT [Member Value] (ExceptT String Identity) (Optional a)
forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
Codec.decode (Name
-> Value a
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     (Optional a)
     (Optional a)
forall a. Name -> Value a -> Object (Optional a)
optional Name
k Value a
c)
        case Optional a -> Maybe a
forall a. Optional a -> Maybe a
Optional.toMaybe Optional a
m of
            Maybe a
Nothing ->
                ExceptT String Identity a
-> StateT [Member 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 [Member Value] (ExceptT String Identity) a)
-> (String -> ExceptT String Identity a)
-> String
-> StateT [Member Value] (ExceptT String Identity) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE
                    (String -> StateT [Member Value] (ExceptT String Identity) a)
-> String -> StateT [Member Value] (ExceptT String Identity) a
forall a b. (a -> b) -> a -> b
$ String
"missing required member: "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
k
            Just a
x -> a -> StateT [Member Value] (ExceptT String Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    , encode :: a -> WriterT [Member Value] Identity a
Codec.encode = \a
x -> do
        WriterT [Member Value] Identity (Optional a)
-> WriterT [Member Value] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (WriterT [Member Value] Identity (Optional a)
 -> WriterT [Member Value] Identity ())
-> (Optional a -> WriterT [Member Value] Identity (Optional a))
-> Optional a
-> WriterT [Member Value] Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codec
  (StateT [Member Value] (ExceptT String Identity))
  (WriterT [Member Value] Identity)
  (AccumT
     (Map Identifier Schema)
     Identity
     [((Name, Bool), (Maybe Identifier, Schema))])
  (Optional a)
  (Optional a)
-> Optional a -> WriterT [Member Value] Identity (Optional a)
forall (r :: * -> *) (w :: * -> *) s i o.
Codec r w s i o -> i -> w o
Codec.encode (Name
-> Value a
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     (Optional a)
     (Optional a)
forall a. Name -> Value a -> Object (Optional a)
optional Name
k Value a
c) (Optional a -> WriterT [Member Value] Identity ())
-> Optional a -> WriterT [Member Value] Identity ()
forall a b. (a -> b) -> a -> b
$ a -> Optional a
forall a. a -> Optional a
Optional.just a
x
        a -> WriterT [Member Value] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    , schema :: AccumT
  (Map Identifier Schema)
  Identity
  [((Name, Bool), (Maybe Identifier, Schema))]
Codec.schema =
        ((Name, Bool), (Maybe Identifier, Schema))
-> [((Name, Bool), (Maybe Identifier, Schema))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Name, Bool), (Maybe Identifier, Schema))
 -> [((Name, Bool), (Maybe Identifier, Schema))])
-> (Schema -> ((Name, Bool), (Maybe Identifier, Schema)))
-> Schema
-> [((Name, Bool), (Maybe Identifier, Schema))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Name
k, Bool
True) ((Maybe Identifier, Schema)
 -> ((Name, Bool), (Maybe Identifier, Schema)))
-> (Schema -> (Maybe Identifier, Schema))
-> Schema
-> ((Name, Bool), (Maybe Identifier, Schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> (Maybe Identifier, Schema)
Schema.unidentified (Schema -> [((Name, Bool), (Maybe Identifier, Schema))])
-> AccumT (Map Identifier Schema) Identity Schema
-> AccumT
     (Map Identifier Schema)
     Identity
     [((Name, Bool), (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
    }

optional :: Name.Name -> Codec.Value a -> Object (Optional.Optional a)
optional :: Name -> Value a -> Object (Optional a)
optional Name
k 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 [Member Value] (ExceptT String Identity) (Optional a)
Codec.decode = do
        [Member Value]
xs <- StateT [Member Value] (ExceptT String Identity) [Member Value]
forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
        case (Member Value -> Bool)
-> [Member Value] -> ([Member Value], [Member Value])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (\(Member.Member Name
j Value
_) -> Name
j Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
k) [Member Value]
xs of
            (Member.Member Name
_ Value
x : [Member Value]
_, [Member Value]
ys) -> case Value a -> Value -> Either String a
forall a. Value a -> Value -> Either String a
Codec.decodeWith Value a
c Value
x of
                Left String
y -> ExceptT String Identity (Optional a)
-> StateT [Member Value] (ExceptT String Identity) (Optional a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity (Optional a)
 -> StateT [Member Value] (ExceptT String Identity) (Optional a))
-> ExceptT String Identity (Optional a)
-> StateT [Member Value] (ExceptT String Identity) (Optional a)
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String Identity (Optional a)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
y
                Right a
y -> do
                    [Member Value]
-> StateT [Member Value] (ExceptT String Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put [Member Value]
ys
                    Optional a
-> StateT [Member Value] (ExceptT String Identity) (Optional a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Optional a
 -> StateT [Member Value] (ExceptT String Identity) (Optional a))
-> Optional a
-> StateT [Member Value] (ExceptT String Identity) (Optional a)
forall a b. (a -> b) -> a -> b
$ a -> Optional a
forall a. a -> Optional a
Optional.just a
y
            ([Member Value], [Member Value])
_ -> Optional a
-> StateT [Member Value] (ExceptT String Identity) (Optional a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Optional a
forall a. Optional a
Optional.nothing
    , encode :: Optional a -> WriterT [Member Value] Identity (Optional a)
Codec.encode = \Optional a
x -> do
        case Optional a -> Maybe a
forall a. Optional a -> Maybe a
Optional.toMaybe Optional a
x of
            Maybe a
Nothing -> () -> WriterT [Member Value] Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just a
y -> [Member Value] -> WriterT [Member Value] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell [Name -> Value -> Member Value
forall value. Name -> value -> Member value
Member.Member Name
k (Value -> Member Value) -> Value -> Member Value
forall a b. (a -> b) -> a -> b
$ Value a -> a -> Value
forall a. Value a -> a -> Value
Codec.encodeWith Value a
c a
y]
        Optional a -> WriterT [Member Value] Identity (Optional a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Optional a
x
    , schema :: AccumT
  (Map Identifier Schema)
  Identity
  [((Name, Bool), (Maybe Identifier, Schema))]
Codec.schema =
        ((Name, Bool), (Maybe Identifier, Schema))
-> [((Name, Bool), (Maybe Identifier, Schema))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Name, Bool), (Maybe Identifier, Schema))
 -> [((Name, Bool), (Maybe Identifier, Schema))])
-> (Schema -> ((Name, Bool), (Maybe Identifier, Schema)))
-> Schema
-> [((Name, Bool), (Maybe Identifier, Schema))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Name
k, Bool
False) ((Maybe Identifier, Schema)
 -> ((Name, Bool), (Maybe Identifier, Schema)))
-> (Schema -> (Maybe Identifier, Schema))
-> Schema
-> ((Name, Bool), (Maybe Identifier, Schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> (Maybe Identifier, Schema)
Schema.unidentified (Schema -> [((Name, Bool), (Maybe Identifier, Schema))])
-> AccumT (Map Identifier Schema) Identity Schema
-> AccumT
     (Map Identifier Schema)
     Identity
     [((Name, Bool), (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
    }

tagged :: String -> Codec.Value a -> Codec.Value a
tagged :: String -> Value a -> Value a
tagged String
t Value a
c =
    (((), a) -> a)
-> (a -> ((), a))
-> Codec
     (ReaderT Value (ExceptT String Identity))
     (MaybeT (StateT Value Identity))
     (AccumT
        (Map Identifier Schema) Identity (Maybe Identifier, Schema))
     ((), a)
     ((), a)
-> Value a
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 ((), a) -> a
forall a b. (a, b) -> b
snd ((,) ())
        (Codec
   (ReaderT Value (ExceptT String Identity))
   (MaybeT (StateT Value Identity))
   (AccumT
      (Map Identifier Schema) Identity (Maybe Identifier, Schema))
   ((), a)
   ((), a)
 -> Value a)
-> (Object ((), a)
    -> Codec
         (ReaderT Value (ExceptT String Identity))
         (MaybeT (StateT Value Identity))
         (AccumT
            (Map Identifier Schema) Identity (Maybe Identifier, Schema))
         ((), a)
         ((), a))
-> Object ((), a)
-> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permission
-> Object ((), a)
-> Codec
     (ReaderT Value (ExceptT String Identity))
     (MaybeT (StateT Value Identity))
     (AccumT
        (Map Identifier Schema) Identity (Maybe Identifier, Schema))
     ((), a)
     ((), a)
forall a. Permission -> Object a -> Value a
fromObjectCodec Permission
Permission.Forbid
        (Object ((), a) -> Value a) -> Object ((), a) -> Value a
forall a b. (a -> b) -> a -> b
$ (,)
        (() -> a -> ((), a))
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     ((), a)
     ()
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     ((), a)
     (a -> ((), a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((), a) -> ())
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     ()
     ()
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     ((), a)
     ()
forall i f (r :: * -> *) (w :: * -> *) s o.
(i -> f) -> Codec r w s f o -> Codec r w s i o
Codec.project
                ((), a) -> ()
forall a b. (a, b) -> a
fst
                (Name
-> Value ()
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     ()
     ()
forall a. Name -> Value a -> Object a
required
                    (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")
                    (Value -> Value ()
Codec.literalCodec
                    (Value -> Value ()) -> (Text -> Value) -> Text -> Value ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
t
                    )
                )
        Codec
  (StateT [Member Value] (ExceptT String Identity))
  (WriterT [Member Value] Identity)
  (AccumT
     (Map Identifier Schema)
     Identity
     [((Name, Bool), (Maybe Identifier, Schema))])
  ((), a)
  (a -> ((), a))
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     ((), a)
     a
-> Object ((), a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((), a) -> a)
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     a
     a
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     ((), a)
     a
forall i f (r :: * -> *) (w :: * -> *) s o.
(i -> f) -> Codec r w s f o -> Codec r w s i o
Codec.project
                ((), a) -> a
forall a b. (a, b) -> b
snd
                (Name
-> Value a
-> Codec
     (StateT [Member Value] (ExceptT String Identity))
     (WriterT [Member Value] Identity)
     (AccumT
        (Map Identifier Schema)
        Identity
        [((Name, Bool), (Maybe Identifier, Schema))])
     a
     a
forall a. Name -> Value a -> Object a
required
                    (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
"value")
                    Value a
c
                )