module Argo.Codec where

import Control.Applicative ((<|>))

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.Null as Null
import qualified Argo.Json.Number as Number
import qualified Argo.Json.Object as Object
import qualified Argo.Json.String as String
import qualified Argo.Json.Value as Value
import qualified Argo.Result as Result
import qualified Argo.Vendor.Transformers as Trans
import qualified Control.Applicative as Applicative
import qualified Control.Monad as Monad
import qualified Data.Functor.Identity as Identity
import qualified Data.Text as Text

decodeWith :: ValueCodec a -> Value.Value -> Result.Result a
decodeWith :: ValueCodec a -> Value -> Result a
decodeWith ValueCodec a
c = (String -> Result a)
-> (a -> Result a) -> Either String a -> Result a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either String a -> Result a)
-> (Value -> Either String a) -> Value -> Result a
forall b c a. (b -> c) -> (a -> b) -> 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 (ValueCodec a -> ReaderT Value (ExceptT String Identity) a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode ValueCodec a
c)

encodeWith :: ValueCodec a -> a -> Value.Value
encodeWith :: ValueCodec a -> a -> Value
encodeWith ValueCodec 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
$ ValueCodec a -> a -> MaybeT (StateT Value Identity) a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode ValueCodec 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 ()

project :: (i -> f) -> CodecOf r w f o -> CodecOf r w i o
project :: (i -> f) -> CodecOf r w f o -> CodecOf r w i o
project i -> f
f CodecOf r w f o
c = CodecOf r w f o
c { encode :: i -> w o
encode = CodecOf r w f o -> f -> w o
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode CodecOf r w f o
c (f -> w o) -> (i -> f) -> i -> w o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> f
f }

data CodecOf r w i o = Codec
    { CodecOf r w i o -> r o
decode :: r o
    , CodecOf r w i o -> i -> w o
encode :: i -> w o
    }

instance (Functor r, Functor w) => Functor (CodecOf r w i) where
    fmap :: (a -> b) -> CodecOf r w i a -> CodecOf r w i b
fmap a -> b
f CodecOf r w i a
c = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
        { decode :: r b
decode = (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (r a -> r b) -> r a -> r b
forall a b. (a -> b) -> a -> b
$ CodecOf r w i a -> r a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode CodecOf r w i a
c
        , encode :: i -> w b
encode = (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (w a -> w b) -> (i -> w a) -> i -> w b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecOf r w i a -> i -> w a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode CodecOf r w i a
c
        }

instance (Applicative r, Applicative w) => Applicative (CodecOf r w i) where
    pure :: a -> CodecOf r w i a
pure a
x = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
        { decode :: r a
decode = a -> r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        , encode :: i -> w a
encode = w a -> i -> w a
forall a b. a -> b -> a
const (w a -> i -> w a) -> w a -> i -> w a
forall a b. (a -> b) -> a -> b
$ a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        }
    CodecOf r w i (a -> b)
cf <*> :: CodecOf r w i (a -> b) -> CodecOf r w i a -> CodecOf r w i b
<*> CodecOf r w i a
cx = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
        { decode :: r b
decode = CodecOf r w i (a -> b) -> r (a -> b)
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode CodecOf r w i (a -> b)
cf r (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CodecOf r w i a -> r a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode CodecOf r w i a
cx
        , encode :: i -> w b
encode = \ i
i -> CodecOf r w i (a -> b) -> i -> w (a -> b)
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode CodecOf r w i (a -> b)
cf i
i w (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CodecOf r w i a -> i -> w a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode CodecOf r w i a
cx i
i
        }

instance (Applicative.Alternative r, Applicative.Alternative w) => Applicative.Alternative (CodecOf r w i) where
    empty :: CodecOf r w i a
empty = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
        { decode :: r a
decode = r a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
        , encode :: i -> w a
encode = w a -> i -> w a
forall a b. a -> b -> a
const w a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
        }
    CodecOf r w i a
cx <|> :: CodecOf r w i a -> CodecOf r w i a -> CodecOf r w i a
<|> CodecOf r w i a
cy = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
        { decode :: r a
decode = CodecOf r w i a -> r a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode CodecOf r w i a
cx r a -> r a -> r a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodecOf r w i a -> r a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode CodecOf r w i a
cy
        , encode :: i -> w a
encode = \ i
i -> CodecOf r w i a -> i -> w a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode CodecOf r w i a
cx i
i w a -> w a -> w a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodecOf r w i a -> i -> w a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode CodecOf r w i a
cy i
i
        }

type Codec r w a = CodecOf r w a a

dimap :: (Functor r, Functor w) => (a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap :: (a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap a -> b
f b -> a
g Codec r w a
c = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: r b
decode = (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (r a -> r b) -> r a -> r b
forall a b. (a -> b) -> a -> b
$ Codec r w a -> r a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode Codec r w a
c
    , encode :: b -> w b
encode = (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (w a -> w b) -> (b -> w a) -> b -> w b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codec r w a -> a -> w a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode Codec r w a
c (a -> w a) -> (b -> a) -> b -> w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g
    }

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

valueCodec :: ValueCodec Value.Value
valueCodec :: ValueCodec Value
valueCodec = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) Value
decode = ReaderT Value (ExceptT String Identity) Value
forall (m :: * -> *) r. Monad m => ReaderT r m r
Trans.ask
    , encode :: Value -> MaybeT (StateT Value Identity) Value
encode = \ 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) ())
-> 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
x
        Value -> MaybeT (StateT Value Identity) Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
x
    }

nullCodec :: ValueCodec Null.Null
nullCodec :: ValueCodec Null
nullCodec = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) Null
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.Null Null
y -> Null -> ReaderT Value (ExceptT String Identity) Null
forall (f :: * -> *) a. Applicative f => a -> f a
pure Null
y
            Value
_ -> ExceptT String Identity Null
-> ReaderT Value (ExceptT String Identity) Null
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity Null
 -> ReaderT Value (ExceptT String Identity) Null)
-> (String -> ExceptT String Identity Null)
-> String
-> ReaderT Value (ExceptT String Identity) Null
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity Null
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> ReaderT Value (ExceptT String Identity) Null)
-> String -> ReaderT Value (ExceptT String Identity) Null
forall a b. (a -> b) -> a -> b
$ String
"expected Null but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x
    , encode :: Null -> MaybeT (StateT Value Identity) Null
