module Argo.Internal.Codec.Object 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.Member as Member
import qualified Argo.Internal.Json.Name as Name
import qualified Argo.Internal.Json.Object as Object
import qualified Argo.Internal.Json.String as String
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.Optional as Optional
import qualified Argo.Internal.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 = Member a a

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

fromObjectCodec :: Permission.Permission -> Object a -> Codec.Value a
fromObjectCodec :: forall a. Permission -> Object a -> Value a
fromObjectCodec =
    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
                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 b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Schema)] -> [Name] -> Maybe Schema -> Schema
Schema.Object
                          (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
                          )
                          (forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
                              (\((Name
k, Bool
r), (Maybe Identifier, Schema)
_) -> if Bool
r then forall a. a -> Maybe a
Just Name
k else forall a. Maybe a
Nothing)
                              [((Name, Bool), (Maybe Identifier, Schema))]
schemas
                          )
                    forall a b. (a -> b) -> a -> b
$ case Permission
permission of
                          Permission
Permission.Allow -> forall a. Maybe a
Nothing
                          Permission
Permission.Forbid -> forall a. a -> Maybe a
Just Schema
Schema.False
            )
        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. Object value -> [Member value]
Object.toList forall value. [Member value] -> Object value
Object.fromList Value (Object Value)
Codec.objectCodec

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

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

tagged :: String -> Codec.Value a -> Codec.Value a
tagged :: forall a. String -> Value a -> Value a
tagged String
t Value a
c =
    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 a b. (a, b) -> b
snd ((,) ())
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Permission -> Object a -> Value a
fromObjectCodec Permission
Permission.Forbid
        forall a b. (a -> b) -> a -> b
$ (,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i f (r :: * -> *) (w :: * -> *) s o.
(i -> f) -> Codec r w s f o -> Codec r w s i o
Codec.project
                forall a b. (a, b) -> a
fst
                (forall a. Name -> Value a -> Object a
required
                    (String -> Name
Name.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"type")
                    (Value -> Value ()
Codec.literalCodec
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Value.String
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText
                    forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
t
                    )
                )
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall i f (r :: * -> *) (w :: * -> *) s o.
(i -> f) -> Codec r w s f o -> Codec r w s i o
Codec.project
                forall a b. (a, b) -> b
snd
                (forall a. Name -> Value a -> Object a
required
                    (String -> Name
Name.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"value")
                    Value a
c
                )