diff --git a/CHANGELOG.md b/CHANGELOG.md index 174e6dc..6abc211 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,10 @@ and this project adheres to - `valuesOfCorrectTypeRule` doesn't check objects recursively since the validation traverser calls it on all object properties. - Validation of non-nullable values inside lists. +- `executeField` shouldn't assume that a selection has only one field with a + given name, but it should take the first field. The underlying cause is a + wrong pattern, which (because of the laziness) is executed only if the field + has arguments. ### Changed - `AST.Document.Value.List` and `AST.Document.ConstValue.ConstList` contain diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs index 742a6a9..a217d9c 100644 --- a/src/Language/GraphQL/Execute/Execution.hs +++ b/src/Language/GraphQL/Execute/Execution.hs @@ -97,7 +97,7 @@ executeField fieldResolver prev fields where executeField' fieldDefinition resolver = do let Out.Field _ fieldType argumentDefinitions = fieldDefinition - let (Transform.Field _ _ arguments' _ _ :| []) = fields + let Transform.Field _ _ arguments' _ _ = NonEmpty.head fields case coerceArgumentValues argumentDefinitions arguments' of Nothing -> addError null $ Error "Argument coercing failed." [] [] Just argumentValues -> do diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index 815e315..a31b0a2 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -21,7 +21,9 @@ import Language.GraphQL.Error import Language.GraphQL.Execute (execute) import qualified Language.GraphQL.Type.Schema as Schema import Language.GraphQL.Type +import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out +import Prelude hiding (id) import Test.Hspec (Spec, context, describe, it, shouldBe) import Text.Megaparsec (parse) import Text.RawString.QQ (r) @@ -43,7 +45,9 @@ queryType = Out.ObjectType "Query" Nothing [] $ pure $ Object mempty where philosopherField = - Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty + Out.Field Nothing (Out.NonNullObjectType philosopherType) + $ HashMap.singleton "id" + $ In.Argument Nothing (In.NamedScalarType id) Nothing musicType :: Out.ObjectType (Either SomeException) musicType = Out.ObjectType "Music" Nothing []