fix index position in error path

5 files changed, 100 insertions, 7 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index bfd8aa2..554fadf 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,10 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
+## [1.0.3] - 2021-01-04
+### Fixed
+- Index position in error path. (Index and Segment paths of a field have been swapped)
+
 ## [1.0.2.0] - 2021-12-26
 ### Added
 - `Serialize` instance for `Type.Definition.Value`.
diff --git a/graphql.cabal b/graphql.cabal
index daf020f..c81c01a 100644
--- a/graphql.cabal
+++ b/graphql.cabal
@@ -99,6 +99,7 @@ test-suite graphql-test
     Language.GraphQL.ExecuteSpec
     Language.GraphQL.Type.OutSpec
     Language.GraphQL.Validate.RulesSpec
+    Schemas.HeroSchema
   hs-source-dirs:
     tests
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
@@ -113,5 +114,7 @@ test-suite graphql-test
     hspec-megaparsec ^>= 2.2.0,
     megaparsec,
     text,
-    unordered-containers
+    unordered-containers,
+    containers,
+    vector
   default-language: Haskell2010
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 476cc50..3faee5b 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -375,6 +375,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 +403,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 +445,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 +477,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
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index 5eafb2e..f4e599a 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -4,6 +4,7 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+
 module Language.GraphQL.ExecuteSpec
     ( spec
     ) where
@@ -26,6 +27,9 @@ 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 Schemas.HeroSchema (heroSchema)
+import Data.Maybe (fromJust)
+import qualified Data.Sequence as Seq
 
 data PhilosopherException = PhilosopherException
     deriving Show
@@ -335,6 +339,18 @@ spec =
                         $ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }"
                 in actual `shouldBe` expected
 
+            context "Error path" $ do
+                let executeHero :: Document -> Either SomeException EitherStreamOrValue
+                    executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Value)
+
+                it "at the beggining of the list" $
+                    let Right (Right actual) = either (pure . parseError) executeHero
+                            $ parse document "" "{ hero(id: \"1\") { friends { name } } }"
+                        Response _ errors' = actual
+                        Error _ _ path' = fromJust $ Seq.lookup 0 errors'
+                        expected = [Segment "hero", Segment "friends", Index 0, Segment "name"]
+                    in path' `shouldBe` expected
+
         context "Subscription" $
             it "subscribes" $
                 let data'' = Object
diff --git a/tests/Schemas/HeroSchema.hs b/tests/Schemas/HeroSchema.hs
new file mode 100644
index 0000000..71b7a10
--- /dev/null
+++ b/tests/Schemas/HeroSchema.hs
@@ -0,0 +1,70 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Schemas.HeroSchema (heroSchema) where
+
+import Control.Exception (Exception(..), SomeException)
+import Control.Monad.Catch (throwM)
+import Language.GraphQL.Error (ResolverException (..))
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type as Type
+import Language.GraphQL.Type.Schema (schemaWithTypes)
+import qualified Data.HashMap.Strict as HashMap
+import Data.Typeable (cast)
+import qualified Language.GraphQL.Type.Out as Out
+
+data HeroException = HeroException
+    deriving Show
+
+instance Exception HeroException where
+    toException = toException. ResolverException
+    fromException e = do
+        ResolverException resolverException <- fromException e
+        cast resolverException
+
+heroSchema :: Type.Schema (Either SomeException)
+heroSchema =
+    schemaWithTypes Nothing queryType Nothing Nothing [] mempty
+
+type ObjectType = Out.ObjectType (Either SomeException)
+
+queryType :: ObjectType
+queryType = Out.ObjectType "Query" Nothing []
+    $ HashMap.fromList
+        [ ("hero", Out.ValueResolver heroField heroResolver)
+        ]
+  where
+    heroField = Out.Field Nothing (Out.NamedObjectType heroType)
+        $ HashMap.singleton "id"
+        $ In.Argument Nothing (In.NamedScalarType Type.id) Nothing
+    heroResolver = pure $ Type.Object mempty
+
+stringField :: Out.Field (Either SomeException)
+stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty
+
+heroType :: ObjectType
+heroType = Out.ObjectType "Hero" Nothing [] $ HashMap.fromList resolvers
+  where
+    resolvers =
+        [ ("id", Out.ValueResolver stringField (pure $ Type.String "4111"))
+        , ("name", Out.ValueResolver stringField (pure $ Type.String "R2D2"))
+        , ("friends", Out.ValueResolver friendsField (pure $ Type.List [luke]))
+        ]
+    friendsField = Out.Field Nothing (Out.ListType $ Out.NonNullObjectType lukeType) HashMap.empty
+    -- This list values are ignored because of current realisation (types and resolvers are the same entity)
+    -- The values from lukeType will be used
+    luke = Type.Object $ HashMap.fromList
+        [ ("id", "dfdfdf")
+        , ("name", "dfdfdff")
+        ]
+
+lukeType :: ObjectType
+lukeType = Out.ObjectType "Luke" Nothing [] $ HashMap.fromList resolvers
+  where
+    resolvers =
+        [ ("id", Out.ValueResolver stringField (pure $ Type.String "1000"))
+        , ("name", Out.ValueResolver stringField (throwM HeroException))
+        ]