Stub request execution

This commit is contained in:
Eugen Wissner 2021-08-17 10:38:14 +02:00
parent 38ec439e9f
commit f527b61a3d

View File

@ -2,7 +2,9 @@
v. 2.0. If a copy of the MPL was not distributed with this file, You can 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/. -} obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Language.GraphQL.Executor module Language.GraphQL.Executor
( Error(..) ( Error(..)
@ -10,14 +12,20 @@ module Language.GraphQL.Executor
, QueryError(..) , QueryError(..)
, Response(..) , Response(..)
, Segment(..) , Segment(..)
, coerceVariableValues
, executeRequest , executeRequest
) where ) where
import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.AST.Document as Full
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Foldable (find) import Data.Foldable (find)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Language.GraphQL.Execute.Coerce as Coerce
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Internal as Type.Internal import qualified Language.GraphQL.Type.Internal as Type.Internal
import qualified Language.GraphQL.Type.Schema as Schema
data Segment = Segment String | Index Int data Segment = Segment String | Index Int
@ -35,11 +43,13 @@ data Response = Response
data QueryError data QueryError
= OperationNameRequired = OperationNameRequired
| OperationNotFound String | OperationNotFound String
| CoercionError
instance Show QueryError where instance Show QueryError where
show OperationNameRequired = "Operation name is required." show OperationNameRequired = "Operation name is required."
show (OperationNotFound operationName) = show (OperationNotFound operationName) =
concat ["Operation \"", operationName, "\" not found."] concat ["Operation \"", operationName, "\" not found."]
show CoercionError = "Coercion error."
respondWithQueryError :: QueryError -> Response respondWithQueryError :: QueryError -> Response
respondWithQueryError queryError respondWithQueryError queryError
@ -82,7 +92,9 @@ executeRequest _schema sourceDocument operationName _variableValues _initialValu
operation = getOperation transformedDocument operationName operation = getOperation transformedDocument operationName
in case operation of in case operation of
Left queryError -> pure $ respondWithQueryError queryError Left queryError -> pure $ respondWithQueryError queryError
Right _ -> pure $ Response mempty mempty Right (Operation Full.Query _ _ _ _) -> executeQuery
Right (Operation Full.Mutation _ _ _ _) -> executeMutation
Right (Operation Full.Subscription _ _ _ _) -> subscribe
getOperation :: [Operation] -> Maybe String -> Either QueryError Operation getOperation :: [Operation] -> Maybe String -> Either QueryError Operation
getOperation [operation] Nothing = Right operation getOperation [operation] Nothing = Right operation
@ -94,3 +106,54 @@ getOperation operations (Just givenOperationName)
givenOperationName == operationName givenOperationName == operationName
findOperationByName _ = False findOperationByName _ = False
getOperation _ _ = Left OperationNameRequired getOperation _ _ = Left OperationNameRequired
executeQuery :: IO Response
executeQuery = pure $ Response mempty mempty
executeMutation :: IO Response
executeMutation = pure $ Response mempty mempty
subscribe :: IO Response
subscribe = pure $ Response mempty mempty
coerceVariableValues :: Coerce.VariableValue a
=> forall m
. HashMap Full.Name (Schema.Type m)
-> Operation
-> HashMap Full.Name a
-> Either QueryError Type.Subs
coerceVariableValues types operationDefinition' variableValues =
let Operation _ _ variableDefinitions _ _ = operationDefinition'
in maybe (Left CoercionError) Right
$ foldr forEach (Just HashMap.empty) variableDefinitions
where
forEach variableDefinition coercedValues = do
let Full.VariableDefinition variableName variableTypeName defaultValue _ =
variableDefinition
let defaultValue' = constValue . Full.node <$> defaultValue
variableType <- Type.Internal.lookupInputType variableTypeName types
Coerce.matchFieldValues
coerceVariableValue'
variableValues
variableName
variableType
defaultValue'
coercedValues
coerceVariableValue' variableType value'
= Coerce.coerceVariableValue variableType value'
>>= Coerce.coerceInputLiteral variableType
constValue :: Full.ConstValue -> Type.Value
constValue (Full.ConstInt i) = Type.Int i
constValue (Full.ConstFloat f) = Type.Float f
constValue (Full.ConstString x) = Type.String x
constValue (Full.ConstBoolean b) = Type.Boolean b
constValue Full.ConstNull = Type.Null
constValue (Full.ConstEnum e) = Type.Enum e
constValue (Full.ConstList list) = Type.List $ constValue . Full.node <$> list
constValue (Full.ConstObject o) =
Type.Object $ HashMap.fromList $ constObjectField <$> o
where
constObjectField Full.ObjectField{value = value', ..} =
(name, constValue $ Full.node value')