{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}

-- | Types and functions used for input and result coercion.
module Language.GraphQL.Execute.Coerce
    ( Output(..)
    , Serialize(..)
    , VariableValue(..)
    , coerceInputLiteral
    , matchFieldValues
    ) where

#ifdef WITH_JSON
import qualified Data.Aeson as Aeson
import Data.Scientific (toBoundedInteger, toRealFloat)
#endif
import Data.Int (Int32)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
import Language.GraphQL.AST (Name)
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out

-- | Since variables are passed separately from the query, in an independent
-- format, they should be first coerced to the internal representation used by
-- this implementation.
class VariableValue a where
    -- | Only a basic, format-specific, coercion must be done here. Type
    -- correctness or nullability shouldn't be validated here, they will be
    -- validated later. The type information is provided only as a hint.
    --
    -- For example @GraphQL@ prohibits the coercion from a 't:Float' to an
    -- 't:Int', but @JSON@ doesn't have integers, so whole numbers should be
    -- coerced to 't:Int` when receiving variables as a JSON object. The same
    -- holds for 't:Enum'. There are formats that support enumerations, @JSON@
    -- doesn't, so the type information is given and 'coerceVariableValue' can
    -- check that an 't:Enum' is expected and treat the given value
    -- appropriately. Even checking whether this value is a proper member of the
    -- corresponding 't:Enum' type isn't required here, since this can be
    -- checked independently.
    --
    -- Another example is an @ID@. @GraphQL@ explicitly allows to coerce
    -- integers and strings to @ID@s, so if an @ID@ is received as an integer,
    -- it can be left as is and will be coerced later.
    --
    -- If a value cannot be coerced without losing information, 'Nothing' should
    -- be returned, the coercion will fail then and the query won't be executed.
    coerceVariableValue
        :: In.Type -- ^ Expected type (variable type given in the query).
        -> a -- ^ Variable value being coerced.
        -> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise.

instance VariableValue Type.Value where
    coerceVariableValue :: Type -> Value -> Maybe Value
coerceVariableValue Type
_ Value
Type.Null = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Type.Null
    coerceVariableValue (In.ScalarBaseType ScalarType
_) Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value
    coerceVariableValue (In.EnumBaseType EnumType
_) (Type.Enum Name
stringValue) =
        Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
stringValue
    coerceVariableValue (In.InputObjectBaseType InputObjectType
objectType) Value
value
        | (Type.Object HashMap Name Value
objectValue) <- Value
value = do
            let (In.InputObjectType Name
_ Maybe Name
_ HashMap Name InputField
inputFields) = InputObjectType
objectType
            (HashMap Name Value
newObjectValue, HashMap Name Value
resultMap) <- HashMap Name Value
-> HashMap Name InputField
-> Maybe (HashMap Name Value, HashMap Name Value)
forall v k.
(VariableValue v, Eq k, Hashable k) =>
HashMap k v
-> HashMap k InputField -> Maybe (HashMap k v, HashMap k Value)
foldWithKey HashMap Name Value
objectValue HashMap Name InputField
inputFields
            if HashMap Name Value -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Name Value
newObjectValue
                then Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ HashMap Name Value -> Value
Type.Object HashMap Name Value
resultMap
                else Maybe Value
forall a. Maybe a
Nothing
      where
        foldWithKey :: HashMap k v
-> HashMap k InputField -> Maybe (HashMap k v, HashMap k Value)
foldWithKey HashMap k v
objectValue = (k
 -> InputField
 -> Maybe (HashMap k v, HashMap k Value)
 -> Maybe (HashMap k v, HashMap k Value))
