module Argo.Codec.Value where

import qualified Argo.Codec.Codec as Codec
import qualified Argo.Json.Array as Array
import qualified Argo.Json.Member as Member
import qualified Argo.Json.Name as Name
import qualified Argo.Json.Null as Null
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.Schema as Schema
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

decodeWith :: Value a -> Value.Value -> Either String a
decodeWith :: Value a -> Value -> Either String a
decodeWith Value a
c =
    Identity (Either String a) -> Either String a
forall a. Identity a -> a
Identity.runIdentity (Identity (Either String a) -> Either String a)
-> (Value -> Identity (Either String a))
-> Value
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String Identity a -> Identity (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Trans.runExceptT (ExceptT String Identity a -> Identity (Either String a))
-> (Value -> ExceptT String Identity a)
-> Value
-> Identity (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Value (ExceptT String Identity) a
-> Value -> ExceptT String Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Trans.runReaderT (Value a -> ReaderT Value (ExceptT String Identity) a
forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
Codec.decode Value a
c)

encodeWith :: Value a -> a -> Value.Value
encodeWith :: Value a -> a -> Value
encodeWith Value a
c a
x =
    (Maybe a, Value) -> Value
forall a b. (a, b) -> b
snd
        ((Maybe a, Value) -> Value)
-> (Null -> (Maybe a, Value)) -> Null -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Maybe a, Value) -> (Maybe a, Value)
forall a. Identity a -> a
Identity.runIdentity
        (Identity (Maybe a, Value) -> (Maybe a, Value))
-> (Null -> Identity (Maybe a, Value)) -> Null -> (Maybe a, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Value Identity (Maybe a)
-> Value -> Identity (Maybe a, Value)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Trans.runStateT (MaybeT (StateT Value Identity) a -> StateT Value Identity (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
Trans.runMaybeT (MaybeT (StateT Value Identity) a
 -> StateT Value Identity (Maybe a))
-> MaybeT (StateT Value Identity) a
-> StateT Value Identity (Maybe a)
forall a b. (a -> b) -> a -> b
$ Value a -> a -> MaybeT (StateT Value Identity) a
forall (r :: * -> *) (w :: * -> *) s i o.
Codec r w s i o -> i -> w o
Codec.encode Value a
c a
x)
        (Value -> Identity (Maybe a, Value))
-> (Null -> Value) -> Null -> Identity (Maybe a, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Null -> Value
Value.Null
        (Null -> Value) -> Null -> Value
forall a b. (a -> b) -> a -> b
$ () -> Null
Null.fromUnit ()

type Value a
    = Codec.Codec
          (Trans.ReaderT Value.Value (Trans.ExceptT String Identity.Identity))
          (Trans.MaybeT (Trans.StateT Value.Value Identity.Identity))
          Schema.Schema
          a
          a

arrayCodec :: Value (Array.Array Value.Value)
arrayCodec :: Value (Array Value)
arrayCodec = Codec :: forall (r :: * -> *) (w :: * -> *) s i o.
r o -> (i -> w o) -> s -> Codec r w s i o
Codec.Codec
    { decode :: ReaderT Value (ExceptT String Identity) (Array Value)
Codec.decode = do
        Value
x <- ReaderT Value (ExceptT String Identity) Value
forall (m :: * -> *) r. Monad m => ReaderT r m r
Trans.ask
        case Value
x of
            Value.Array Array Value
y -> Array Value
-> ReaderT Value (ExceptT String Identity) (Array Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Array Value
y
            Value
_ ->
                ExceptT String Identity (Array Value)
-> ReaderT Value (ExceptT String Identity) (Array Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity (Array Value)
 -> ReaderT Value (ExceptT String Identity) (Array Value))
-> (String -> ExceptT String Identity (Array Value))
-> String
-> ReaderT Value (ExceptT String Identity) (Array Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity (Array Value)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> ReaderT Value (ExceptT String Identity) (Array Value))
-> String -> ReaderT Value (ExceptT String Identity) (Array Value)
forall a b. (a -> b) -> a -> b
$ String
"expected Array but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x
    , encode :: Array Value -> MaybeT (StateT Value Identity) (Array Value)
Codec.encode = \Array Value
x -> do
        StateT Value Identity () -> MaybeT (StateT Value Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (StateT Value Identity () -> MaybeT (StateT Value Identity) ())
-> (Value -> StateT Value Identity ())
-> Value
-> MaybeT (StateT Value Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> StateT Value Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put (Value -> MaybeT (StateT Value Identity) ())
-> Value -> MaybeT (StateT Value Identity) ()
forall a b. (a -> b) -> a -> b
$ Array Value -> Value
Value.Array Array Value
x
        Array Value -> MaybeT (StateT Value Identity) (Array Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Array Value
x
    , schema :: Schema
Codec.schema = Schema
Schema.false
    }

objectCodec :: Value (Object.Object Value.Value)
objectCodec :: Value (Object Value)
objectCodec = Codec :: forall (r :: * -> *) (w :: * -> *) s i o.
r o -> (i -> w o) -> s -> Codec r w s i o
Codec.Codec
    { decode :: ReaderT Value (ExceptT String Identity) (Object Value)
Codec.decode = do
        Value
x <- ReaderT Value (ExceptT String Identity) Value
forall (m :: * -> *) r. Monad m => ReaderT r m r
Trans.ask
        case Value
x of
            Value.Object Object Value
y -> Object Value
-> ReaderT Value (ExceptT String Identity) (Object Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object Value
y
            Value
_ ->
                ExceptT String Identity (Object Value)
-> ReaderT Value (ExceptT String Identity) (Object Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
                    (ExceptT String Identity (Object Value)
 -> ReaderT Value (ExceptT String Identity) (Object Value))
-> (String -> ExceptT String Identity (Object Value))
-> String
-> ReaderT Value (ExceptT String Identity) (Object Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity (Object Value)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE
                    (String -> ReaderT Value (ExceptT String Identity) (Object Value))
-> String -> ReaderT Value (ExceptT String Identity) (Object Value)
forall a b. (a -> b) -> a -> b
$ String
"expected Object but got "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x
    , encode :: Object Value -> MaybeT (StateT Value Identity) (Object Value)
Codec.encode = \Object Value
x -> do
        StateT Value Identity () -> MaybeT (StateT Value Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (StateT Value Identity () -> MaybeT (StateT Value Identity) ())
-> (Value -> StateT Value Identity ())
-> Value
-> MaybeT (StateT Value Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> StateT Value Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put (Value -> MaybeT (StateT Value Identity) ())
-> Value -> MaybeT (StateT Value Identity) ()
forall a b. (a -> b) -> a -> b
$ Object Value -> Value
Value.Object Object Value
x
        Object Value -> MaybeT (StateT Value Identity) (Object Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object Value
x
    , schema :: Schema
Codec.schema = Schema
Schema.false
    }

literalCodec :: Value.Value -> Value ()
literalCodec :: Value -> Value ()
literalCodec Value
expected = Codec :: forall (r :: * -> *) (w :: * -> *) s i o.
r o -> (i -> w o) -> s -> Codec r w s i o
Codec.Codec
    { decode :: ReaderT Value (ExceptT String Identity) ()
Codec.decode = do
        Value
actual <- ReaderT Value (ExceptT String Identity) Value
forall (m :: * -> *) r. Monad m => ReaderT r m r
Trans.ask
        Bool
-> ReaderT Value (ExceptT String Identity) ()
-> ReaderT Value (ExceptT String Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Value
actual Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
expected)
            (ReaderT Value (ExceptT String Identity) ()
 -> ReaderT Value (ExceptT String Identity) ())
-> (String -> ReaderT Value (ExceptT String Identity) ())
-> String
-> ReaderT Value (ExceptT String Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String Identity ()
-> ReaderT Value (ExceptT String Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
            (ExceptT String Identity ()
 -> ReaderT Value (ExceptT String Identity) ())
-> (String -> ExceptT String Identity ())
-> String
-> ReaderT Value (ExceptT String Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE
            (String -> ReaderT Value (ExceptT String Identity) ())
-> String -> ReaderT Value (ExceptT String Identity) ()
forall a b. (a -> b) -> a -> b
$ String
"expected "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
expected
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" but got "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
actual
    , encode :: () -> MaybeT (StateT Value Identity) ()
Codec.encode = MaybeT (StateT Value Identity) ()
-> () -> MaybeT (StateT Value Identity) ()
forall a b. a -> b -> a
const (MaybeT (StateT Value Identity) ()
 -> () -> MaybeT (StateT Value Identity) ())
-> (StateT Value Identity () -> MaybeT (StateT Value Identity) ())
-> StateT Value Identity ()
-> ()
-> MaybeT (StateT Value Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Value Identity () -> MaybeT (StateT Value Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (StateT Value Identity ()
 -> () -> MaybeT (StateT Value Identity) ())
-> StateT Value Identity ()
-> ()
-> MaybeT (StateT Value Identity) ()
forall a b. (a -> b) -> a -> b
$ Value -> StateT Value Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put Value
expected
    , schema :: Schema
Codec.schema = 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 -> Schema) -> Object Value -> 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
"const", Value
expected)
        ]
    }