graphql/src/Language/GraphQL/Execute.hs

174 lines
7.0 KiB
Haskell
Raw Normal View History

2017-02-10 22:40:08 +01:00
{-# LANGUAGE OverloadedStrings #-}
2020-05-14 09:17:14 +02:00
{-# LANGUAGE NamedFieldPuns #-}
-- | This module provides functions to execute a @GraphQL@ request.
2019-07-14 05:58:05 +02:00
module Language.GraphQL.Execute
( execute
2019-07-25 07:37:36 +02:00
, executeWithName
2019-07-14 05:58:05 +02:00
) where
2019-07-25 07:37:36 +02:00
import qualified Data.Aeson as Aeson
2020-05-14 09:17:14 +02:00
import Data.Foldable (find)
2020-05-21 10:20:59 +02:00
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
2019-07-25 07:37:36 +02:00
import Data.Text (Text)
import qualified Data.Text as Text
2019-12-26 13:00:47 +01:00
import Language.GraphQL.AST.Document
import qualified Language.GraphQL.AST.Core as AST.Core
2020-05-21 10:20:59 +02:00
import Language.GraphQL.Execute.Coerce
import qualified Language.GraphQL.Execute.Transform as Transform
import Language.GraphQL.Error
import qualified Language.GraphQL.Schema as Schema
2020-05-21 10:20:59 +02:00
import qualified Language.GraphQL.Type.Definition as Definition
2020-05-14 09:17:14 +02:00
import Language.GraphQL.Type.Schema
-- | Query error types.
data QueryError
= OperationNotFound Text
| OperationNameRequired
2020-05-21 10:20:59 +02:00
| CoercionError
2020-05-14 09:17:14 +02:00
queryError :: QueryError -> Text
queryError (OperationNotFound operationName) = Text.unwords
["Operation", operationName, "couldn't be found in the document."]
queryError OperationNameRequired = "Missing operation name."
2020-05-21 10:20:59 +02:00
queryError CoercionError = "Coercion error."
-- | The substitution is applied to the document, and the resolvers are applied
-- to the resulting fields.
--
-- Returns the result of the query against the schema wrapped in a /data/
-- field, or errors wrapped in an /errors/ field.
2020-05-21 10:20:59 +02:00
execute :: (Monad m, VariableValue a)
2020-05-14 09:17:14 +02:00
=> Schema m -- ^ Resolvers.
2020-05-21 10:20:59 +02:00
-> HashMap.HashMap Name a -- ^ Variable substitution function.
2019-12-26 13:00:47 +01:00
-> Document -- @GraphQL@ document.
2019-07-25 07:37:36 +02:00
-> m Aeson.Value
2020-05-21 10:20:59 +02:00
execute schema = document schema Nothing
2019-07-25 07:37:36 +02:00
-- | The substitution is applied to the document, and the resolvers are applied
-- to the resulting fields. The operation name can be used if the document
-- defines multiple root operations.
2019-07-25 07:37:36 +02:00
--
-- Returns the result of the query against the schema wrapped in a /data/
-- field, or errors wrapped in an /errors/ field.
2020-05-21 10:20:59 +02:00
executeWithName :: (Monad m, VariableValue a)
2020-05-14 09:17:14 +02:00
=> Schema m -- ^ Resolvers
-> Text -- ^ Operation name.
2020-05-21 10:20:59 +02:00
-> HashMap.HashMap Name a -- ^ Variable substitution function.
2019-12-26 13:00:47 +01:00
-> Document -- ^ @GraphQL@ Document.
2019-07-25 07:37:36 +02:00
-> m Aeson.Value
2020-05-21 10:20:59 +02:00
executeWithName schema operationName = document schema (Just operationName)
2020-05-14 09:17:14 +02:00
getOperation
:: Maybe Text
2020-05-21 10:20:59 +02:00
-> Transform.Document
-> Either QueryError Transform.OperationDefinition
getOperation Nothing (Transform.Document (operation' :| []) _) = pure operation'
2020-05-14 09:17:14 +02:00
getOperation Nothing _ = Left OperationNameRequired
2020-05-21 10:20:59 +02:00
getOperation (Just operationName) (Transform.Document operations _)
| Just operation' <- find matchingName operations = pure operation'
2020-05-14 09:17:14 +02:00
| otherwise = Left $ OperationNotFound operationName
where
2020-05-21 10:20:59 +02:00
matchingName (Transform.OperationDefinition _ name _ _ _) =
name == Just operationName
lookupInputType
:: Type
-> HashMap.HashMap Name (Definition.TypeDefinition m)
-> Maybe Definition.InputType
lookupInputType (TypeNamed name) types =
case HashMap.lookup name types of
Just (Definition.ScalarTypeDefinition scalarType) ->
Just $ Definition.ScalarInputType scalarType
Just (Definition.EnumTypeDefinition enumType) ->
Just $ Definition.EnumInputType enumType
Just (Definition.InputObjectTypeDefinition objectType) ->
Just $ Definition.ObjectInputType objectType
_ -> Nothing
lookupInputType (TypeList list) types
= Definition.ListInputType
<$> lookupInputType list types
lookupInputType (TypeNonNull (NonNullTypeNamed nonNull)) types =
case HashMap.lookup nonNull types of
Just (Definition.ScalarTypeDefinition scalarType) ->
Just $ Definition.NonNullScalarInputType scalarType
Just (Definition.EnumTypeDefinition enumType) ->
Just $ Definition.NonNullEnumInputType enumType
Just (Definition.InputObjectTypeDefinition objectType) ->
Just $ Definition.NonNullObjectInputType objectType
_ -> Nothing
lookupInputType (TypeNonNull (NonNullTypeList nonNull)) types
= Definition.NonNullListInputType
<$> lookupInputType nonNull types
coerceVariableValues :: (Monad m, VariableValue a)
=> Schema m
-> Transform.OperationDefinition
-> HashMap.HashMap Name a
-> Either QueryError Schema.Subs
coerceVariableValues schema (Transform.OperationDefinition _ _ variables _ _) values =
let referencedTypes = collectReferencedTypes schema
in maybe (Left CoercionError) Right
$ foldr (coerceValue referencedTypes) (Just HashMap.empty) variables
where
coerceValue referencedTypes variableDefinition coercedValues = do
let VariableDefinition variableName variableTypeName _defaultValue =
variableDefinition
variableType <- lookupInputType variableTypeName referencedTypes
value <- HashMap.lookup variableName values
coercedValue <- coerceVariableValue variableType value
HashMap.insert variableName coercedValue <$> coercedValues
2020-05-14 09:17:14 +02:00
2020-05-21 10:20:59 +02:00
executeRequest :: (Monad m, VariableValue a)
2020-05-14 09:17:14 +02:00
=> Schema m
-> Maybe Text
2020-05-21 10:20:59 +02:00
-> HashMap.HashMap Name a
-> Transform.Document
-> Either QueryError (Transform.OperationDefinition, Schema.Subs)
executeRequest schema operationName subs document' = do
operation' <- getOperation operationName document'
coercedValues <- coerceVariableValues schema operation' subs
pure (operation', coercedValues)
document :: (Monad m, VariableValue a)
=> Schema m
-> Maybe Text
-> HashMap.HashMap Name a
-> Document
-> m Aeson.Value
2020-05-21 10:20:59 +02:00
document schema operationName subs document' =
case Transform.document document' of
Just transformed -> executeRequest' transformed
Nothing -> pure $ singleError
"The document doesn't contain any executable operations."
where
transformOperation fragmentTable operation' subs' =
case Transform.operation fragmentTable subs' operation' of
Just operationResult -> operation schema operationResult
Nothing -> pure $ singleError "Schema transformation error."
executeRequest' transformed@(Transform.Document _ fragmentTable) =
case executeRequest schema operationName subs transformed of
Right (operation', subs') -> transformOperation fragmentTable operation' subs'
Left error' -> pure $ singleError $ queryError error'
operation :: Monad m
2020-05-14 09:17:14 +02:00
=> Schema m
-> AST.Core.Operation
-> m Aeson.Value
2020-05-14 09:17:14 +02:00
operation = schemaOperation
where
2020-05-14 09:17:14 +02:00
resolve queryFields = runCollectErrs
. flip Schema.resolve queryFields
2020-05-21 10:20:59 +02:00
. fmap getResolver
. Definition.fields
lookupError = pure
$ singleError "Root operation type couldn't be found in the schema."
2020-05-14 09:17:14 +02:00
schemaOperation Schema {query} (AST.Core.Query _ fields') =
resolve fields' query
schemaOperation Schema {mutation = Just mutation} (AST.Core.Mutation _ fields') =
resolve fields' mutation
schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
lookupError
2020-05-21 10:20:59 +02:00
getResolver (Definition.Field _ _ _ resolver) = resolver