{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language GADTs                 #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds             #-}
{-# language ScopedTypeVariables   #-}
{-# language TypeApplications      #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Description : Adapter for JSON serialization

Just import the module and you can turn any
value with a 'ToSchema' and 'FromSchema' from
and to JSON values.
-}
module Mu.Adapter.Json () where

import           Control.Applicative                 ((<|>))
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Functor.Contravariant
import qualified Data.HashMap.Strict                 as HM
import qualified Data.Text                           as T
import qualified Data.Vector                         as V

import           Mu.Schema
import qualified Mu.Schema.Interpretation.Schemaless as SLess

instance SLess.ToSchemalessTerm Value where
  toSchemalessTerm :: Value -> Term
toSchemalessTerm (Object o :: Object
o)
    = [Field] -> Term
SLess.TRecord ([Field] -> Term) -> [Field] -> Term
forall a b. (a -> b) -> a -> b
$ ((Text, Value) -> Field) -> [(Text, Value)] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: Text
k,v :: Value
v) -> Text -> FieldValue -> Field
SLess.Field Text
k (Value -> FieldValue
forall t. ToSchemalessValue t => t -> FieldValue
SLess.toSchemalessValue Value
v))
                    ([(Text, Value)] -> [Field]) -> [(Text, Value)] -> [Field]
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
o
  toSchemalessTerm v :: Value
v = FieldValue -> Term
SLess.TSimple (Value -> FieldValue
forall t. ToSchemalessValue t => t -> FieldValue
SLess.toSchemalessValue Value
v)

instance SLess.ToSchemalessValue Value where
  toSchemalessValue :: Value -> FieldValue
toSchemalessValue r :: Value
r@(Object _)
    = Term -> FieldValue
SLess.FSchematic (Value -> Term
forall t. ToSchemalessTerm t => t -> Term
SLess.toSchemalessTerm Value
r)
  toSchemalessValue Null       = FieldValue
SLess.FNull
  toSchemalessValue (String s :: Text
s) = Text -> FieldValue
forall t. (Typeable t, Eq t, Ord t, Show t) => t -> FieldValue
SLess.FPrimitive Text
s
  toSchemalessValue (Number n :: Scientific
n) = Scientific -> FieldValue
forall t. (Typeable t, Eq t, Ord t, Show t) => t -> FieldValue
SLess.FPrimitive Scientific
n
  toSchemalessValue (Bool   b :: Bool
b) = Bool -> FieldValue
forall t. (Typeable t, Eq t, Ord t, Show t) => t -> FieldValue
SLess.FPrimitive Bool
b
  toSchemalessValue (Array xs :: Array
xs)
    = [FieldValue] -> FieldValue
SLess.FList ([FieldValue] -> FieldValue) -> [FieldValue] -> FieldValue
forall a b. (a -> b) -> a -> b
$ (Value -> FieldValue) -> [Value] -> [FieldValue]
forall a b. (a -> b) -> [a] -> [b]
map Value -> FieldValue
forall t. ToSchemalessValue t => t -> FieldValue
SLess.toSchemalessValue ([Value] -> [FieldValue]) -> [Value] -> [FieldValue]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
xs

instance (ToSchema sch sty a, ToJSON (Term sch (sch :/: sty)))
         => ToJSON (WithSchema sch sty a) where
  toJSON :: WithSchema sch sty a -> Value
toJSON (WithSchema x :: a
x) = Term sch (sch :/: sty) -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Term sch (sch :/: sty)
forall fn tn (sch :: Schema tn fn) t (sty :: tn).
ToSchema sch sty t =>
t -> Term sch (sch :/: sty)
toSchema' @_ @_ @sch a
x)
instance (FromSchema sch sty a, FromJSON (Term sch (sch :/: sty)))
         => FromJSON (WithSchema sch sty a) where
  parseJSON :: Value -> Parser (WithSchema sch sty a)
