Fix merging fields with arguments

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.

3 files changed, 10 insertions, 2 deletions

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 []