{-# 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           Data.Functor.Identity
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 Applicative w => SLess.ToSchemalessTerm Value w where
  toSchemalessTerm :: Value -> Term w
toSchemalessTerm (Object o :: Object
o)
    = [Field w] -> Term w
forall (w :: * -> *). [Field w] -> Term w
SLess.TRecord ([Field w] -> Term w) -> [Field w] -> Term w
forall a b. (a -> b) -> a -> b
$ ((Text, Value) -> Field w) -> [(Text, Value)] -> [Field w]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: Text
k,v :: Value
v) -> Text -> w (FieldValue w) -> Field w
forall (w :: * -> *). Text -> w (FieldValue w) -> Field w
SLess.Field Text
k (FieldValue w -> w (FieldValue w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue w -> w (FieldValue w))
-> FieldValue w -> w (FieldValue w)
forall a b. (a -> b) -> a -> b
$ Value -> FieldValue w
forall t (w :: * -> *). ToSchemalessValue t w => t -> FieldValue w
SLess.toSchemalessValue Value
v))
                    ([(Text, Value)] -> [Field w]) -> [(Text, Value)] -> [Field w]
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 w -> Term w
forall (w :: * -> *). FieldValue w -> Term w
SLess.TSimple (Value -> FieldValue w
forall t (w :: * -> *). ToSchemalessValue t w => t -> FieldValue w
SLess.toSchemalessValue Value
v)

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

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

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

class ToJSONFields sch fields where
  toJSONFields :: NP (Field Identity sch) fields -> Object
instance ToJSONFields sch '[] where
  toJSONFields :: NP (Field Identity sch) '[] -> Object
toJSONFields _ = Object
forall k v. HashMap k v
HM.empty
instance (KnownName name, ToJSON (FieldValue Identity sch t), ToJSONFields sch fs)
         => ToJSONFields sch ('FieldDef name t ': fs) where
  toJSONFields :: NP (Field Identity sch) ('FieldDef name t : fs) -> Object
toJSONFields (Field (Identity v :: FieldValue Identity sch t
v) :* rest :: NP (Field Identity 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 Identity sch) xs -> Object
forall typeName fieldName (sch :: Schema typeName fieldName)
       (fields :: [FieldDef typeName fieldName]).
ToJSONFields sch fields =>
NP (Field Identity sch) fields -> Object
toJSONFields NP (Field Identity 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 Identity sch t -> Value
forall a. ToJSON a => a -> Value
toJSON FieldValue Identity sch t
v

class FromJSONFields w sch fields where
  parseJSONFields :: Object -> Parser (NP (Field w sch) fields)
instance FromJSONFields w sch '[] where
  parseJSONFields :: Object -> Parser (NP (Field w sch) '[])
parseJSONFields _ = NP (Field w sch) '[] -> Parser (NP (Field w sch) '[])
forall (m :: * -> *) a. Monad m => a -> m a
return NP (Field w sch) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance (Applicative w, KnownName name, FromJSON (FieldValue w sch t), FromJSONFields w sch fs)
         => FromJSONFields w sch ('FieldDef name t ': fs) where
  parseJSONFields :: Object -> Parser (NP (Field w sch) ('FieldDef name t : fs))
parseJSONFields v :: Object
v = Field w sch ('FieldDef name t)
-> NP (Field w sch) fs -> NP (Field w sch) ('FieldDef name t : fs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (Field w sch ('FieldDef name t)
 -> NP (Field w sch) fs -> NP (Field w sch) ('FieldDef name t : fs))
-> Parser (Field w sch ('FieldDef name t))
-> Parser
     (NP (Field w sch) fs -> NP (Field w sch) ('FieldDef name t : fs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (w (FieldValue w sch t) -> Field w sch ('FieldDef name t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName)
       (name :: fieldName).
w (FieldValue w sch t) -> Field w sch ('FieldDef name t)
Field (w (FieldValue w sch t) -> Field w sch ('FieldDef name t))
-> Parser (w (FieldValue w sch t))
-> Parser (Field w sch ('FieldDef name t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldValue w sch t -> w (FieldValue w sch t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue w sch t -> w (FieldValue w sch t))
-> Parser (FieldValue w sch t) -> Parser (w (FieldValue w sch t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (FieldValue w sch t)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
key)) Parser
  (NP (Field w sch) fs -> NP (Field w sch) ('FieldDef name t : fs))
-> Parser (NP (Field w sch) fs)
-> Parser (NP (Field w sch) ('FieldDef name t : fs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser (NP (Field w sch) fs)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName)
       (fields :: [FieldDef typeName fieldName]).
FromJSONFields w sch fields =>
Object -> Parser (NP (Field w 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 w sch ('DEnum name choices)) where
  toJSON :: Term w 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 w sch ('DEnum name choices)) where
  parseJSON :: Value -> Parser (Term w sch ('DEnum name choices))
parseJSON (String s :: Text
s) = NS Proxy choices -> Term w sch ('DEnum name choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
       (w :: * -> *) (sch :: Schema typeName fieldName)
       (name :: typeName).
NS Proxy choices -> Term w sch ('DEnum name choices)
TEnum (NS Proxy choices -> Term w sch ('DEnum name choices))
-> Parser (NS Proxy choices)
-> Parser (Term w 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 w 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 (m :: * -> *) a. Monad m => a -> m a
return (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 w sch t) => ToJSON (Term w sch ('DSimple t)) where
  toJSON :: Term w sch ('DSimple t) -> Value
toJSON (TSimple x :: FieldValue w sch t
x) = FieldValue w sch t -> Value
forall a. ToJSON a => a -> Value
toJSON FieldValue w sch t
x
instance FromJSON (FieldValue w sch t) => FromJSON (Term w sch ('DSimple t)) where
  parseJSON :: Value -> Parser (Term w sch ('DSimple t))
parseJSON v :: Value
v = FieldValue w sch t -> Term w sch ('DSimple t)
forall typeName fieldName (w :: * -> *)
       (sch :: Schema typeName fieldName) (t :: FieldType typeName).
FieldValue w sch t -> Term w sch ('DSimple t)
TSimple (FieldValue w sch t -> Term w sch ('DSimple t))
-> Parser (FieldValue w sch t) -> Parser (Term w sch ('DSimple t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (FieldValue w sch t)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

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

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

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

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