parseJSON v :: Value
v = a -> WithSchema sch sty a
forall tn fn (sch :: Schema tn fn) (sty :: tn) a.
a -> WithSchema sch sty a
WithSchema (a -> WithSchema sch sty a)
-> (Term sch (sch :/: sty) -> a)
-> Term sch (sch :/: sty)
-> WithSchema sch sty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (sty :: tn).
FromSchema sch sty t =>
Term sch (sch :/: sty) -> t
forall fn tn (sch :: Schema tn fn) t (sty :: tn).
FromSchema sch sty t =>
Term sch (sch :/: sty) -> t
fromSchema' @_ @_ @sch (Term sch (sch :/: sty) -> WithSchema sch sty a)
-> Parser (Term sch (sch :/: sty)) -> Parser (WithSchema sch sty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Term sch (sch :/: sty))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSONFields sch args => ToJSON (Term sch ('DRecord name args)) where
  toJSON :: Term sch ('DRecord name args) -> Value
toJSON (TRecord fields :: NP (Field sch) args
fields) = Object -> Value
Object (NP (Field sch) args -> Object
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fields :: [FieldDef typeName fieldName]).
ToJSONFields sch fields =>
NP (Field sch) fields -> Object
toJSONFields NP (Field sch) args
fields)
instance FromJSONFields sch args => FromJSON (Term sch ('DRecord name args)) where
  parseJSON :: Value -> Parser (Term sch ('DRecord name args))
parseJSON (Object v :: Object
v) = NP (Field sch) args -> Term sch ('DRecord name args)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (args :: [FieldDef typeName fieldName]) (choices :: typeName).
NP (Field sch) args -> Term sch ('DRecord choices args)
TRecord (NP (Field sch) args -> Term sch ('DRecord name args))
-> Parser (NP (Field sch) args)
-> Parser (Term sch ('DRecord name args))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser (NP (Field sch) args)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fields :: [FieldDef typeName fieldName]).
FromJSONFields sch fields =>
Object -> Parser (NP (Field sch) fields)
parseJSONFields Object
v
  parseJSON _          = String -> Parser (Term sch ('DRecord name args))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected object"

class ToJSONFields sch fields where
  toJSONFields :: NP (Field sch) fields -> Object
instance ToJSONFields sch '[] where
  toJSONFields :: NP (Field sch) '[] -> Object
toJSONFields _ = Object
forall k v. HashMap k v
HM.empty
instance (KnownName name, ToJSON (FieldValue sch t), ToJSONFields sch fs)
         => ToJSONFields sch ('FieldDef name t ': fs) where
  toJSONFields :: NP (Field sch) ('FieldDef name t : fs) -> Object
toJSONFields (Field v :: FieldValue sch t
v :* rest :: NP (Field sch) xs
rest) = Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
key Value
value (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ NP (Field sch) xs -> Object
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fields :: [FieldDef typeName fieldName]).
ToJSONFields sch fields =>
NP (Field sch) fields -> Object
toJSONFields NP (Field sch) xs
rest
    where key :: Text
key = String -> Text
T.pack (Proxy name -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name))
          value :: Value
value = FieldValue sch t -> Value
forall a. ToJSON a => a -> Value
toJSON FieldValue sch t
v

class FromJSONFields sch fields where
  parseJSONFields :: Object -> Parser (NP (Field sch) fields)
instance FromJSONFields sch '[] where
  parseJSONFields :: Object -> Parser (NP (Field sch) '[])
parseJSONFields _ = NP (Field sch) '[] -> Parser (NP (Field sch) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP (Field sch) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance (KnownName name, FromJSON (FieldValue sch t), FromJSONFields sch fs)
         => FromJSONFields sch ('FieldDef name t ': fs) where
  parseJSONFields :: Object -> Parser (NP (Field sch) ('FieldDef name t : fs))
parseJSONFields v :: Object
v = Field sch ('FieldDef name t)
-> NP (Field sch) fs -> NP (Field sch) ('FieldDef name t : fs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (Field sch ('FieldDef name t)
 -> NP (Field sch) fs -> NP (Field sch) ('FieldDef name t : fs))
-> Parser (Field sch ('FieldDef name t))
-> Parser
     (NP (Field sch) fs -> NP (Field sch) ('FieldDef name t : fs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldValue sch t -> Field sch ('FieldDef name t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName) (name :: fieldName).
FieldValue sch t -> Field sch ('FieldDef name t)
Field (FieldValue sch t -> Field sch ('FieldDef name t))
-> Parser (FieldValue sch t)
-> Parser (Field sch ('FieldDef name t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (FieldValue sch t)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
key) Parser
  (NP (Field sch) fs -> NP (Field sch) ('FieldDef name t : fs))
-> Parser (NP (Field sch) fs)
-> Parser (NP (Field sch) ('FieldDef name t : fs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser (NP (Field sch) fs)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fields :: [FieldDef typeName fieldName]).
FromJSONFields sch fields =>
Object -> Parser (NP (Field sch) fields)
parseJSONFields Object
v
    where key :: Text
key = String -> Text
T.pack (Proxy name -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name))

instance ToJSONEnum choices => ToJSON (Term sch ('DEnum name choices)) where
  toJSON :: Term sch ('DEnum name choices) -> Value
toJSON (TEnum choice :: NS Proxy choices
choice) = Text -> Value
String (NS Proxy choices -> Text
forall k (choices :: [k]).
ToJSONEnum choices =>
NS Proxy choices -> Text
toJSONEnum NS Proxy choices
choice)
instance FromJSONEnum choices => FromJSON (Term sch ('DEnum name choices)) where
  parseJSON :: Value -> Parser (Term sch ('DEnum name choices))
parseJSON (String s :: Text
s) = NS Proxy choices -> Term sch ('DEnum name choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (sch :: Schema typeName fieldName) (name :: typeName).
NS Proxy choices -> Term sch ('DEnum name choices)
TEnum (NS Proxy choices -> Term sch ('DEnum name choices))
-> Parser (NS Proxy choices)
-> Parser (Term sch ('DEnum name choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (NS Proxy choices)
forall k (choices :: [k]).
FromJSONEnum choices =>
Text -> Parser (NS Proxy choices)
parseJSONEnum Text
s
  parseJSON _          = String -> Parser (Term sch ('DEnum name choices))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected string"

class ToJSONEnum choices where
  toJSONEnum :: NS Proxy choices -> T.Text
instance ToJSONEnum '[] where
  toJSONEnum :: NS Proxy '[] -> Text
toJSONEnum = String -> NS Proxy '[] -> Text
forall a. HasCallStack => String -> a
error "empty enum"
instance (KnownName c, ToJSONEnum cs)
         => ToJSONEnum ('ChoiceDef c ': cs) where
  toJSONEnum :: NS Proxy ('ChoiceDef c : cs) -> Text
toJSONEnum (Z _) = String -> Text
T.pack (Proxy c -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy c
forall k (t :: k). Proxy t
Proxy @c))
  toJSONEnum (S v :: NS Proxy xs
v) = NS Proxy xs -> Text
forall k (choices :: [k]).
ToJSONEnum choices =>
NS Proxy choices -> Text
toJSONEnum NS Proxy xs
v

class FromJSONEnum choices where
  parseJSONEnum :: T.Text -> Parser (NS Proxy choices)
instance FromJSONEnum '[] where
  parseJSONEnum :: Text -> Parser (NS Proxy '[])
parseJSONEnum _ = String -> Parser (NS Proxy '[])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unknown enum value"
instance (KnownName c, FromJSONEnum cs)
         => FromJSONEnum ('ChoiceDef c ': cs) where
  parseJSONEnum :: Text -> Parser (NS Proxy ('ChoiceDef c : cs))
parseJSONEnum v :: Text
v
    | Text
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key  = NS Proxy ('ChoiceDef c : cs)
-> Parser (NS Proxy ('ChoiceDef c : cs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy ('ChoiceDef c) -> NS Proxy ('ChoiceDef c : cs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z Proxy ('ChoiceDef c)
forall k (t :: k). Proxy t
Proxy)
    | Bool
otherwise = NS Proxy cs -> NS Proxy ('ChoiceDef c : cs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS Proxy cs -> NS Proxy ('ChoiceDef c : cs))
-> Parser (NS Proxy cs) -> Parser (NS Proxy ('ChoiceDef c : cs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (NS Proxy cs)
forall k (choices :: [k]).
FromJSONEnum choices =>
Text -> Parser (NS Proxy choices)
parseJSONEnum Text
v
    where key :: Text
key = String -> Text
T.pack (Proxy c -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal (Proxy c
forall k (t :: k). Proxy t
Proxy @c))

instance ToJSON (FieldValue sch t) => ToJSON (Term sch ('DSimple t)) where
  toJSON :: Term sch ('DSimple t) -> Value
toJSON (TSimple x :: FieldValue sch t
x) = FieldValue sch t -> Value
forall a. ToJSON a => a -> Value
toJSON FieldValue sch t
x
instance FromJSON (FieldValue sch t) => FromJSON (Term sch ('DSimple t)) where
  parseJSON :: Value -> Parser (Term sch ('DSimple t))
parseJSON v :: Value
v = FieldValue sch t -> Term sch ('DSimple t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName).
FieldValue sch t -> Term sch ('DSimple t)
TSimple (FieldValue sch t -> Term sch ('DSimple t))
-> Parser (FieldValue sch t) -> Parser (Term sch ('DSimple t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (FieldValue sch t)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON (FieldValue sch 'TNull) where
  toJSON :: FieldValue sch 'TNull -> Value
toJSON FNull = Value
Null
instance ToJSON t => ToJSON (FieldValue sch ('TPrimitive t)) where
  toJSON :: FieldValue sch ('TPrimitive t) -> Value
toJSON (FPrimitive v :: t
v) = t -> Value
forall a. ToJSON a => a -> Value
toJSON t
v
instance ToJSONKey t => ToJSONKey (FieldValue sch ('TPrimitive t)) where
  toJSONKey :: ToJSONKeyFunction (FieldValue sch ('TPrimitive t))
toJSONKey = (FieldValue sch ('TPrimitive t)
 -> FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t))))
-> ToJSONKeyFunction
     (FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t))))
-> ToJSONKeyFunction (FieldValue sch ('TPrimitive t))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap FieldValue sch ('TPrimitive t)
-> FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t)))
forall typeName fieldName t (sch :: Schema typeName fieldName).
t -> FieldValue sch ('TPrimitive t)
FPrimitive ToJSONKeyFunction
  (FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t))))
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey
  toJSONKeyList :: ToJSONKeyFunction [FieldValue sch ('TPrimitive t)]
toJSONKeyList = ([FieldValue sch ('TPrimitive t)]
 -> [FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t)))])
-> ToJSONKeyFunction
     [FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t)))]
-> ToJSONKeyFunction [FieldValue sch ('TPrimitive t)]
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((FieldValue sch ('TPrimitive t)
 -> FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t))))
-> [FieldValue sch ('TPrimitive t)]
-> [FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t)))]
forall a b. (a -> b) -> [a] -> [b]
map FieldValue sch ('TPrimitive t)
-> FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t)))
forall typeName fieldName t (sch :: Schema typeName fieldName).
t -> FieldValue sch ('TPrimitive t)
FPrimitive) ToJSONKeyFunction
  [FieldValue Any ('TPrimitive (FieldValue sch ('TPrimitive t)))]
forall a. ToJSONKey a => ToJSONKeyFunction [a]
toJSONKeyList
instance ToJSON (Term sch (sch :/: t))
         => ToJSON (FieldValue sch ('TSchematic t)) where
  toJSON :: FieldValue sch ('TSchematic t) -> Value
toJSON (FSchematic v :: Term sch (sch :/: t)
v) = Term sch (sch :/: t) -> Value
forall a. ToJSON a => a -> Value
toJSON Term sch (sch :/: t)
Term sch (sch :/: t)
v
instance ToJSON (FieldValue sch t)
         => ToJSON (FieldValue sch ('TOption t)) where
  toJSON :: FieldValue sch ('TOption t) -> Value
toJSON (FOption v :: Maybe (FieldValue sch t)
v) = Maybe (FieldValue sch t) -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe (FieldValue sch t)
v
instance ToJSON (FieldValue sch t)
         => ToJSON (FieldValue sch ('TList t)) where
  toJSON :: FieldValue sch ('TList t) -> Value
toJSON (FList v :: [FieldValue sch t]
v) = [FieldValue sch t] -> Value
forall a. ToJSON a => a -> Value
toJSON [FieldValue sch t]
v
instance (ToJSONKey (FieldValue sch k), ToJSON (FieldValue sch v))
         => ToJSON (FieldValue sch ('TMap k v)) where
  toJSON :: FieldValue sch ('TMap k v) -> Value
toJSON (FMap v :: Map (FieldValue sch k) (FieldValue sch v)
v) = Map (FieldValue sch k) (FieldValue sch v) -> Value
forall a. ToJSON a => a -> Value
toJSON Map (FieldValue sch k) (FieldValue sch v)
v
instance (ToJSONUnion sch us)
         => ToJSON (FieldValue sch ('TUnion us)) where
  toJSON :: FieldValue sch ('TUnion us) -> Value
toJSON (FUnion v :: NS (FieldValue sch) choices
v) = NS (FieldValue sch) choices -> Value
forall typeName fieldName (sch :: Schema typeName fieldName)
       (us :: [FieldType typeName]).
ToJSONUnion sch us =>
NS (FieldValue sch) us -> Value
unionToJSON NS (FieldValue sch) choices
v

class ToJSONUnion sch us where
  unionToJSON :: NS (FieldValue sch) us -> Value
instance ToJSONUnion sch '[] where
  unionToJSON :: NS (FieldValue sch) '[] -> Value
unionToJSON = String -> NS (FieldValue sch) '[] -> Value
forall a. HasCallStack => String -> a
error "this should never happen"
instance (ToJSON (FieldValue sch u), ToJSONUnion sch us)
         => ToJSONUnion sch (u ': us) where
  unionToJSON :: NS (FieldValue sch) (u : us) -> Value
unionToJSON (Z v :: FieldValue sch x
v) = FieldValue sch x -> Value
forall a. ToJSON a => a -> Value
toJSON FieldValue sch x
v
  unionToJSON (S r :: NS (FieldValue sch) xs
r) = NS (FieldValue sch) xs -> Value
forall typeName fieldName (sch :: Schema typeName fieldName)
       (us :: [FieldType typeName]).
ToJSONUnion sch us =>
NS (FieldValue sch) us -> Value
unionToJSON NS (FieldValue sch) xs
r

instance FromJSON (FieldValue sch 'TNull) where
  parseJSON :: Value -> Parser (FieldValue sch 'TNull)
parseJSON Null = FieldValue sch 'TNull -> Parser (FieldValue sch 'TNull)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldValue sch 'TNull
forall typeName fieldName (sch :: Schema typeName fieldName).
FieldValue sch 'TNull
FNull
  parseJSON _    = String -> Parser (FieldValue sch 'TNull)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected null"
instance FromJSON t => FromJSON (FieldValue sch ('TPrimitive t)) where
  parseJSON :: Value -> Parser (FieldValue sch ('TPrimitive t))
parseJSON v :: Value
v = t -> FieldValue sch ('TPrimitive t)
forall typeName fieldName t (sch :: Schema typeName fieldName).
t -> FieldValue sch ('TPrimitive t)
FPrimitive (t -> FieldValue sch ('TPrimitive t))
-> Parser t -> Parser (FieldValue sch ('TPrimitive t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser t
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance FromJSONKey t => FromJSONKey (FieldValue sch ('TPrimitive t)) where
  fromJSONKey :: FromJSONKeyFunction (FieldValue sch ('TPrimitive t))
fromJSONKey = (t -> FieldValue sch ('TPrimitive t))
-> FromJSONKeyFunction t
-> FromJSONKeyFunction (FieldValue sch ('TPrimitive t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> FieldValue sch ('TPrimitive t)
forall typeName fieldName t (sch :: Schema typeName fieldName).
t -> FieldValue sch ('TPrimitive t)
FPrimitive FromJSONKeyFunction t
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey
  fromJSONKeyList :: FromJSONKeyFunction [FieldValue sch ('TPrimitive t)]
fromJSONKeyList = ([t] -> [FieldValue sch ('TPrimitive t)])
-> FromJSONKeyFunction [t]
-> FromJSONKeyFunction [FieldValue sch ('TPrimitive t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t -> FieldValue sch ('TPrimitive t))
-> [t] -> [FieldValue sch ('TPrimitive t)]
forall a b. (a -> b) -> [a] -> [b]
map t -> FieldValue sch ('TPrimitive t)
forall typeName fieldName t (sch :: Schema typeName fieldName).
t -> FieldValue sch ('TPrimitive t)
FPrimitive) FromJSONKeyFunction [t]
forall a. FromJSONKey a => FromJSONKeyFunction [a]
fromJSONKeyList
instance FromJSON (Term sch (sch :/: t))
         => FromJSON (FieldValue sch ('TSchematic t)) where
  parseJSON :: Value -> Parser (FieldValue sch ('TSchematic t))
parseJSON v :: Value
v = Term sch (sch :/: t) -> FieldValue sch ('TSchematic t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: typeName).
Term sch (sch :/: t) -> FieldValue sch ('TSchematic t)
FSchematic (Term sch (sch :/: t) -> FieldValue sch ('TSchematic t))
-> Parser (Term sch (sch :/: t))
-> Parser (FieldValue sch ('TSchematic t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Term sch (sch :/: t))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance FromJSON (FieldValue sch t)
         => FromJSON (FieldValue sch ('TOption t)) where
  parseJSON :: Value -> Parser (FieldValue sch ('TOption t))
parseJSON v :: Value
v = Maybe (FieldValue sch t) -> FieldValue sch ('TOption t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName).
Maybe (FieldValue sch t) -> FieldValue sch ('TOption t)
FOption (Maybe (FieldValue sch t) -> FieldValue sch ('TOption t))
-> Parser (Maybe (FieldValue sch t))
-> Parser (FieldValue sch ('TOption t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Maybe (FieldValue sch t))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance FromJSON (FieldValue sch t)
         => FromJSON (FieldValue sch ('TList t)) where
  parseJSON :: Value -> Parser (FieldValue sch ('TList t))
parseJSON v :: Value
v = [FieldValue sch t] -> FieldValue sch ('TList t)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (t :: FieldType typeName).
[FieldValue sch t] -> FieldValue sch ('TList t)
FList ([FieldValue sch t] -> FieldValue sch ('TList t))
-> Parser [FieldValue sch t] -> Parser (FieldValue sch ('TList t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [FieldValue sch t]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance ( FromJSONKey (FieldValue sch k), FromJSON (FieldValue sch v)
         , Ord (FieldValue sch k) )
         => FromJSON (FieldValue sch ('TMap k v)) where
  parseJSON :: Value -> Parser (FieldValue sch ('TMap k v))
parseJSON v :: Value
v = Map (FieldValue sch k) (FieldValue sch v)
-> FieldValue sch ('TMap k v)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (k :: FieldType typeName) (v :: FieldType typeName).
Ord (FieldValue sch k) =>
Map (FieldValue sch k) (FieldValue sch v)
-> FieldValue sch ('TMap k v)
FMap (Map (FieldValue sch k) (FieldValue sch v)
 -> FieldValue sch ('TMap k v))
-> Parser (Map (FieldValue sch k) (FieldValue sch v))
-> Parser (FieldValue sch ('TMap k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map (FieldValue sch k) (FieldValue sch v))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance (FromJSONUnion sch us)
         => FromJSON (FieldValue sch ('TUnion us)) where
  parseJSON :: Value -> Parser (FieldValue sch ('TUnion us))
parseJSON v :: Value
v = NS (FieldValue sch) us -> FieldValue sch ('TUnion us)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (choices :: [FieldType typeName]).
NS (FieldValue sch) choices -> FieldValue sch ('TUnion choices)
FUnion (NS (FieldValue sch) us -> FieldValue sch ('TUnion us))
-> Parser (NS (FieldValue sch) us)
-> Parser (FieldValue sch ('TUnion us))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NS (FieldValue sch) us)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (us :: [FieldType typeName]).
FromJSONUnion sch us =>
Value -> Parser (NS (FieldValue sch) us)
unionFromJSON Value
v

class FromJSONUnion sch us where
  unionFromJSON :: Value -> Parser (NS (FieldValue sch) us)
instance FromJSONUnion sch '[] where
  unionFromJSON :: Value -> Parser (NS (FieldValue sch) '[])
unionFromJSON _ = String -> Parser (NS (FieldValue sch) '[])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "value does not match any of the types of the union"
instance (FromJSON (FieldValue sch u), FromJSONUnion sch us)
         => FromJSONUnion sch (u ': us) where
  unionFromJSON :: Value -> Parser (NS (FieldValue sch) (u : us))
unionFromJSON v :: Value
v = FieldValue sch u -> NS (FieldValue sch) (u : us)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (FieldValue sch u -> NS (FieldValue sch) (u : us))
-> Parser (FieldValue sch u)
-> Parser (NS (FieldValue sch) (u : us))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (FieldValue sch u)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (NS (FieldValue sch) (u : us))
-> Parser (NS (FieldValue sch) (u : us))
-> Parser (NS (FieldValue sch) (u : us))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NS (FieldValue sch) us -> NS (FieldValue sch) (u : us)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (FieldValue sch) us -> NS (FieldValue sch) (u : us))
-> Parser (NS (FieldValue sch) us)
-> Parser (NS (FieldValue sch) (u : us))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NS (FieldValue sch) us)
forall typeName fieldName (sch :: Schema typeName fieldName)
       (us :: [FieldType typeName]).
FromJSONUnion sch us =>
Value -> Parser (NS (FieldValue sch) us)
unionFromJSON Value
v