encode = \ Null
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
$ Null -> Value
Value.Null Null
x
        Null -> MaybeT (StateT Value Identity) Null
forall (f :: * -> *) a. Applicative f => a -> f a
pure Null
x
    }

booleanCodec :: ValueCodec Boolean.Boolean
booleanCodec :: ValueCodec Boolean
booleanCodec = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) Boolean
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.Boolean Boolean
y -> Boolean -> ReaderT Value (ExceptT String Identity) Boolean
forall (f :: * -> *) a. Applicative f => a -> f a
pure Boolean
y
            Value
_ -> ExceptT String Identity Boolean
-> ReaderT Value (ExceptT String Identity) Boolean
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity Boolean
 -> ReaderT Value (ExceptT String Identity) Boolean)
-> (String -> ExceptT String Identity Boolean)
-> String
-> ReaderT Value (ExceptT String Identity) Boolean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity Boolean
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> ReaderT Value (ExceptT String Identity) Boolean)
-> String -> ReaderT Value (ExceptT String Identity) Boolean
forall a b. (a -> b) -> a -> b
$ String
"expected Boolean but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x
    , encode :: Boolean -> MaybeT (StateT Value Identity) Boolean
encode = \ Boolean
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
$ Boolean -> Value
Value.Boolean Boolean
x
        Boolean -> MaybeT (StateT Value Identity) Boolean
forall (f :: * -> *) a. Applicative f => a -> f a
pure Boolean
x
    }

numberCodec :: ValueCodec Number.Number
numberCodec :: ValueCodec Number
numberCodec = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) Number
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.Number Number
y -> Number -> ReaderT Value (ExceptT String Identity) Number
forall (f :: * -> *) a. Applicative f => a -> f a
pure Number
y
            Value
_ -> ExceptT String Identity Number
-> ReaderT Value (ExceptT String Identity) Number
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity Number
 -> ReaderT Value (ExceptT String Identity) Number)
-> (String -> ExceptT String Identity Number)
-> String
-> ReaderT Value (ExceptT String Identity) Number
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity Number
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> ReaderT Value (ExceptT String Identity) Number)
-> String -> ReaderT Value (ExceptT String Identity) Number
forall a b. (a -> b) -> a -> b
$ String
"expected Number but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x
    , encode :: Number -> MaybeT (StateT Value Identity) Number