-> Maybe (HashMap k v, HashMap k Value)
-> HashMap k InputField
-> Maybe (HashMap k v, HashMap k Value)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey k
-> InputField
-> Maybe (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall k v.
(VariableValue v, Eq k, Hashable k) =>
k
-> InputField
-> Maybe (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
matchFieldValues'
            (Maybe (HashMap k v, HashMap k Value)
 -> HashMap k InputField -> Maybe (HashMap k v, HashMap k Value))
-> Maybe (HashMap k v, HashMap k Value)
-> HashMap k InputField
-> Maybe (HashMap k v, HashMap k Value)
forall a b. (a -> b) -> a -> b
$ (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall a. a -> Maybe a
Just (HashMap k v
objectValue, HashMap k Value
forall k v. HashMap k v
HashMap.empty)
        matchFieldValues' :: k
-> InputField
-> Maybe (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
matchFieldValues' k
_ InputField
_ Maybe (HashMap k v, HashMap k Value)
Nothing = Maybe (HashMap k v, HashMap k Value)
forall a. Maybe a
Nothing
        matchFieldValues' k
fieldName InputField
inputField (Just (HashMap k v
objectValue, HashMap k Value
resultMap)) =
            let (In.InputField Maybe Name
_ Type
fieldType Maybe Value
_) = InputField
inputField
                insert :: Value -> HashMap k Value
insert = (Value -> HashMap k Value -> HashMap k Value)
-> HashMap k Value -> Value -> HashMap k Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> Value -> HashMap k Value -> HashMap k Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
fieldName) HashMap k Value
resultMap
                newObjectValue :: HashMap k v
newObjectValue = k -> HashMap k v -> HashMap k v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete k
fieldName HashMap k v
objectValue
             in case k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
fieldName HashMap k v
objectValue of
                    Just v
variableValue -> do
                        Value
coerced <- Type -> v -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
fieldType v
variableValue
                        (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap k v
newObjectValue, Value -> HashMap k Value
insert Value
coerced)
                    Maybe v
Nothing -> (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall a. a -> Maybe a
Just (HashMap k v
objectValue, HashMap k Value
resultMap)
    coerceVariableValue (In.ListBaseType Type
listType) Value
value
        | (Type.List [Value]
arrayValue) <- Value
value =
            [Value] -> Value
Type.List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Maybe Value) -> [Value] -> Maybe [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Type -> Value -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
listType) [Value]
arrayValue
        | Bool
otherwise = Type -> Value -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
listType Value
value
    coerceVariableValue Type
_ Value
_ = Maybe Value
forall a. Maybe a
Nothing

-- | Looks up a value by name in the given map, coerces it and inserts into the
-- result map. If the coercion fails, returns 'Nothing'. If the value isn't
-- given, but a default value is known, inserts the default value into the
-- result map. Otherwise it fails with 'Nothing' if the Input Type is a
-- Non-Nullable type, or returns the unchanged, original map.
matchFieldValues :: forall a
    . (In.Type -> a -> Maybe Type.Value)
    -> HashMap Name a
    -> Name
    -> In.Type
    -> Maybe Type.Value
    -> Maybe (HashMap Name Type.Value)
    -> Maybe (HashMap Name Type.Value)
matchFieldValues :: (Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues Type -> a -> Maybe Value
coerce HashMap Name a
values' Name
fieldName Type
type' Maybe Value
defaultValue Maybe (HashMap Name Value)
resultMap =
    case Name -> HashMap Name a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldName HashMap Name a
values' of
        Just a
variableValue -> Maybe Value -> Maybe (HashMap Name Value)
coerceRuntimeValue (Maybe Value -> Maybe (HashMap Name Value))
-> Maybe Value -> Maybe (HashMap Name Value)
forall a b. (a -> b) -> a -> b
$ Type -> a -> Maybe Value
coerce Type
type' a
variableValue
        Maybe a
Nothing
            | Just Value
value <- Maybe Value
defaultValue ->
                Name -> Value -> HashMap Name Value -> HashMap Name Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
fieldName Value
value (HashMap Name Value -> HashMap Name Value)
-> Maybe (HashMap Name Value) -> Maybe (HashMap Name Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HashMap Name Value)
resultMap
            | Maybe Value
Nothing <- Maybe Value
defaultValue
            , Type -> Bool
In.isNonNullType Type
type' -> Maybe (HashMap Name Value)
forall a. Maybe a
Nothing
            | Bool
otherwise -> Maybe (HashMap Name Value)
resultMap
  where
    coerceRuntimeValue :: Maybe Value -> Maybe (HashMap Name Value)
coerceRuntimeValue (Just Value
Type.Null)
        | Type -> Bool
In.isNonNullType Type
type' = Maybe (HashMap Name Value)
forall a. Maybe a
Nothing
    coerceRuntimeValue Maybe Value
coercedValue =
        Name -> Value -> HashMap Name Value -> HashMap Name Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Name
fieldName (Value -> HashMap Name Value -> HashMap Name Value)
-> Maybe Value -> Maybe (HashMap Name Value -> HashMap Name Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
coercedValue Maybe (HashMap Name Value -> HashMap Name Value)
-> Maybe (HashMap Name Value) -> Maybe (HashMap Name Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (HashMap Name Value)
resultMap

-- | Coerces operation arguments according to the input coercion rules for the
-- corresponding types.
coerceInputLiteral :: In.Type -> Type.Value -> Maybe Type.Value
coerceInputLiteral :: Type -> Value -> Maybe Value
coerceInputLiteral (Type -> Bool
In.isNonNullType -> Bool
False) Value
Type.Null = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Type.Null
coerceInputLiteral (In.ScalarBaseType ScalarType
type') Value
value
    | (Type.String Name
stringValue) <- Value
value
    , (Type.ScalarType Name
"String" Maybe Name
_) <- ScalarType
type' = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
stringValue
    | (Type.Boolean Bool
booleanValue) <- Value
value
    , (Type.ScalarType Name
"Boolean" Maybe Name
_) <- ScalarType
type' = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Type.Boolean Bool
booleanValue
    | (Type.Int Int32
intValue) <- Value
value
    , (Type.ScalarType Name
"Int" Maybe Name
_) <- ScalarType
type' = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Type.Int Int32
intValue
    | (Type.Float Double
floatValue) <- Value
value
    , (Type.ScalarType Name
"Float" Maybe Name
_) <- ScalarType
type' = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float Double
floatValue
    | (Type.Int Int32
intValue) <- Value
value
    , (Type.ScalarType Name
"Float" Maybe Name
_) <- ScalarType
type' =
        Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
intValue
    | (Type.String Name
stringValue) <- Value
value
    , (Type.ScalarType Name
"ID" Maybe Name
_) <- ScalarType
type' = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
stringValue
    | (Type.Int Int32
intValue) <- Value
value
    , (Type.ScalarType Name
"ID" Maybe Name
_) <- ScalarType
type' = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Value
decimal Int32
intValue
  where
    decimal :: Int32 -> Value
decimal = Name -> Value
Type.String
        (Name -> Value) -> (Int32 -> Name) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Name
Text.Lazy.toStrict
        (Text -> Name) -> (Int32 -> Text) -> Int32 -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Text.Builder.toLazyText
        (Builder -> Text) -> (Int32 -> Builder) -> Int32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal
coerceInputLiteral (In.EnumBaseType EnumType
type') (Type.Enum Name
enumValue)
    | Name -> EnumType -> Bool
member Name
enumValue EnumType
type' = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enumValue
  where
    member :: Name -> EnumType -> Bool
member Name
value (Type.EnumType Name
_ Maybe Name
_ HashMap Name EnumValue
members) = Name -> HashMap Name EnumValue -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Name
value HashMap Name EnumValue
members
coerceInputLiteral (In.InputObjectBaseType InputObjectType
type') (Type.Object HashMap Name Value
values) = 
    let (In.InputObjectType Name
_ Maybe Name
_ HashMap Name InputField
inputFields) = InputObjectType
type'
     in HashMap Name Value -> Value
Type.Object
            (HashMap Name Value -> Value)
-> Maybe (HashMap Name Value) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name
 -> InputField
 -> Maybe (HashMap Name Value)
 -> Maybe (HashMap Name Value))
-> Maybe (HashMap Name Value)
-> HashMap Name InputField
-> Maybe (HashMap Name Value)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey (HashMap Name Value
-> Name
-> InputField
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues' HashMap Name Value
values) (HashMap Name Value -> Maybe (HashMap Name Value)
forall a. a -> Maybe a
Just HashMap Name Value
forall k v. HashMap k v
HashMap.empty) HashMap Name InputField
inputFields
  where
    matchFieldValues' :: HashMap Name Value
-> Name
-> InputField
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues' HashMap Name Value
values' Name
fieldName (In.InputField Maybe Name
_ Type
inputFieldType Maybe Value
defaultValue) =
        (Type -> Value -> Maybe Value)
-> HashMap Name Value
-> Name
-> Type
-> Maybe Value
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe (HashMap Name Value)
-> Maybe (HashMap Name Value)
matchFieldValues Type -> Value -> Maybe Value
coerceInputLiteral HashMap Name Value
values' Name
fieldName Type
inputFieldType Maybe Value
defaultValue
coerceInputLiteral (In.ListBaseType Type
listType) (Type.List [Value]
list) =
    [Value] -> Value
Type.List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Maybe Value) -> [Value] -> Maybe [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Type -> Value -> Maybe Value
coerceInputLiteral Type
listType) [Value]
list
coerceInputLiteral (In.ListBaseType Type
listType) Value
singleton =
    Type -> Value -> Maybe Value
wrapSingleton Type
listType Value
singleton
  where
      wrapSingleton :: Type -> Value -> Maybe Value
wrapSingleton (In.ListBaseType Type
listType') Value
singleton' =
          [Value] -> Value
Type.List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Type -> Value -> Maybe Value
wrapSingleton Type
listType' Value
singleton']
      wrapSingleton Type
listType' Value
singleton' =
          [Value] -> Value
Type.List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Type -> Value -> Maybe Value
coerceInputLiteral Type
listType' Value
singleton']
coerceInputLiteral Type
_ Value
_ = Maybe Value
forall a. Maybe a
Nothing

-- | 'Serialize' describes how a @GraphQL@ value should be serialized.
class Serialize a where
    -- | Serializes a @GraphQL@ value according to the given serialization
    -- format.
    --
    -- Type infomration is given as a hint, e.g. if you need to know what type
    -- is being serialized to serialize it properly. Don't do any validation for
    -- @GraphQL@ built-in types here.
    --
    -- If the value cannot be serialized without losing information, return
    -- 'Nothing' — it will cause a field error.
    serialize :: forall m
        . Out.Type m -- ^ Expected output type.
        -> Output a -- ^ The value to be serialized.
        -> Maybe a -- ^ Serialized value on success or 'Nothing'.
    -- | __null__ representation in the given serialization format.
    null :: a

-- | Intermediate type used to serialize a @GraphQL@ value.
--
-- The serialization is done during the execution, and 'Output' contains
-- already serialized data (in 'List' and 'Object') as well as the new layer
-- that has to be serialized in the current step. So 'Output' is parameterized
-- by the serialization format.
data Output a
    = Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Enum Name
    | List [a]
    | Object (OrderedMap a)
    deriving (Output a -> Output a -> Bool
(Output a -> Output a -> Bool)
-> (Output a -> Output a -> Bool) -> Eq (Output a)
forall a. Eq a => Output a -> Output a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output a -> Output a -> Bool
$c/= :: forall a. Eq a => Output a -> Output a -> Bool
== :: Output a -> Output a -> Bool
$c== :: forall a. Eq a => Output a -> Output a -> Bool
Eq, Int -> Output a -> ShowS
[Output a] -> ShowS
Output a -> String
(Int -> Output a -> ShowS)
-> (Output a -> String) -> ([Output a] -> ShowS) -> Show (Output a)
forall a. Show a => Int -> Output a -> ShowS
forall a. Show a => [Output a] -> ShowS
forall a. Show a => Output a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output a] -> ShowS
$cshowList :: forall a. Show a => [Output a] -> ShowS
show :: Output a -> String
$cshow :: forall a. Show a => Output a -> String
showsPrec :: Int -> Output a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Output a -> ShowS
Show)

instance forall a. IsString (Output a) where
    fromString :: String -> Output a
fromString = Name -> Output a
forall a. Name -> Output a
String (Name -> Output a) -> (String -> Name) -> String -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
forall a. IsString a => String -> a
fromString

instance Serialize Type.Value where
    null :: Value
null = Value
Type.Null
    serialize :: Type m -> Output Value -> Maybe Value
serialize (Out.ScalarBaseType ScalarType
scalarType) Output Value
value
        | Type.ScalarType Name
"Int" Maybe Name
_ <- ScalarType
scalarType
        , Int Int32
int <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Value
Type.Int Int32
int
        | Type.ScalarType Name
"Float" Maybe Name
_ <- ScalarType
scalarType
        , Float Double
float <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float Double
float
        | Type.ScalarType Name
"String" Maybe Name
_ <- ScalarType
scalarType
        , String Name
string <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
string
        | Type.ScalarType Name
"ID" Maybe Name
_ <- ScalarType
scalarType
        , String Name
string <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
string
        | Type.ScalarType Name
"Boolean" Maybe Name
_ <- ScalarType
scalarType
        , Boolean Bool
boolean <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Type.Boolean Bool
boolean
    serialize Type m
_ (Enum Name
enum) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enum
    serialize Type m
_ (List [Value]
list) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
Type.List [Value]
list
    serialize Type m
_ (Object OrderedMap Value
object) = Value -> Maybe Value
forall a. a -> Maybe a
Just
        (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ HashMap Name Value -> Value
Type.Object
        (HashMap Name Value -> Value) -> HashMap Name Value -> Value
forall a b. (a -> b) -> a -> b
$ [(Name, Value)] -> HashMap Name Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
        ([(Name, Value)] -> HashMap Name Value)
-> [(Name, Value)] -> HashMap Name Value
forall a b. (a -> b) -> a -> b
$ OrderedMap Value -> [(Name, Value)]
forall v. OrderedMap v -> [(Name, v)]
OrderedMap.toList OrderedMap Value
object
    serialize Type m
_ Output Value
_ = Maybe Value
forall a. Maybe a
Nothing

#ifdef WITH_JSON
instance Serialize Aeson.Value where
    serialize :: Type m -> Output Value -> Maybe Value
serialize (Out.ScalarBaseType ScalarType
scalarType) Output Value
value
        | Type.ScalarType Name
"Int" Maybe Name
_ <- ScalarType
scalarType
        , Int Int32
int <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Int32
int
        | Type.ScalarType Name
"Float" Maybe Name
_ <- ScalarType
scalarType
        , Float Double
float <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Double
float
        | Type.ScalarType Name
"String" Maybe Name
_ <- ScalarType
scalarType
        , String Name
string <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Aeson.String Name
string
        | Type.ScalarType Name
"ID" Maybe Name
_ <- ScalarType
scalarType
        , String Name
string <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Aeson.String Name
string
        | Type.ScalarType Name
"Boolean" Maybe Name
_ <- ScalarType
scalarType
        , Boolean Bool
boolean <- Output Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Aeson.Bool Bool
boolean
    serialize Type m
_ (Enum Name
enum) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Aeson.String Name
enum
    serialize Type m
_ (List [Value]
list) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON [Value]
list
    serialize Type m
_ (Object OrderedMap Value
object) = Value -> Maybe Value
forall a. a -> Maybe a
Just
        (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object
        ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ OrderedMap Value -> [Pair]
forall v. OrderedMap v -> [(Name, v)]
OrderedMap.toList
        (OrderedMap Value -> [Pair]) -> OrderedMap Value -> [Pair]
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Value -> Value) -> OrderedMap Value -> OrderedMap Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrderedMap Value
object
    serialize Type m
_ Output Value
_ = Maybe Value
forall a. Maybe a
Nothing
    null :: Value
null = Value
Aeson.Null

instance VariableValue Aeson.Value where
    coerceVariableValue :: Type -> Value -> Maybe Value
coerceVariableValue Type
_ Value
Aeson.Null = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Type.Null
    coerceVariableValue (In.ScalarBaseType ScalarType
scalarType) Value
value
        | (Aeson.String Name
stringValue) <- Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.String Name
stringValue
        | (Aeson.Bool Bool
booleanValue) <- Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Type.Boolean Bool
booleanValue
        | (Aeson.Number Scientific
numberValue) <- Value
value
        , (Type.ScalarType Name
"Float" Maybe Name
_) <- ScalarType
scalarType =
            Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Type.Float (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
numberValue
        | (Aeson.Number Scientific
numberValue) <- Value
value = -- ID or Int
            Int32 -> Value
Type.Int (Int32 -> Value) -> Maybe Int32 -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> Maybe Int32
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
numberValue
    coerceVariableValue (In.EnumBaseType EnumType
_) (Aeson.String Name
stringValue) =
        Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
stringValue
    coerceVariableValue (In.InputObjectBaseType InputObjectType
objectType) Value
value
        | (Aeson.Object Object
objectValue) <- Value
value = do
            let (In.InputObjectType Name
_ Maybe Name
_ HashMap Name InputField
inputFields) = InputObjectType
objectType
            (Object
newObjectValue, HashMap Name Value
resultMap) <- Object
-> HashMap Name InputField -> Maybe (Object, HashMap Name Value)
forall v k.
(VariableValue v, Eq k, Hashable k) =>
HashMap k v
-> HashMap k InputField -> Maybe (HashMap k v, HashMap k Value)
foldWithKey Object
objectValue HashMap Name InputField
inputFields
            if Object -> Bool
forall k v. HashMap k v -> Bool
HashMap.null Object
newObjectValue
                then Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ HashMap Name Value -> Value
Type.Object HashMap Name Value
resultMap
                else Maybe Value
forall a. Maybe a
Nothing
      where
        foldWithKey :: HashMap k v
-> HashMap k InputField -> Maybe (HashMap k v, HashMap k Value)
foldWithKey HashMap k v
objectValue = (k
 -> InputField
 -> Maybe (HashMap k v, HashMap k Value)
 -> Maybe (HashMap k v, HashMap k Value))
-> Maybe (HashMap k v, HashMap k Value)
-> HashMap k InputField
-> Maybe (HashMap k v, HashMap k Value)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey k
-> InputField
-> Maybe (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall k v.
(VariableValue v, Eq k, Hashable k) =>
k
-> InputField
-> Maybe (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
matchFieldValues'
            (Maybe (HashMap k v, HashMap k Value)
 -> HashMap k InputField -> Maybe (HashMap k v, HashMap k Value))
-> Maybe (HashMap k v, HashMap k Value)
-> HashMap k InputField
-> Maybe (HashMap k v, HashMap k Value)
forall a b. (a -> b) -> a -> b
$ (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall a. a -> Maybe a
Just (HashMap k v
objectValue, HashMap k Value
forall k v. HashMap k v
HashMap.empty)
        matchFieldValues' :: k
-> InputField
-> Maybe (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
matchFieldValues' k
_ InputField
_ Maybe (HashMap k v, HashMap k Value)
Nothing = Maybe (HashMap k v, HashMap k Value)
forall a. Maybe a
Nothing
        matchFieldValues' k
fieldName InputField
inputField (Just (HashMap k v
objectValue, HashMap k Value
resultMap)) =
            let (In.InputField Maybe Name
_ Type
fieldType Maybe Value
_) = InputField
inputField
                insert :: Value -> HashMap k Value
insert = (Value -> HashMap k Value -> HashMap k Value)
-> HashMap k Value -> Value -> HashMap k Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> Value -> HashMap k Value -> HashMap k Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
fieldName) HashMap k Value
resultMap
                newObjectValue :: HashMap k v
newObjectValue = k -> HashMap k v -> HashMap k v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete k
fieldName HashMap k v
objectValue
             in case k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
fieldName HashMap k v
objectValue of
                    Just v
variableValue -> do
                        Value
coerced <- Type -> v -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
fieldType v
variableValue
                        (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap k v
newObjectValue, Value -> HashMap k Value
insert Value
coerced)
                    Maybe v
Nothing -> (HashMap k v, HashMap k Value)
-> Maybe (HashMap k v, HashMap k Value)
forall a. a -> Maybe a
Just (HashMap k v
objectValue, HashMap k Value
resultMap)
    coerceVariableValue (In.ListBaseType Type
listType) Value
value
        | (Aeson.Array Array
arrayValue) <- Value
value =
            [Value] -> Value
Type.List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Maybe [Value] -> Maybe [Value])
-> Maybe [Value] -> Array -> Maybe [Value]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Value -> Maybe [Value] -> Maybe [Value]
forall a. VariableValue a => a -> Maybe [Value] -> Maybe [Value]
foldVector ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just []) Array
arrayValue
        | Bool
otherwise = Type -> Value -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
listType Value
value
      where
        foldVector :: a -> Maybe [Value] -> Maybe [Value]
foldVector a
_ Maybe [Value]
Nothing = Maybe [Value]
forall a. Maybe a
Nothing
        foldVector a
variableValue (Just [Value]
list) = do
            Value
coerced <- Type -> a -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
listType a
variableValue
            [Value] -> Maybe [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ Value
coerced Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
list 
    coerceVariableValue Type
_ Value
_ = Maybe Value
forall a. Maybe a
Nothing
#endif