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).

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." [] []
+            Left [] ->
-            Just argumentValues -> do
+                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 Full.Name In.Argument
-    -> HashMap Name Transform.Input
+    -> HashMap Full.Name (Full.Node Transform.Input)
-    -> Maybe Type.Subs
+    -> Either [Full.Location] Type.Subs
-coerceArgumentValues argumentDefinitions argumentValues =
+coerceArgumentValues argumentDefinitions argumentNodes =
     HashMap.foldrWithKey forEach (pure mempty) argumentDefinitions
   where
-    forEach variableName (In.Argument _ variableType defaultValue) =
+    forEach argumentName (In.Argument _ variableType defaultValue) = \case
-        matchFieldValues coerceArgumentValue argumentValues variableName variableType defaultValue
+        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) =

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."
+            Left _ -> pure $ Left "Argument coercion failed."
-            Just argumentValues ->
+            Right  argumentValues ->
                 resolveFieldEventStream Type.Null argumentValues resolver
     | otherwise = pure $ Left "Subscription contains more than one field."
   where

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' _) _) =
+    go arguments (Full.Argument name' (Full.Node value' _) location') = do
-        inputField arguments name' value'
+        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

tests/Language/GraphQL/ExecuteSpec.hs

@@ -254,6 +254,20 @@ spec =
                         $ parse document "" "{ philosopher { majorWork { title } } }"
                 in actual `shouldBe` expected
 
+            it "gives location information for invalid scalar arguments" $
+                let data'' = Aeson.object
+                        [ "philosopher" .= Aeson.Null
+                        ]
+                    executionErrors = pure $ Error
+                        { message = "Argument coercing failed."
+                        , locations = [Location 1 15]
+                        , path = []
+                        }
+                    expected = Response data'' executionErrors
+                    Right (Right actual) = either (pure . parseError) execute'
+                        $ parse document "" "{ philosopher(id: true) { lastName } }"
+                in actual `shouldBe` expected
+
         context "Subscription" $
             it "subscribes" $
                 let data'' = Aeson.object