encode = \ Number
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
$ Number -> Value
Value.Number Number
x
        Number -> MaybeT (StateT Value Identity) Number
forall (f :: * -> *) a. Applicative f => a -> f a
pure Number
x
    }

stringCodec :: ValueCodec String.String
stringCodec :: ValueCodec String
stringCodec = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) String
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.String String
y -> String -> ReaderT Value (ExceptT String Identity) String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
y
            Value
_ -> ExceptT String Identity String
-> ReaderT Value (ExceptT String Identity) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity String
 -> ReaderT Value (ExceptT String Identity) String)
-> (String -> ExceptT String Identity String)
-> String
-> ReaderT Value (ExceptT String Identity) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity String
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> ReaderT Value (ExceptT String Identity) String)
-> String -> ReaderT Value (ExceptT String Identity) String
forall a b. (a -> b) -> a -> b
$ String
"expected String but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x
    , encode :: String -> MaybeT (StateT Value Identity) String
encode = \ String
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
$ String -> Value
Value.String String
x
        String -> MaybeT (StateT Value Identity) String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x
    }

arrayCodec :: ValueCodec (Array.ArrayOf Value.Value)
arrayCodec :: ValueCodec (ArrayOf Value)
arrayCodec = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) (ArrayOf Value)
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 ArrayOf Value
y -> ArrayOf Value
-> ReaderT Value (ExceptT String Identity) (ArrayOf Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArrayOf Value
y
            Value
_ -> ExceptT String Identity (ArrayOf Value)
-> ReaderT Value (ExceptT String Identity) (ArrayOf Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity (ArrayOf Value)
 -> ReaderT Value (ExceptT String Identity) (ArrayOf Value))
-> (String -> ExceptT String Identity (ArrayOf Value))
-> String
-> ReaderT Value (ExceptT String Identity) (ArrayOf Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity (ArrayOf Value)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String -> ReaderT Value (ExceptT String Identity) (ArrayOf Value))
-> String
-> ReaderT Value (ExceptT String Identity) (ArrayOf 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 :: ArrayOf Value -> MaybeT (StateT Value Identity) (ArrayOf Value)
encode = \ ArrayOf 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
$ ArrayOf Value -> Value
Value.Array ArrayOf Value
x
        ArrayOf Value -> MaybeT (StateT Value Identity) (ArrayOf Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArrayOf Value
x
    }

objectCodec :: ValueCodec (Object.ObjectOf Value.Value)
objectCodec :: ValueCodec (ObjectOf Value)
objectCodec = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) (ObjectOf Value)
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 ObjectOf Value
y -> ObjectOf Value
-> ReaderT Value (ExceptT String Identity) (ObjectOf Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectOf Value
y
            Value
_ -> ExceptT String Identity (ObjectOf Value)
-> ReaderT Value (ExceptT String Identity) (ObjectOf Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity (ObjectOf Value)
 -> ReaderT Value (ExceptT String Identity) (ObjectOf Value))
-> (String -> ExceptT String Identity (ObjectOf Value))
-> String
-> ReaderT Value (ExceptT String Identity) (ObjectOf Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExceptT String Identity (ObjectOf Value)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE (String
 -> ReaderT Value (ExceptT String Identity) (ObjectOf Value))
-> String
-> ReaderT Value (ExceptT String Identity) (ObjectOf 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 :: ObjectOf Value -> MaybeT (StateT Value Identity) (ObjectOf Value)
encode = \ ObjectOf 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
$ ObjectOf Value -> Value
Value.Object ObjectOf Value
x
        ObjectOf Value -> MaybeT (StateT Value Identity) (ObjectOf Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectOf Value
x
    }

boolCodec :: ValueCodec Bool
boolCodec :: ValueCodec Bool
boolCodec = (Boolean -> Bool)
-> (Bool -> Boolean) -> ValueCodec Boolean -> ValueCodec Bool
forall (r :: * -> *) (w :: * -> *) a b.
(Functor r, Functor w) =>
(a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap Boolean -> Bool
Boolean.toBool Bool -> Boolean
Boolean.fromBool ValueCodec Boolean
booleanCodec

textCodec :: ValueCodec Text.Text
textCodec :: ValueCodec Text
textCodec = (String -> Text)
-> (Text -> String) -> ValueCodec String -> ValueCodec Text
forall (r :: * -> *) (w :: * -> *) a b.
(Functor r, Functor w) =>
(a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap String -> Text
String.toText Text -> String
String.fromText ValueCodec String
stringCodec

maybeCodec :: ValueCodec a -> ValueCodec (Maybe a)
maybeCodec :: ValueCodec a -> ValueCodec (Maybe a)
maybeCodec ValueCodec a
c =
    (a -> Maybe a)
-> (Maybe a -> Maybe a) -> ValueCodec a -> ValueCodec (Maybe a)
forall (r :: * -> *) (w :: * -> *) o2 o1 i1 i2.
(Functor r, Alternative w) =>
(o2 -> o1)
-> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
mapBoth a -> Maybe a
forall a. a -> Maybe a
Just Maybe a -> Maybe a
forall a. a -> a
id ValueCodec a
c
    ValueCodec (Maybe a)
-> ValueCodec (Maybe a) -> ValueCodec (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Null -> Maybe a)
-> (Maybe a -> Null) -> ValueCodec Null -> ValueCodec (Maybe a)
forall (r :: * -> *) (w :: * -> *) a b.
(Functor r, Functor w) =>
(a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap (Maybe a -> Null -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (Null -> Maybe a -> Null
forall a b. a -> b -> a
const (Null -> Maybe a -> Null) -> Null -> Maybe a -> Null
forall a b. (a -> b) -> a -> b
$ () -> Null
Null.fromUnit ()) ValueCodec Null
nullCodec

eitherCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (Either a b)
eitherCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (Either a b)
eitherCodec ValueCodec a
cx ValueCodec b
cy =
    (a -> Either a b)
-> (Either a b -> Maybe a)
-> ValueCodec a
-> ValueCodec (Either a b)
forall (r :: * -> *) (w :: * -> *) o2 o1 i1 i2.
(Functor r, Alternative w) =>
(o2 -> o1)
-> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
mapBoth a -> Either a b
forall a b. a -> Either a b
Left ((a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)) (String -> ValueCodec a -> ValueCodec a
forall a. String -> ValueCodec a -> ValueCodec a
tagged String
"Left" ValueCodec a
cx)
    ValueCodec (Either a b)
-> ValueCodec (Either a b) -> ValueCodec (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b -> Either a b)
-> (Either a b -> Maybe b)
-> ValueCodec b
-> ValueCodec (Either a b)
forall (r :: * -> *) (w :: * -> *) o2 o1 i1 i2.
(Functor r, Alternative w) =>
(o2 -> o1)
-> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
mapBoth b -> Either a b
forall a b. b -> Either a b
Right ((a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just) (String -> ValueCodec b -> ValueCodec b
forall a. String -> ValueCodec a -> ValueCodec a
tagged String
"Right" ValueCodec b
cy)

mapBoth
    :: (Functor r, Applicative.Alternative w)
    => (o2 -> o1) -> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
mapBoth :: (o2 -> o1)
-> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
mapBoth o2 -> o1
f i1 -> Maybe i2
g CodecOf r w i2 o2
c = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: r o1
decode = (o2 -> o1) -> r o2 -> r o1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap o2 -> o1
f (r o2 -> r o1) -> r o2 -> r o1
forall a b. (a -> b) -> a -> b
$ CodecOf r w i2 o2 -> r o2
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode CodecOf r w i2 o2
c
    , encode :: i1 -> w o1
encode = \ i1
x -> case i1 -> Maybe i2
g i1
x of
        Maybe i2
Nothing -> w o1
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
        Just i2
y -> (o2 -> o1) -> w o2 -> w o1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap o2 -> o1
f (w o2 -> w o1) -> w o2 -> w o1
forall a b. (a -> b) -> a -> b
$ CodecOf r w i2 o2 -> i2 -> w o2
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode CodecOf r w i2 o2
c i2
y
    }

tagged :: String -> ValueCodec a -> ValueCodec a
tagged :: String -> ValueCodec a -> ValueCodec a
tagged String
t ValueCodec a
c = (((), a) -> a)
-> (a -> ((), a))
-> Codec
     (ReaderT Value (ExceptT String Identity))
     (MaybeT (StateT Value Identity))
     ((), a)
-> ValueCodec a
forall (r :: * -> *) (w :: * -> *) a b.
(Functor r, Functor w) =>
(a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap ((), a) -> a
forall a b. (a, b) -> b
snd ((,) ()) (Codec
   (ReaderT Value (ExceptT String Identity))
   (MaybeT (StateT Value Identity))
   ((), a)
 -> ValueCodec a)
-> (ObjectCodec ((), a)
    -> Codec
         (ReaderT Value (ExceptT String Identity))
         (MaybeT (StateT Value Identity))
         ((), a))
-> ObjectCodec ((), a)
-> ValueCodec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permission
-> ObjectCodec ((), a)
-> Codec
     (ReaderT Value (ExceptT String Identity))
     (MaybeT (StateT Value Identity))
     ((), a)
forall a. Permission -> ObjectCodec a -> ValueCodec a
fromObjectCodec Permission
Allow (ObjectCodec ((), a) -> ValueCodec a)
-> ObjectCodec ((), a) -> ValueCodec a
forall a b. (a -> b) -> a -> b
$ (,)
    (() -> a -> ((), a))
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     ((), a)
     ()
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     ((), a)
     (a -> ((), a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((), a) -> ())
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     ()
     ()
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     ((), a)
     ()
forall i f (r :: * -> *) (w :: * -> *) o.
(i -> f) -> CodecOf r w f o -> CodecOf r w i o
project ((), a) -> ()
forall a b. (a, b) -> a
fst (Name
-> ValueCodec ()
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     ()
     ()
forall a. Name -> ValueCodec a -> ObjectCodec 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 -> ValueCodec ()
literalCodec (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)))
    CodecOf
  (StateT [MemberOf Value] (ExceptT String Identity))
  (WriterT [MemberOf Value] Identity)
  ((), a)
  (a -> ((), a))
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     ((), a)
     a
-> ObjectCodec ((), a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((), a) -> a)
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     a
     a
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     ((), a)
     a
forall i f (r :: * -> *) (w :: * -> *) o.
(i -> f) -> CodecOf r w f o -> CodecOf r w i o
project ((), a) -> a
forall a b. (a, b) -> b
snd (Name
-> ValueCodec a
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     a
     a
forall a. Name -> ValueCodec a -> ObjectCodec 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") ValueCodec a
c)

literalCodec :: Value.Value -> ValueCodec ()
literalCodec :: Value -> ValueCodec ()
literalCodec Value
expected = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) ()
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) ()
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
    }

data Permission
    = Allow
    | Forbid
    deriving (Permission -> Permission -> Bool
(Permission -> Permission -> Bool)
-> (Permission -> Permission -> Bool) -> Eq Permission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Permission -> Permission -> Bool
$c/= :: Permission -> Permission -> Bool
== :: Permission -> Permission -> Bool
$c== :: Permission -> Permission -> Bool
Eq, Int -> Permission -> String -> String
[Permission] -> String -> String
Permission -> String
(Int -> Permission -> String -> String)
-> (Permission -> String)
-> ([Permission] -> String -> String)
-> Show Permission
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Permission] -> String -> String
$cshowList :: [Permission] -> String -> String
show :: Permission -> String
$cshow :: Permission -> String
showsPrec :: Int -> Permission -> String -> String
$cshowsPrec :: Int -> Permission -> String -> String
Show)

type ListCodec e a = Codec
    (Trans.StateT [e] (Trans.ExceptT String Identity.Identity))
    (Trans.WriterT [e] Identity.Identity)
    a

fromListCodec :: ValueCodec [e] -> Permission -> ListCodec e a -> ValueCodec a
fromListCodec :: ValueCodec [e] -> Permission -> ListCodec e a -> ValueCodec a
fromListCodec ValueCodec [e]
ce Permission
p ListCodec e a
ca = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: ReaderT Value (ExceptT String Identity) a
decode = do
        [e]
xs <- ValueCodec [e] -> ReaderT Value (ExceptT String Identity) [e]
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode ValueCodec [e]
ce
        case Identity (Either String (a, [e])) -> Either String (a, [e])
forall a. Identity a -> a
Identity.runIdentity (Identity (Either String (a, [e])) -> Either String (a, [e]))
-> (ExceptT String Identity (a, [e])
    -> Identity (Either String (a, [e])))
-> ExceptT String Identity (a, [e])
-> Either String (a, [e])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String Identity (a, [e])
-> Identity (Either String (a, [e]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Trans.runExceptT (ExceptT String Identity (a, [e]) -> Either String (a, [e]))
-> ExceptT String Identity (a, [e]) -> Either String (a, [e])
forall a b. (a -> b) -> a -> b
$ StateT [e] (ExceptT String Identity) a
-> [e] -> ExceptT String Identity (a, [e])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Trans.runStateT (ListCodec e a -> StateT [e] (ExceptT String Identity) a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode ListCodec e a
ca) [e]
xs of
            Left String
x -> ExceptT String Identity a
-> ReaderT Value (ExceptT String Identity) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity a
 -> ReaderT Value (ExceptT String Identity) a)
-> ExceptT String Identity a
-> ReaderT 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
x
            Right (a
x, [e]
ys) -> do
                case (Permission
p, [e]
ys) of
                    (Permission
Forbid, e
_ : [e]
_) -> 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) ())
-> ExceptT String Identity ()
-> ReaderT Value (ExceptT String Identity) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String Identity ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
"leftover elements"
                    (Permission, [e])
_ -> () -> ReaderT Value (ExceptT String Identity) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                a -> ReaderT Value (ExceptT String Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    , encode :: a -> MaybeT (StateT Value Identity) a
encode = \ a
x -> do
        MaybeT (StateT Value Identity) [e]
-> MaybeT (StateT Value Identity) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void
            (MaybeT (StateT Value Identity) [e]
 -> MaybeT (StateT Value Identity) ())
-> (WriterT [e] Identity a -> MaybeT (StateT Value Identity) [e])
-> WriterT [e] Identity a
-> MaybeT (StateT Value Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCodec [e] -> [e] -> MaybeT (StateT Value Identity) [e]
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode ValueCodec [e]
ce
            ([e] -> MaybeT (StateT Value Identity) [e])
-> (WriterT [e] Identity a -> [e])
-> WriterT [e] Identity a
-> MaybeT (StateT Value Identity) [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [e]) -> [e]
forall a b. (a, b) -> b
snd
            ((a, [e]) -> [e])
-> (WriterT [e] Identity a -> (a, [e]))
-> WriterT [e] Identity a
-> [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (a, [e]) -> (a, [e])
forall a. Identity a -> a
Identity.runIdentity
            (Identity (a, [e]) -> (a, [e]))
-> (WriterT [e] Identity a -> Identity (a, [e]))
-> WriterT [e] Identity a
-> (a, [e])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [e] Identity a -> Identity (a, [e])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Trans.runWriterT
            (WriterT [e] Identity a -> MaybeT (StateT Value Identity) ())
-> WriterT [e] Identity a -> MaybeT (StateT Value Identity) ()
forall a b. (a -> b) -> a -> b
$ ListCodec e a -> a -> WriterT [e] Identity a
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode ListCodec e a
ca a
x
        a -> MaybeT (StateT Value Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    }

type ArrayCodec a = ListCodec Value.Value a

fromArrayCodec :: Permission -> ArrayCodec a -> ValueCodec a
fromArrayCodec :: Permission -> ArrayCodec a -> ValueCodec a
fromArrayCodec = ValueCodec [Value] -> Permission -> ArrayCodec a -> ValueCodec a
forall e a.
ValueCodec [e] -> Permission -> ListCodec e a -> ValueCodec a
fromListCodec (ValueCodec [Value] -> Permission -> ArrayCodec a -> ValueCodec a)
-> ValueCodec [Value] -> Permission -> ArrayCodec a -> ValueCodec a
forall a b. (a -> b) -> a -> b
$ (ArrayOf Value -> [Value])
-> ([Value] -> ArrayOf Value)
-> ValueCodec (ArrayOf Value)
-> ValueCodec [Value]
forall (r :: * -> *) (w :: * -> *) a b.
(Functor r, Functor w) =>
(a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap ArrayOf Value -> [Value]
forall value. ArrayOf value -> [value]
Array.toList [Value] -> ArrayOf Value
forall value. [value] -> ArrayOf value
Array.fromList ValueCodec (ArrayOf Value)
arrayCodec

element :: ValueCodec a -> ArrayCodec a
element :: ValueCodec a -> ArrayCodec a
element ValueCodec a
c = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: StateT [Value] (ExceptT String Identity) a
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 ValueCodec a -> Value -> Result a
forall a. ValueCodec a -> Value -> Result a
decodeWith ValueCodec a
c Value
h of
                Result.Failure 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
                Result.Success 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
encode = \ a
x -> do
        [Value] -> WriterT [Value] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell [ValueCodec a -> a -> Value
forall a. ValueCodec a -> a -> Value
encodeWith ValueCodec a
c a
x]
        a -> WriterT [Value] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    }

tupleCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (a, b)
tupleCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (a, b)
tupleCodec ValueCodec a
cx ValueCodec b
cy = Permission -> ArrayCodec (a, b) -> ValueCodec (a, b)
forall a. Permission -> ArrayCodec a -> ValueCodec a
fromArrayCodec Permission
Forbid (ArrayCodec (a, b) -> ValueCodec (a, b))
-> ArrayCodec (a, b) -> ValueCodec (a, b)
forall a b. (a -> b) -> a -> b
$ (,)
    (a -> b -> (a, b))
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     (a, b)
     a
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     (a, b)
     (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, b) -> a)
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     a
     a
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     (a, b)
     a
forall i f (r :: * -> *) (w :: * -> *) o.
(i -> f) -> CodecOf r w f o -> CodecOf r w i o
project (a, b) -> a
forall a b. (a, b) -> a
fst (ValueCodec a
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     a
     a
forall a. ValueCodec a -> ArrayCodec a
element ValueCodec a
cx)
    CodecOf
  (StateT [Value] (ExceptT String Identity))
  (WriterT [Value] Identity)
  (a, b)
  (b -> (a, b))
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     (a, b)
     b
-> ArrayCodec (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, b) -> b)
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     b
     b
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     (a, b)
     b
forall i f (r :: * -> *) (w :: * -> *) o.
(i -> f) -> CodecOf r w f o -> CodecOf r w i o
project (a, b) -> b
forall a b. (a, b) -> b
snd (ValueCodec b
-> CodecOf
     (StateT [Value] (ExceptT String Identity))
     (WriterT [Value] Identity)
     b
     b
forall a. ValueCodec a -> ArrayCodec a
element ValueCodec b
cy)

type ObjectCodec a = ListCodec (Member.MemberOf Value.Value) a

fromObjectCodec :: Permission -> ObjectCodec a -> ValueCodec a
fromObjectCodec :: Permission -> ObjectCodec a -> ValueCodec a
fromObjectCodec = ValueCodec [MemberOf Value]
-> Permission -> ObjectCodec a -> ValueCodec a
forall e a.
ValueCodec [e] -> Permission -> ListCodec e a -> ValueCodec a
fromListCodec (ValueCodec [MemberOf Value]
 -> Permission -> ObjectCodec a -> ValueCodec a)
-> ValueCodec [MemberOf Value]
-> Permission
-> ObjectCodec a
-> ValueCodec a
forall a b. (a -> b) -> a -> b
$ (ObjectOf Value -> [MemberOf Value])
-> ([MemberOf Value] -> ObjectOf Value)
-> ValueCodec (ObjectOf Value)
-> ValueCodec [MemberOf Value]
forall (r :: * -> *) (w :: * -> *) a b.
(Functor r, Functor w) =>
(a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
dimap ObjectOf Value -> [MemberOf Value]
forall value. ObjectOf value -> [MemberOf value]
Object.toList [MemberOf Value] -> ObjectOf Value
forall value. [MemberOf value] -> ObjectOf value
Object.fromList ValueCodec (ObjectOf Value)
objectCodec

required :: Name.Name -> ValueCodec a -> ObjectCodec a
required :: Name -> ValueCodec a -> ObjectCodec a
required Name
k ValueCodec a
c = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: StateT [MemberOf Value] (ExceptT String Identity) a
decode = do
        Maybe a
m <- CodecOf
  (StateT [MemberOf Value] (ExceptT String Identity))
  (WriterT [MemberOf Value] Identity)
  (Maybe a)
  (Maybe a)
-> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a)
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> r o
decode (Name
-> ValueCodec a
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     (Maybe a)
     (Maybe a)
forall a. Name -> ValueCodec a -> ObjectCodec (Maybe a)
optional Name
k ValueCodec a
c)
        case Maybe a
m of
            Maybe a
Nothing -> ExceptT String Identity a
-> StateT [MemberOf 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 [MemberOf Value] (ExceptT String Identity) a)
-> (String -> ExceptT String Identity a)
-> String
-> StateT [MemberOf 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 [MemberOf Value] (ExceptT String Identity) a)
-> String -> StateT [MemberOf 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 [MemberOf Value] (ExceptT String Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    , encode :: a -> WriterT [MemberOf Value] Identity a
encode = \ a
x -> do
        WriterT [MemberOf Value] Identity (Maybe a)
-> WriterT [MemberOf Value] Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
Monad.void (WriterT [MemberOf Value] Identity (Maybe a)
 -> WriterT [MemberOf Value] Identity ())
-> (Maybe a -> WriterT [MemberOf Value] Identity (Maybe a))
-> Maybe a
-> WriterT [MemberOf Value] Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodecOf
  (StateT [MemberOf Value] (ExceptT String Identity))
  (WriterT [MemberOf Value] Identity)
  (Maybe a)
  (Maybe a)
-> Maybe a -> WriterT [MemberOf Value] Identity (Maybe a)
forall (r :: * -> *) (w :: * -> *) i o. CodecOf r w i o -> i -> w o
encode (Name
-> ValueCodec a
-> CodecOf
     (StateT [MemberOf Value] (ExceptT String Identity))
     (WriterT [MemberOf Value] Identity)
     (Maybe a)
     (Maybe a)
forall a. Name -> ValueCodec a -> ObjectCodec (Maybe a)
optional Name
k ValueCodec a
c) (Maybe a -> WriterT [MemberOf Value] Identity ())
-> Maybe a -> WriterT [MemberOf Value] Identity ()
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
        a -> WriterT [MemberOf Value] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    }

optional :: Name.Name -> ValueCodec a -> ObjectCodec (Maybe a)
optional :: Name -> ValueCodec a -> ObjectCodec (Maybe a)
optional Name
k ValueCodec a
c = Codec :: forall (r :: * -> *) (w :: * -> *) i o.
r o -> (i -> w o) -> CodecOf r w i o
Codec
    { decode :: StateT [MemberOf Value] (ExceptT String Identity) (Maybe a)
decode = do
        [MemberOf Value]
xs <- StateT [MemberOf Value] (ExceptT String Identity) [MemberOf Value]
forall (m :: * -> *) s. Monad m => StateT s m s
Trans.get
        case (MemberOf Value -> Bool)
-> [MemberOf Value] -> Maybe (MemberOf Value, [MemberOf Value])
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
detect (\ (Member.Member Name
j Value
_) -> Name
j Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
k) [MemberOf Value]
xs of
            Maybe (MemberOf Value, [MemberOf Value])
Nothing -> Maybe a
-> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
            Just (Member.Member Name
_ Value
x, [MemberOf Value]
ys) -> case ValueCodec a -> Value -> Result a
forall a. ValueCodec a -> Value -> Result a
decodeWith ValueCodec a
c Value
x of
                Result.Failure String
y -> ExceptT String Identity (Maybe a)
-> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity (Maybe a)
 -> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a))
-> ExceptT String Identity (Maybe a)
-> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String Identity (Maybe a)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
y
                Result.Success a
y -> do
                    [MemberOf Value]
-> StateT [MemberOf Value] (ExceptT String Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put [MemberOf Value]
ys
                    Maybe a
-> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
 -> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a))
-> Maybe a
-> StateT [MemberOf Value] (ExceptT String Identity) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
y
    , encode :: Maybe a -> WriterT [MemberOf Value] Identity (Maybe a)
encode = \ Maybe a
x -> do
        case Maybe a
x of
            Maybe a
Nothing -> () -> WriterT [MemberOf Value] Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just a
y -> [MemberOf Value] -> WriterT [MemberOf Value] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Trans.tell [Name -> Value -> MemberOf Value
forall value. Name -> value -> MemberOf value
Member.Member Name
k (Value -> MemberOf Value) -> Value -> MemberOf Value
forall a b. (a -> b) -> a -> b
$ ValueCodec a -> a -> Value
forall a. ValueCodec a -> a -> Value
encodeWith ValueCodec a
c a
y]
        Maybe a -> WriterT [MemberOf Value] Identity (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
x
    }

detect :: (a -> Bool) -> [a] -> Maybe (a, [a])
detect :: (a -> Bool) -> [a] -> Maybe (a, [a])
detect = ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
forall a. ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
detectWith [a] -> [a]
forall a. a -> a
id

detectWith :: ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
detectWith :: ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
detectWith [a] -> [a]
f a -> Bool
p [a]
xs = case [a]
xs of
    [] -> Maybe (a, [a])
forall a. Maybe a
Nothing
    a
x : [a]
ys -> if a -> Bool
p a
x
        then (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a] -> [a]
f [a]
ys)
        else ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
forall a. ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
detectWith ([a] -> [a]
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) a -> Bool
p [a]
ys