diff options
Diffstat (limited to 'src/Language/GraphQL/Execute.hs')
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 51 |
1 files changed, 31 insertions, 20 deletions
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 476cc50..5ceb616 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -61,6 +61,7 @@ import Language.GraphQL.Error , ResponseEventStream ) import Prelude hiding (null) +import Language.GraphQL.AST.Document (showVariableName) newtype ExecutorT m a = ExecutorT { runExecutorT :: ReaderT (HashMap Full.Name (Type m)) (WriterT (Seq Error) m) a @@ -190,32 +191,42 @@ data QueryError tell :: Monad m => Seq Error -> ExecutorT m () tell = ExecutorT . lift . Writer.tell +operationNameErrorText :: Text +operationNameErrorText = Text.unlines + [ "Named operations must be provided with the name of the desired operation." + , "See https://spec.graphql.org/June2018/#sec-Language.Document description." + ] + queryError :: QueryError -> Error queryError OperationNameRequired = - Error{ message = "Operation name is required.", locations = [], path = [] } + let queryErrorMessage = "Operation name is required. " <> operationNameErrorText + in Error{ message = queryErrorMessage, locations = [], path = [] } queryError (OperationNotFound operationName) = - let queryErrorMessage = Text.concat - [ "Operation \"" - , Text.pack operationName - , "\" not found." + let queryErrorMessage = Text.unlines + [ Text.concat + [ "Operation \"" + , Text.pack operationName + , "\" is not found in the named operations you've provided. " + ] + , operationNameErrorText ] in Error{ message = queryErrorMessage, locations = [], path = [] } queryError (CoercionError variableDefinition) = - let Full.VariableDefinition variableName _ _ location = variableDefinition + let (Full.VariableDefinition _ _ _ location) = variableDefinition queryErrorMessage = Text.concat - [ "Failed to coerce the variable \"" - , variableName - , "\"." + [ "Failed to coerce the variable " + , Text.pack $ Full.showVariable variableDefinition + , "." ] in Error{ message = queryErrorMessage, locations = [location], path = [] } queryError (UnknownInputType variableDefinition) = - let Full.VariableDefinition variableName variableTypeName _ location = variableDefinition + let Full.VariableDefinition _ variableTypeName _ location = variableDefinition queryErrorMessage = Text.concat - [ "Variable \"" - , variableName - , "\" has unknown type \"" + [ "Variable " + , Text.pack $ showVariableName variableDefinition + , " has unknown type " , Text.pack $ show variableTypeName - , "\"." + , "." ] in Error{ message = queryErrorMessage, locations = [location], path = [] } @@ -375,6 +386,7 @@ executeField objectValue fields (viewResolver -> resolverPair) errorPath = , Handler (resolverHandler fieldLocation) ] where + fieldErrorPath = fieldsSegment fields : errorPath inputCoercionHandler :: (MonadCatch m, Serialize a) => Full.Location -> InputCoercionException @@ -402,17 +414,16 @@ executeField objectValue fields (viewResolver -> resolverPair) errorPath = then throwM e else returnError newError exceptionHandler errorLocation e = - let newPath = fieldsSegment fields : errorPath - newError = constructError e errorLocation newPath + let newError = constructError e errorLocation fieldErrorPath in if Out.isNonNullType fieldType - then throwM $ FieldException errorLocation newPath e + then throwM $ FieldException errorLocation fieldErrorPath e else returnError newError returnError newError = tell (Seq.singleton newError) >> pure null go fieldName inputArguments = do argumentValues <- coerceArgumentValues argumentTypes inputArguments resolvedValue <- resolveFieldValue resolveFunction objectValue fieldName argumentValues - completeValue fieldType fields errorPath resolvedValue + completeValue fieldType fields fieldErrorPath resolvedValue (resolverField, resolveFunction) = resolverPair Out.Field _ fieldType argumentTypes = resolverField @@ -445,6 +456,7 @@ resolveAbstractType abstractType values' _ -> pure Nothing | otherwise = pure Nothing +-- https://spec.graphql.org/October2021/#sec-Value-Completion completeValue :: (MonadCatch m, Serialize a) => Out.Type m -> NonEmpty (Transform.Field m) @@ -476,8 +488,7 @@ completeValue outputType@(Out.EnumBaseType enumType) _ _ (Type.Enum enum) = $ ValueCompletionException (show outputType) $ Type.Enum enum completeValue (Out.ObjectBaseType objectType) fields errorPath result - = executeSelectionSet (mergeSelectionSets fields) objectType result - $ fieldsSegment fields : errorPath + = executeSelectionSet (mergeSelectionSets fields) objectType result errorPath completeValue outputType@(Out.InterfaceBaseType interfaceType) fields errorPath result | Type.Object objectMap <- result = do let abstractType = Type.Internal.AbstractInterfaceType interfaceType |