module Argo.Type.Codec where

import Control.Applicative ((<|>))

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.Type.Permission as Permission
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.List as List
import qualified Data.Text as Text

decodeWith :: ValueCodec a -> Value.Value -> Either String a
decodeWith :: ValueCodec a -> Value -> Either String a
decodeWith ValueCodec 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
f (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor 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
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
f (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 }

tap :: Functor f => (a -> f b) -> a -> f a
tap :: (a -> f b) -> a -> f a
tap a -> f b
f a
x = a
x a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> f b
f a
x

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

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
    }

mapMaybe
    :: (Applicative.Alternative r, Applicative.Alternative w, Monad r, Monad w)
    => (o2 -> Maybe o1)
    -> (i1 -> Maybe i2)
    -> CodecOf r w i2 o2
    -> CodecOf r w i1 o1
mapMaybe :: (o2 -> Maybe o1)
-> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
mapMaybe o2 -> Maybe 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 = do
        o2
o2 <- 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
        Maybe o1 -> r o1
forall (m :: * -> *) a. Alternative m => Maybe a -> m a
toAlternative (Maybe o1 -> r o1) -> Maybe o1 -> r o1
forall a b. (a -> b) -> a -> b
$ o2 -> Maybe o1
f o2
o2
    , encode :: i1 -> w o1
encode = \ i1
i1 -> do
        i2
i2 <- Maybe i2 -> w i2
forall (m :: * -> *) a. Alternative m => Maybe a -> m a
toAlternative (Maybe i2 -> w i2) -> Maybe i2 -> w i2
forall a b. (a -> b) -> a -> b
$ i1 -> Maybe i2
g i1
i1
        o2
o2 <- 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
i2
        Maybe o1 -> w o1
forall (m :: * -> *) a. Alternative m => Maybe a -> m a
toAlternative (Maybe o1 -> w o1) -> Maybe o1 -> w o1
forall a b. (a -> b) -> a -> b
$ o2 -> Maybe o1
f o2
o2
    }

toAlternative :: Applicative.Alternative m => Maybe a -> m a
toAlternative :: Maybe a -> m a
toAlternative = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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
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
    }

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

fromListCodec
    :: ValueCodec [e] -> Permission.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
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.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 -> Either String a
forall a. ValueCodec a -> Value -> Either String a
decodeWith ValueCodec a
c Value
h of
                Left String
y -> ExceptT String Identity a
-> StateT [Value] (ExceptT String Identity) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (ExceptT String Identity a
 -> StateT [Value] (ExceptT String Identity) a)
-> ExceptT String Identity a
-> StateT [Value] (ExceptT String Identity) a
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String Identity a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Trans.throwE String
y
                Right a
y -> do
                    [Value] -> StateT [Value] (ExceptT String Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
Trans.put [Value]
t
                    a -> StateT [Value] (ExceptT String Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
y
    , encode :: a -> WriterT [Value] Identity a
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
    }

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

fromObjectCodec :: Permission.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] -> ([MemberOf Value], [MemberOf 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) [MemberOf Value]
xs of
            (Member.Member Name
_ Value
x : [MemberOf Value]
_, [MemberOf Value]
ys) -> case ValueCodec a -> Value -> Either String a
forall a. ValueCodec a -> Value -> Either String a
decodeWith ValueCodec a
c Value
x of
                Left 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
                Right 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
            ([MemberOf Value], [MemberOf Value])
_ -> 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
    , 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
    }