Provide locations for argument errors

The executor still doesn't give an error per argument, but a single
error per field with locations for all arguments.
If a non-null argument isn't specified, only the error location of the
field is given. If some arguments cannot be coerced, only the locations
of these arguments are given, non-null arguments are ignored. This
should still be improved, so the executor returns all errors at once.
The transformation tree is changed, so that argument map contains
locations of the arguments (but not the locations of the argument values
yet).

3 files changed, 40 insertions, 16 deletions

diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index a217d9c..31cc579 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -19,7 +20,7 @@ import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (fromMaybe)
 import Data.Sequence (Seq(..))
 import qualified Data.Text as Text
-import Language.GraphQL.AST (Name)
+import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.Error
 import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Execute.Internal
@@ -66,7 +67,7 @@ collectFields objectType = foldl forEach OrderedMap.empty
              in groupedFields <> fragmentGroupedFieldSet
         | otherwise = groupedFields
 
-aliasOrName :: forall m. Transform.Field m -> Name
+aliasOrName :: forall m. Transform.Field m -> Full.Name
 aliasOrName (Transform.Field alias name _ _ _) = fromMaybe name alias
 
 resolveAbstractType :: Monad m
@@ -97,10 +98,14 @@ executeField fieldResolver prev fields
   where
     executeField' fieldDefinition resolver = do
         let Out.Field _ fieldType argumentDefinitions = fieldDefinition
-        let Transform.Field _ _ arguments' _ _ = NonEmpty.head fields
+        let Transform.Field _ _ arguments' _ location' = NonEmpty.head fields
         case coerceArgumentValues argumentDefinitions arguments' of
-            Nothing -> addError null $ Error "Argument coercing failed." [] []
-            Just argumentValues -> do
+            Left [] ->
+                let errorMessage = "Not all required arguments are specified."
+                 in addError null $ Error errorMessage [location'] []
+            Left errorLocations -> addError null
+                $ Error "Argument coercing failed." errorLocations []
+            Right argumentValues -> do
                 answer <- resolveFieldValue prev argumentValues resolver
                 completeValue fieldType fields answer
 
@@ -189,14 +194,28 @@ executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selection
         executeField resolver result fields >>= lift . pure
 
 coerceArgumentValues
-    :: HashMap Name In.Argument
-    -> HashMap Name Transform.Input
-    -> Maybe Type.Subs
-coerceArgumentValues argumentDefinitions argumentValues =
+    :: HashMap Full.Name In.Argument
+    -> HashMap Full.Name (Full.Node Transform.Input)
+    -> Either [Full.Location] Type.Subs
+coerceArgumentValues argumentDefinitions argumentNodes =
     HashMap.foldrWithKey forEach (pure mempty) argumentDefinitions
   where
-    forEach variableName (In.Argument _ variableType defaultValue) =
-        matchFieldValues coerceArgumentValue argumentValues variableName variableType defaultValue
+    forEach argumentName (In.Argument _ variableType defaultValue) = \case
+        Right resultMap
+            | Just matchedValues
+                <- matchFieldValues' argumentName variableType defaultValue $ Just resultMap
+                -> Right matchedValues
+            | otherwise -> Left $ generateError argumentName []
+        Left errorLocations
+            | Just _
+                <- matchFieldValues' argumentName variableType defaultValue $ pure mempty
+                -> Left errorLocations
+            | otherwise -> Left $ generateError argumentName errorLocations
+    generateError argumentName errorLocations =
+        case HashMap.lookup argumentName argumentNodes of
+            Just (Full.Node _ errorLocation) -> [errorLocation]
+            Nothing -> errorLocations
+    matchFieldValues' = matchFieldValues coerceArgumentValue (Full.node <$> argumentNodes)
     coerceArgumentValue inputType (Transform.Int integer) =
         coerceInputLiteral inputType (Type.Int integer)
     coerceArgumentValue inputType (Transform.Boolean boolean) =
diff --git a/src/Language/GraphQL/Execute/Subscribe.hs b/src/Language/GraphQL/Execute/Subscribe.hs
index 648e741..fada378 100644
--- a/src/Language/GraphQL/Execute/Subscribe.hs
+++ b/src/Language/GraphQL/Execute/Subscribe.hs
@@ -57,8 +57,8 @@ createSourceEventStream _types subscriptionType@(Out.ObjectType _ _ _ fieldTypes
     , Out.EventStreamResolver fieldDefinition _ resolver <- resolverT
     , Out.Field _ _fieldType argumentDefinitions <- fieldDefinition =
         case coerceArgumentValues argumentDefinitions arguments' of
-            Nothing -> pure $ Left "Argument coercion failed."
-            Just argumentValues ->
+            Left _ -> pure $ Left "Argument coercion failed."
+            Right  argumentValues ->
                 resolveFieldEventStream Type.Null argumentValues resolver
     | otherwise = pure $ Left "Subscription contains more than one field."
   where
diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs
index 5e2054b..5f3b771 100644
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@@ -83,7 +83,7 @@ data Operation m
 data Field m = Field
     (Maybe Full.Name)
     Full.Name
-    (HashMap Full.Name Input)
+    (HashMap Full.Name (Full.Node Input))
     (Seq (Selection m))
     Full.Location
 
@@ -278,8 +278,13 @@ field (Full.Field alias name arguments' directives' selections location) = do
     let field' = Field alias name fieldArguments fieldSelections location
     pure $ field' <$ fieldDirectives
   where
-    go arguments (Full.Argument name' (Full.Node value' _) _) =
-        inputField arguments name' value'
+    go arguments (Full.Argument name' (Full.Node value' _) location') = do
+        objectFieldValue <-  input value'
+        case objectFieldValue of
+            Just fieldValue ->
+                let argumentNode = Full.Node fieldValue location'
+                 in pure $ HashMap.insert name' argumentNode arguments
+            Nothing -> pure arguments
 
 fragmentSpread
     :: Full.FragmentSpread