Move path to the execution error

Since it isn't possible to get a path during validation, without
executing the query.

CHANGELOG.md

@@ -17,6 +17,10 @@ and this project adheres to
   rules. `rules` was a part of the `Validation` context to pass it easier
   around, but since the rules are traversed once now and applied to all nodes in
   the tree at the beginning, it isn't required anymore.
+- `Validate.Validation.Error`: `path` is removed since it isn't possible to get
+  the path without executing the query.
+- `Error.Error`: `path` added. It is currently always empty.
+- `Validate.Validation.Path` was moved to `Error`.
 
 ### Added
 - `Validate.Validation.Rule`: `SelectionRule`, `FieldRule`, `FragmentRule`,

src/Language/GraphQL.hs

@@ -11,6 +11,7 @@ import Control.Monad.Catch (MonadCatch)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 import qualified Data.HashMap.Strict as HashMap
+import Data.Maybe (catMaybes)
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import Language.GraphQL.AST
@@ -55,24 +56,19 @@ graphqlSubs schema operationName variableValues document' =
         [ ("data", data'')
         , ("errors", Aeson.toJSON $ fromError <$> errors')
         ]
-    fromError Error{ locations = [], ..} =
+    fromError Error{..} = Aeson.object $ catMaybes
-        Aeson.object [("message", Aeson.toJSON message)]
+        [ Just ("message", Aeson.toJSON message)
-    fromError Error{..} = Aeson.object
+        , toMaybe fromLocation "locations" locations
+        , toMaybe fromPath "path" path
+        ]
+    fromValidationError Validate.Error{..} = Aeson.object
         [ ("message", Aeson.toJSON message)
         , ("locations", Aeson.listValue fromLocation locations)
         ]
-    fromValidationError Validate.Error{..}
+    toMaybe _ _ [] = Nothing
-        | [] <- path = Aeson.object
+    toMaybe f key xs = Just (key, Aeson.listValue f xs)
-            [ ("message", Aeson.toJSON message)
+    fromPath (Segment segment) = Aeson.String segment
-            , ("locations", Aeson.listValue fromLocation locations)
+    fromPath (Index index) = Aeson.toJSON index
-            ]
-        | otherwise = Aeson.object
-            [ ("message", Aeson.toJSON message)
-            , ("locations", Aeson.listValue fromLocation locations)
-            , ("path", Aeson.listValue fromPath path)
-            ]
-    fromPath (Validate.Segment segment) = Aeson.String segment
-    fromPath (Validate.Index index) = Aeson.toJSON index
     fromLocation Location{..} = Aeson.object
         [ ("line", Aeson.toJSON line)
         , ("column", Aeson.toJSON column)

src/Language/GraphQL/Error.hs

@@ -8,6 +8,7 @@ module Language.GraphQL.Error
     ( parseError
     , CollectErrsT
     , Error(..)
+    , Path(..)
     , Resolution(..)
     , ResolverException(..)
     , Response(..)
@@ -57,6 +58,7 @@ parseError ParseErrorBundle{..}  =
     errorObject s SourcePos{..} = Error
         { message = Text.pack $ init $ parseErrorTextPretty s
         , locations = [Location (unPos' sourceLine) (unPos' sourceColumn)]
+        , path = []
         }
     unPos' = fromIntegral . unPos
     go (result, state) x =
@@ -75,7 +77,7 @@ addErr v = modify appender
     appender resolution@Resolution{..} = resolution{ errors = errors |> v }
 
 makeErrorMessage :: Text -> Error
-makeErrorMessage s = Error s []
+makeErrorMessage s = Error s [] []
 
 -- | Constructs a response object containing only the error with the given
 -- message.
@@ -86,10 +88,20 @@ singleError message = Response null $ Seq.singleton $ makeErrorMessage message
 addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
 addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null
 
+-- | If an error can be associated to a particular field in the GraphQL result,
+-- it must contain an entry with the key path that details the path of the
+-- response field which experienced the error. This allows clients to identify
+-- whether a null result is intentional or caused by a runtime error.
+data Path
+    = Segment Text -- ^ Field name.
+    | Index Int -- ^ List index if a field returned a list.
+    deriving (Eq, Show)
+
 -- | @GraphQL@ error.
 data Error = Error
     { message :: Text
     , locations :: [Location]
+    , path :: [Path]
     } deriving (Eq, Show)
 
 -- | The server\'s response describes the result of executing the requested

src/Language/GraphQL/Execute/Execution.hs

@@ -43,7 +43,7 @@ resolveFieldValue result args resolver =
         => ResolverException
         -> CollectErrsT m Type.Value
     handleFieldError e =
-        addErr (Error (Text.pack $ displayException e) []) >> pure Type.Null
+        addErr (Error (Text.pack $ displayException e) [] []) >> pure Type.Null
     context = Type.Context
         { Type.arguments = Type.Arguments args
         , Type.values = result

src/Language/GraphQL/Validate.hs

@@ -7,7 +7,6 @@
 -- | GraphQL validator.
 module Language.GraphQL.Validate
     ( Error(..)
-    , Path(..)
     , document
     , module Language.GraphQL.Validate.Rules
     ) where

src/Language/GraphQL/Validate/Rules.hs

@@ -70,7 +70,6 @@ executableDefinitionsRule = DefinitionRule $ \case
         { message =
             "Definition must be OperationDefinition or FragmentDefinition."
         , locations = [location]
-        , path = []
         }
 
 -- | Subscription operations must have exactly one root field.
@@ -88,12 +87,10 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
                         , "must select only one top level field."
                         ]
                     , locations = [location]
-                    , path = []
                     }
                 | otherwise -> pure $ Error
                     { message = errorMessage
                     , locations = [location]
-                    , path = []
                     }
     _ -> lift mempty
   where
@@ -173,7 +170,6 @@ loneAnonymousOperationRule = OperationDefinitionRule $ \case
           { message =
               "This anonymous operation must be the only defined operation."
           , locations = [location]
-          , path = []
           }
 
 -- | Each named operation definition must be unique within a document when
@@ -209,7 +205,6 @@ findDuplicates filterByName thisLocation errorMessage = do
     error' locations' = Error 
         { message = errorMessage
         , locations = locations'
-        , path = []
         }
 
 viewOperation :: Definition -> Maybe OperationDefinition
@@ -257,7 +252,6 @@ fragmentSpreadTargetDefinedRule = FragmentSpreadRule $ \case
             Nothing -> pure $ Error
                 { message = error' fragmentName
                 , locations = [location]
-                , path = []
                 }
             Just _ -> lift mempty
   where
@@ -288,7 +282,6 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case
                 Nothing -> pure $ Error
                     { message = spreadError fragmentName typeCondition
                     , locations = [location]
-                    , path = []
                     }
                 Just _ -> lift mempty
     InlineFragmentSelection fragmentSelection
@@ -299,7 +292,6 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case
                 Nothing -> pure $ Error
                     { message = inlineError typeCondition
                     , locations = [location]
-                    , path = []
                     }
                 Just _ -> lift mempty
     _ -> lift mempty
@@ -344,7 +336,6 @@ fragmentsOnCompositeTypesRule = FragmentRule definitionRule inlineRule
             Nothing -> pure $ Error
                 { message = errorMessage typeCondition
                 , locations = [location]
-                , path = []
                 }
             Just _ -> lift mempty
     errorMessage typeCondition = concat
@@ -363,7 +354,6 @@ noUnusedFragmentsRule = FragmentDefinitionRule $ \fragment ->
         | otherwise = pure $ Error
             { message = errorMessage fragName
             , locations = [location]
-            , path = []
             }
     errorMessage fragName = concat
         [ "Fragment \""
@@ -413,7 +403,6 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case
                     , ")."
                     ]
                 , locations = [location]
-                , path = []
                 }
             _ -> lift mempty
   where

src/Language/GraphQL/Validate/Validation.hs

@@ -5,7 +5,6 @@
 -- | Definitions used by the validation rules and the validator itself.
 module Language.GraphQL.Validate.Validation
     ( Error(..)
-    , Path(..)
     , Rule(..)
     , RuleT
     , Validation(..)
@@ -14,25 +13,14 @@ module Language.GraphQL.Validate.Validation
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.HashMap.Strict (HashMap)
 import Data.Sequence (Seq)
-import Data.Text (Text)
 import Language.GraphQL.AST.Document
 import Language.GraphQL.Type.Schema (Schema)
 import qualified Language.GraphQL.Type.Schema as Schema
 
--- | If an error can be associated to a particular field in the GraphQL result,
--- it must contain an entry with the key path that details the path of the
--- response field which experienced the error. This allows clients to identify
--- whether a null result is intentional or caused by a runtime error.
-data Path
-    = Segment Text -- ^ Field name.
-    | Index Int -- ^ List index if a field returned a list.
-    deriving (Eq, Show)
-
 -- | Validation error.
 data Error = Error
     { message :: String
     , locations :: [Location]
-    , path :: [Path]
     } deriving (Eq, Show)
 
 -- | Validation rule context.

tests/Language/GraphQL/ErrorSpec.hs

@@ -19,6 +19,6 @@ import Test.Hspec ( Spec
 spec :: Spec
 spec = describe "singleError" $
     it "constructs an error with the given message" $
-        let errors'' = Seq.singleton $ Error "Message." []
+        let errors'' = Seq.singleton $ Error "Message." [] []
             expected = Response Aeson.Null errors''
          in singleError "Message." `shouldBe` expected

tests/Language/GraphQL/ValidateSpec.hs

@@ -168,7 +168,6 @@ spec =
                     { message =
                         "Definition must be OperationDefinition or FragmentDefinition."
                     , locations = [AST.Location 9 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -186,7 +185,6 @@ spec =
                     { message =
                         "Subscription sub must select only one top level field."
                     , locations = [AST.Location 2 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -208,7 +206,6 @@ spec =
                     { message =
                         "Subscription sub must select only one top level field."
                     , locations = [AST.Location 2 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -232,7 +229,6 @@ spec =
                     { message =
                         "This anonymous operation must be the only defined operation."
                     , locations = [AST.Location 2 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -254,7 +250,6 @@ spec =
                     { message =
                         "There can be only one operation named \"dogOperation\"."
                     , locations = [AST.Location 2 15, AST.Location 8 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -280,7 +275,6 @@ spec =
                     { message =
                         "There can be only one fragment named \"fragmentOne\"."
                     , locations = [AST.Location 8 15, AST.Location 12 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -296,7 +290,6 @@ spec =
                     { message =
                         "Fragment target \"undefinedFragment\" is undefined."
                     , locations = [AST.Location 4 19]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -316,7 +309,6 @@ spec =
                         "Fragment \"notOnExistingType\" is specified on type \
                         \\"NotInSchema\" which doesn't exist in the schema."
                     , locations = [AST.Location 4 19]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -333,7 +325,6 @@ spec =
                         "Inline fragment is specified on type \"NotInSchema\" \
                         \which doesn't exist in the schema."
                     , locations = [AST.Location 3 17]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -353,7 +344,6 @@ spec =
                         "Fragment cannot condition on non composite type \
                         \\"Int\"."
                     , locations = [AST.Location 7 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -370,7 +360,6 @@ spec =
                         "Fragment cannot condition on non composite type \
                         \\"Boolean\"."
                     , locations = [AST.Location 3 17]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -390,7 +379,6 @@ spec =
                     { message =
                         "Fragment \"nameFragment\" is never used."
                     , locations = [AST.Location 2 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.singleton expected
 
@@ -416,7 +404,6 @@ spec =
                         \itself (via barkVolumeFragment -> nameFragment -> \
                         \barkVolumeFragment)."
                     , locations = [AST.Location 11 15]
-                    , path = []
                     }
                 error2 = Error
                     { message =
@@ -424,6 +411,5 @@ spec =
                         \(via nameFragment -> barkVolumeFragment -> \
                         \nameFragment)."
                     , locations = [AST.Location 7 15]
-                    , path = []
                     }
              in validate queryString `shouldBe` Seq.fromList [error1, error2]