{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.AST.Value
( Value (..),
ScalarValue (..),
Object,
GQLValue (..),
replaceValue,
decodeScientific,
RawValue,
ValidValue,
RawObject,
ValidObject,
Variable (..),
ResolvedValue,
ResolvedObject,
VariableContent (..),
ObjectEntry (..),
VariableDefinitions,
)
where
import qualified Data.Aeson as A
( (.=),
FromJSON (..),
ToJSON (..),
Value (..),
object,
pairs,
)
import Data.Foldable (foldl1)
import qualified Data.HashMap.Lazy as M
import Data.Morpheus.Error.NameCollision
( NameCollision (..),
)
import Data.Morpheus.Ext.OrdMap
( OrdMap,
unsafeFromList,
)
import Data.Morpheus.Internal.Utils
( KeyOf (..),
elems,
mapTuple,
)
import Data.Morpheus.Rendering.RenderGQL
( RenderGQL (..),
fromText,
renderGQL,
renderInputSeq,
space,
)
import Data.Morpheus.Types.Internal.AST.Base
( FieldName,
FieldName (..),
Msg (..),
Position,
Ref (..),
TypeName (..),
TypeRef,
ValidationError (..),
msgValidation,
)
import Data.Morpheus.Types.Internal.AST.Stage
( CONST,
CONST_OR_VALID,
RAW,
Stage,
VALID,
)
import Data.Scientific
( Scientific,
floatingOrInteger,
)
import qualified Data.Vector as V
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))
import Relude
data ScalarValue
= Int Int
| Float Float
| String Text
| Boolean Bool
| Value A.Value
deriving (Int -> ScalarValue -> ShowS
[ScalarValue] -> ShowS
ScalarValue -> String
(Int -> ScalarValue -> ShowS)
-> (ScalarValue -> String)
-> ([ScalarValue] -> ShowS)
-> Show ScalarValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScalarValue] -> ShowS
$cshowList :: [ScalarValue] -> ShowS
show :: ScalarValue -> String
$cshow :: ScalarValue -> String
showsPrec :: Int -> ScalarValue -> ShowS
$cshowsPrec :: Int -> ScalarValue -> ShowS
Show, ScalarValue -> ScalarValue -> Bool
(ScalarValue -> ScalarValue -> Bool)
-> (ScalarValue -> ScalarValue -> Bool) -> Eq ScalarValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScalarValue -> ScalarValue -> Bool
$c/= :: ScalarValue -> ScalarValue -> Bool
== :: ScalarValue -> ScalarValue -> Bool
$c== :: ScalarValue -> ScalarValue -> Bool
Eq, (forall x. ScalarValue -> Rep ScalarValue x)
-> (forall x. Rep ScalarValue x -> ScalarValue)
-> Generic ScalarValue
forall x. Rep ScalarValue x -> ScalarValue
forall x. ScalarValue -> Rep ScalarValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScalarValue x -> ScalarValue
$cfrom :: forall x. ScalarValue -> Rep ScalarValue x
Generic, ScalarValue -> Q Exp
ScalarValue -> Q (TExp ScalarValue)
(ScalarValue -> Q Exp)
-> (ScalarValue -> Q (TExp ScalarValue)) -> Lift ScalarValue
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ScalarValue -> Q (TExp ScalarValue)
$cliftTyped :: ScalarValue -> Q (TExp ScalarValue)
lift :: ScalarValue -> Q Exp
$clift :: ScalarValue -> Q Exp
Lift)
instance RenderGQL ScalarValue where
render :: ScalarValue -> Rendering
render (Int Int
x) = Int -> Rendering
forall a. RenderGQL a => a -> Rendering
render Int
x
render (Float Float
x) = Float -> Rendering
forall a. RenderGQL a => a -> Rendering
render Float
x
render (String Text
x) = Text -> Rendering
forall a. RenderGQL a => a -> Rendering
render Text
x
render (Boolean Bool
x) = Bool -> Rendering
forall a. RenderGQL a => a -> Rendering
render Bool
x
render (Value Value
x) = Value -> Rendering
forall a. RenderGQL a => a -> Rendering
render Value
x
instance A.ToJSON ScalarValue where
toJSON :: ScalarValue -> Value
toJSON (Float Float
x) = Float -> Value
forall a. ToJSON a => a -> Value
A.toJSON Float
x
toJSON (Int Int
x) = Int -> Value
forall a. ToJSON a => a -> Value
A.toJSON Int
x
toJSON (Boolean Bool
x) = Bool -> Value
forall a. ToJSON a => a -> Value
A.toJSON Bool
x
toJSON (String Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
x
toJSON (Value Value
x) = Value -> Value
forall a. ToJSON a => a -> Value
A.toJSON Value
x
instance A.FromJSON ScalarValue where
parseJSON :: Value -> Parser ScalarValue
parseJSON (A.Bool Bool
v) = ScalarValue -> Parser ScalarValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Bool -> ScalarValue
Boolean Bool
v
parseJSON (A.Number Scientific
v) = ScalarValue -> Parser ScalarValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Scientific -> ScalarValue
decodeScientific Scientific
v
parseJSON (A.String Text
v) = ScalarValue -> Parser ScalarValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Parser ScalarValue)
-> ScalarValue -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ Text -> ScalarValue
String Text
v
parseJSON Value
notScalar = String -> Parser ScalarValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ScalarValue) -> String -> Parser ScalarValue
forall a b. (a -> b) -> a -> b
$ String
"Expected Scalar got :" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall b a. (Show a, IsString b) => a -> b
show Value
notScalar
data VariableContent (stage :: Stage) where
DefaultValue :: Maybe ResolvedValue -> VariableContent CONST
ValidVariableValue :: {VariableContent VALID -> ValidValue
validVarContent :: ValidValue} -> VariableContent VALID
instance Lift (VariableContent a) where
lift :: VariableContent a -> Q Exp
lift (DefaultValue Maybe ResolvedValue
x) = [|DefaultValue x|]
lift (ValidVariableValue ValidValue
x) = [|ValidVariableValue x|]
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped :: VariableContent a -> Q (TExp (VariableContent a))
liftTyped (DefaultValue Maybe ResolvedValue
x) = [||DefaultValue x||]
liftTyped (ValidVariableValue ValidValue
x) = [||ValidVariableValue x||]
#endif
deriving instance Show (VariableContent a)
deriving instance Eq (VariableContent a)
data Variable (stage :: Stage) = Variable
{ Variable stage -> Position
variablePosition :: Position,
Variable stage -> FieldName
variableName :: FieldName,
Variable stage -> TypeRef
variableType :: TypeRef,
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue :: VariableContent (CONST_OR_VALID stage)
}
deriving (Int -> Variable stage -> ShowS
[Variable stage] -> ShowS
Variable stage -> String
(Int -> Variable stage -> ShowS)
-> (Variable stage -> String)
-> ([Variable stage] -> ShowS)
-> Show (Variable stage)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (stage :: Stage). Int -> Variable stage -> ShowS
forall (stage :: Stage). [Variable stage] -> ShowS
forall (stage :: Stage). Variable stage -> String
showList :: [Variable stage] -> ShowS
$cshowList :: forall (stage :: Stage). [Variable stage] -> ShowS
show :: Variable stage -> String
$cshow :: forall (stage :: Stage). Variable stage -> String
showsPrec :: Int -> Variable stage -> ShowS
$cshowsPrec :: forall (stage :: Stage). Int -> Variable stage -> ShowS
Show, Variable stage -> Variable stage -> Bool
(Variable stage -> Variable stage -> Bool)
-> (Variable stage -> Variable stage -> Bool)
-> Eq (Variable stage)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (stage :: Stage). Variable stage -> Variable stage -> Bool
/= :: Variable stage -> Variable stage -> Bool
$c/= :: forall (stage :: Stage). Variable stage -> Variable stage -> Bool
== :: Variable stage -> Variable stage -> Bool
$c== :: forall (stage :: Stage). Variable stage -> Variable stage -> Bool
Eq, Variable stage -> Q Exp
Variable stage -> Q (TExp (Variable stage))
(Variable stage -> Q Exp)
-> (Variable stage -> Q (TExp (Variable stage)))
-> Lift (Variable stage)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (stage :: Stage). Variable stage -> Q Exp
forall (stage :: Stage).
Variable stage -> Q (TExp (Variable stage))
liftTyped :: Variable stage -> Q (TExp (Variable stage))
$cliftTyped :: forall (stage :: Stage).
Variable stage -> Q (TExp (Variable stage))
lift :: Variable stage -> Q Exp
$clift :: forall (stage :: Stage). Variable stage -> Q Exp
Lift)
instance KeyOf FieldName (Variable s) where
keyOf :: Variable s -> FieldName
keyOf = Variable s -> FieldName
forall (s :: Stage). Variable s -> FieldName
variableName
instance NameCollision (Variable s) where
nameCollision :: Variable s -> ValidationError
nameCollision Variable {FieldName
variableName :: FieldName
variableName :: forall (s :: Stage). Variable s -> FieldName
variableName, Position
variablePosition :: Position
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variablePosition} =
ValidationError :: Message -> [Position] -> ValidationError
ValidationError
{ validationMessage :: Message
validationMessage = Message
"There can Be only One Variable Named " Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
variableName,
validationLocations :: [Position]
validationLocations = [Position
variablePosition]
}
type VariableDefinitions s = OrdMap FieldName (Variable s)
data Value (stage :: Stage) where
ResolvedVariable :: Ref -> Variable VALID -> Value CONST
VariableValue :: Ref -> Value RAW
Object :: Object stage -> Value stage
List :: [Value stage] -> Value stage
Enum :: TypeName -> Value stage
Scalar :: ScalarValue -> Value stage
Null :: Value stage
deriving instance Show (Value a)
deriving instance Eq (Value s)
data ObjectEntry (s :: Stage) = ObjectEntry
{ ObjectEntry s -> FieldName
entryName :: FieldName,
ObjectEntry s -> Value s
entryValue :: Value s
}
deriving (ObjectEntry s -> ObjectEntry s -> Bool
(ObjectEntry s -> ObjectEntry s -> Bool)
-> (ObjectEntry s -> ObjectEntry s -> Bool) -> Eq (ObjectEntry s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
/= :: ObjectEntry s -> ObjectEntry s -> Bool
$c/= :: forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
== :: ObjectEntry s -> ObjectEntry s -> Bool
$c== :: forall (s :: Stage). ObjectEntry s -> ObjectEntry s -> Bool
Eq, Int -> ObjectEntry s -> ShowS
[ObjectEntry s] -> ShowS
ObjectEntry s -> String
(Int -> ObjectEntry s -> ShowS)
-> (ObjectEntry s -> String)
-> ([ObjectEntry s] -> ShowS)
-> Show (ObjectEntry s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> ObjectEntry s -> ShowS
forall (s :: Stage). [ObjectEntry s] -> ShowS
forall (s :: Stage). ObjectEntry s -> String
showList :: [ObjectEntry s] -> ShowS
$cshowList :: forall (s :: Stage). [ObjectEntry s] -> ShowS
show :: ObjectEntry s -> String
$cshow :: forall (s :: Stage). ObjectEntry s -> String
showsPrec :: Int -> ObjectEntry s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> ObjectEntry s -> ShowS
Show)
instance RenderGQL (ObjectEntry a) where
render :: ObjectEntry a -> Rendering
render (ObjectEntry (FieldName Text
name) Value a
value) = Text -> Rendering
fromText Text
name Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
": " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Value a -> Rendering
forall a. RenderGQL a => a -> Rendering
render Value a
value
instance NameCollision (ObjectEntry s) where
nameCollision :: ObjectEntry s -> ValidationError
nameCollision ObjectEntry {FieldName
entryName :: FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryName} =
ValidationError
"There can Be only One field Named " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> FieldName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation FieldName
entryName :: ValidationError
instance KeyOf FieldName (ObjectEntry s) where
keyOf :: ObjectEntry s -> FieldName
keyOf = ObjectEntry s -> FieldName
forall (s :: Stage). ObjectEntry s -> FieldName
entryName
type Object a = OrdMap FieldName (ObjectEntry a)
type ValidObject = Object VALID
type RawObject = Object RAW
type ResolvedObject = Object CONST
type RawValue = Value RAW
type ValidValue = Value VALID
type ResolvedValue = Value CONST
deriving instance Lift (Value a)
deriving instance Lift (ObjectEntry a)
instance RenderGQL (Value a) where
render :: Value a -> Rendering
render (ResolvedVariable Ref {FieldName
refName :: Ref -> FieldName
refName :: FieldName
refName} Variable VALID
_) = Rendering
"$" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldName
refName
render (VariableValue Ref {FieldName
refName :: FieldName
refName :: Ref -> FieldName
refName}) = Rendering
"$" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldName
refName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
" "
render Value a
Null = Rendering
"null"
render (Enum TypeName
x) = TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
x
render (Scalar ScalarValue
x) = ScalarValue -> Rendering
forall a. RenderGQL a => a -> Rendering
render ScalarValue
x
render (Object Object a
xs) = Rendering
"{" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
entries Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"}"
where
entries :: Rendering
entries
| [ObjectEntry a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
xs) = Rendering
""
| Bool
otherwise = Rendering
space Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [ObjectEntry a] -> Rendering
forall (t :: * -> *) a.
(Foldable t, RenderGQL a) =>
t a -> Rendering
renderInputSeq (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
xs) Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
space
render (List [Value a]
list) = Rendering
"[" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [Value a] -> Rendering
forall (t :: * -> *) a.
(Foldable t, RenderGQL a) =>
t a -> Rendering
renderInputSeq [Value a]
list Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
"]"
instance Msg (Value a) where
msg :: Value a -> Message
msg = ByteString -> Message
forall a. Msg a => a -> Message
msg (ByteString -> Message)
-> (Value a -> ByteString) -> Value a -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> ByteString
forall a. RenderGQL a => a -> ByteString
renderGQL
instance A.ToJSON (Value a) where
toJSON :: Value a -> Value
toJSON (ResolvedVariable Ref
_ Variable {variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = ValidVariableValue ValidValue
x}) =
ValidValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON ValidValue
x
toJSON (VariableValue Ref {FieldName
refName :: FieldName
refName :: Ref -> FieldName
refName}) =
Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"($ref:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName -> Text
readName FieldName
refName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
toJSON Value a
Null = Value
A.Null
toJSON (Enum (TypeName Text
x)) = Text -> Value
A.String Text
x
toJSON (Scalar ScalarValue
x) = ScalarValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON ScalarValue
x
toJSON (List [Value a]
x) = [Value a] -> Value
forall a. ToJSON a => a -> Value
A.toJSON [Value a]
x
toJSON (Object Object a
fields) = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (ObjectEntry a -> Pair) -> [ObjectEntry a] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObjectEntry a -> Pair
forall kv (s :: Stage). KeyValue kv => ObjectEntry s -> kv
toEntry (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
fields)
where
toEntry :: ObjectEntry s -> kv
toEntry (ObjectEntry (FieldName Text
name) Value s
value) = Text
name Text -> Value -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Value s -> Value
forall a. ToJSON a => a -> Value
A.toJSON Value s
value
toEncoding :: Value a -> Encoding
toEncoding (ResolvedVariable Ref
_ Variable {variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = ValidVariableValue ValidValue
x}) =
ValidValue -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding ValidValue
x
toEncoding (VariableValue Ref {FieldName
refName :: FieldName
refName :: Ref -> FieldName
refName}) =
FieldName -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (FieldName -> Encoding) -> FieldName -> Encoding
forall a b. (a -> b) -> a -> b
$ FieldName
"($ref:" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
refName FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
")"
toEncoding Value a
Null = Value -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding Value
A.Null
toEncoding (Enum TypeName
x) = TypeName -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding TypeName
x
toEncoding (Scalar ScalarValue
x) = ScalarValue -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding ScalarValue
x
toEncoding (List [Value a]
x) = [Value a] -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding [Value a]
x
toEncoding (Object Object a
ordmap)
| Object a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object a
ordmap = Value -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (Value -> Encoding) -> Value -> Encoding
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object []
| Bool
otherwise = Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ (Series -> Series -> Series) -> [Series] -> Series
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
(<>) ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$ (ObjectEntry a -> Series) -> [ObjectEntry a] -> [Series]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ObjectEntry a -> Series
forall kv (s :: Stage). KeyValue kv => ObjectEntry s -> kv
encodeField (Object a -> [ObjectEntry a]
forall a coll. Elems a coll => coll -> [a]
elems Object a
ordmap)
where
encodeField :: ObjectEntry s -> kv
encodeField (ObjectEntry (FieldName Text
key) Value s
value) = Text
key Text -> Value s -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= Value s
value
decodeScientific :: Scientific -> ScalarValue
decodeScientific :: Scientific -> ScalarValue
decodeScientific Scientific
v = case Scientific -> Either Float Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
v of
Left Float
float -> Float -> ScalarValue
Float Float
float
Right Int
int -> Int -> ScalarValue
Int Int
int
replaceValue :: A.Value -> Value a
replaceValue :: Value -> Value a
replaceValue (A.Bool Bool
v) = Bool -> Value a
forall a. GQLValue a => Bool -> a
gqlBoolean Bool
v
replaceValue (A.Number Scientific
v) = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a) -> ScalarValue -> Value a
forall a b. (a -> b) -> a -> b
$ Scientific -> ScalarValue
decodeScientific Scientific
v
replaceValue (A.String Text
v) = Text -> Value a
forall a. GQLValue a => Text -> a
gqlString Text
v
replaceValue (A.Object Object
v) =
[(FieldName, Value a)] -> Value a
forall a. GQLValue a => [(FieldName, a)] -> a
gqlObject ([(FieldName, Value a)] -> Value a)
-> [(FieldName, Value a)] -> Value a
forall a b. (a -> b) -> a -> b
$
(Pair -> (FieldName, Value a)) -> [Pair] -> [(FieldName, Value a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
((Text -> FieldName)
-> (Value -> Value a) -> Pair -> (FieldName, Value a)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
mapTuple Text -> FieldName
FieldName Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue)
(Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
M.toList Object
v)
replaceValue (A.Array Array
li) = [Value a] -> Value a
forall a. GQLValue a => [a] -> a
gqlList ((Value -> Value a) -> [Value] -> [Value a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
li))
replaceValue Value
A.Null = Value a
forall a. GQLValue a => a
gqlNull
instance A.FromJSON (Value a) where
parseJSON :: Value -> Parser (Value a)
parseJSON = Value a -> Parser (Value a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value a -> Parser (Value a))
-> (Value -> Value a) -> Value -> Parser (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue
class GQLValue a where
gqlNull :: a
gqlScalar :: ScalarValue -> a
gqlBoolean :: Bool -> a
gqlString :: Text -> a
gqlList :: [a] -> a
gqlObject :: [(FieldName, a)] -> a
instance GQLValue (Value a) where
gqlNull :: Value a
gqlNull = Value a
forall (a :: Stage). Value a
Null
gqlScalar :: ScalarValue -> Value a
gqlScalar = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar
gqlBoolean :: Bool -> Value a
gqlBoolean = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a)
-> (Bool -> ScalarValue) -> Bool -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ScalarValue
Boolean
gqlString :: Text -> Value a
gqlString = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a)
-> (Text -> ScalarValue) -> Text -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ScalarValue
String
gqlList :: [Value a] -> Value a
gqlList = [Value a] -> Value a
forall (a :: Stage). [Value a] -> Value a
List
gqlObject :: [(FieldName, Value a)] -> Value a
gqlObject = Object a -> Value a
forall (stage :: Stage). Object stage -> Value stage
Object (Object a -> Value a)
-> ([(FieldName, Value a)] -> Object a)
-> [(FieldName, Value a)]
-> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldName, ObjectEntry a)] -> Object a
forall k a. (Hashable k, Eq k) => [(k, a)] -> OrdMap k a
unsafeFromList ([(FieldName, ObjectEntry a)] -> Object a)
-> ([(FieldName, Value a)] -> [(FieldName, ObjectEntry a)])
-> [(FieldName, Value a)]
-> Object a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FieldName, Value a) -> (FieldName, ObjectEntry a))
-> [(FieldName, Value a)] -> [(FieldName, ObjectEntry a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldName, Value a) -> (FieldName, ObjectEntry a)
forall (s :: Stage).
(FieldName, Value s) -> (FieldName, ObjectEntry s)
toEntry
where
toEntry :: (FieldName, Value s) -> (FieldName, ObjectEntry s)
toEntry (FieldName
key, Value s
value) = (FieldName
key, FieldName -> Value s -> ObjectEntry s
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
key Value s
value)