Return parser error location in a list

An error can have multiple locations which are returned in a listt with
key "locations".

4 files changed, 30 insertions, 19 deletions

diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs
index adda7a1..845d5cf 100644
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@@ -8,6 +8,7 @@ module Language.GraphQL
     ) where
 
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import Language.GraphQL.AST
@@ -41,13 +42,16 @@ graphqlSubs schema operationName variableValues document' =
         pure $ Aeson.object [("data", data'')]
     formatResponse (Response data'' errors') = pure $ Aeson.object
         [ ("data", data'')
-        , ("errors", Aeson.toJSON $ toJSON <$> errors')
+        , ("errors", Aeson.toJSON $ fromError <$> errors')
         ]
-    toJSON Error{ line = 0, column = 0, ..} =
+    fromError Error{ locations = [], ..} =
         Aeson.object [("message", Aeson.toJSON message)]
-    toJSON Error{..} = Aeson.object
+    fromError Error{..} = Aeson.object
         [ ("message", Aeson.toJSON message)
-        , ("line", Aeson.toJSON line)
+        , ("locations", Aeson.listValue fromLocation locations)
+        ]
+    fromLocation Location{..} = Aeson.object
+        [ ("line", Aeson.toJSON line)
         , ("column", Aeson.toJSON column)
         ]
     executeRequest = execute schema operationName variableValues
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 430e92a..ed473b7 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -19,6 +19,7 @@ module Language.GraphQL.AST.Document
     , FragmentDefinition(..)
     , ImplementsInterfaces(..)
     , InputValueDefinition(..)
+    , Location(..)
     , Name
     , NamedType
     , NonNullType(..)
@@ -55,6 +56,12 @@ import Language.GraphQL.AST.DirectiveLocation
 -- | Name.
 type Name = Text
 
+-- | Error location, line and column.
+data Location = Location
+    { line :: Word
+    , column :: Word
+    } deriving (Eq, Show)
+
 -- ** Document
 
 -- | GraphQL document.
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 7fb0677..a9f91ec 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -254,19 +254,20 @@ stringValue (Pretty indentation) string =
           char == '\t' || isNewline char || (char >= '\x0020' && char /= '\x007F')
 
       tripleQuote = Builder.fromText "\"\"\""
-      start = tripleQuote <> Builder.singleton '\n'
-      end = Builder.fromLazyText (indent indentation) <> tripleQuote
+      newline = Builder.singleton '\n'
 
       strip = Text.dropWhile isWhiteSpace . Text.dropWhileEnd isWhiteSpace
       lines' = map Builder.fromText $ Text.split isNewline (Text.replace "\r\n" "\n" $ strip string)
       encoded [] = oneLine string
       encoded [_] = oneLine string
-      encoded lines'' = start <> transformLines lines'' <> end
-      transformLines = foldr ((\line acc -> line <> Builder.singleton '\n' <> acc) . transformLine) mempty
-      transformLine line =
-        if Lazy.Text.null (Builder.toLazyText line)
-        then line
-        else Builder.fromLazyText (indent (indentation + 1)) <> line
+      encoded lines'' = tripleQuote <> newline
+        <> transformLines lines''
+        <> Builder.fromLazyText (indent indentation) <> tripleQuote
+      transformLines = foldr transformLine mempty
+      transformLine "" acc = newline <> acc
+      transformLine line' acc
+            = Builder.fromLazyText (indent (indentation + 1))
+            <> line' <> newline <> acc
 
 escape :: Char -> Builder
 escape char'
diff --git a/src/Language/GraphQL/Error.hs b/src/Language/GraphQL/Error.hs
index b36be9c..3dbc696 100644
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@@ -22,7 +22,7 @@ import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Void (Void)
-import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.AST (Location(..), Name)
 import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Type.Schema
 import Prelude hiding (null)
@@ -51,9 +51,9 @@ parseError ParseErrorBundle{..}  =
         $ foldl go (Seq.empty, bundlePosState) bundleErrors
   where
     errorObject s SourcePos{..} = Error
-        (Text.pack $ init $ parseErrorTextPretty s)
-        (unPos' sourceLine)
-        (unPos' sourceColumn)
+        { message = Text.pack $ init $ parseErrorTextPretty s
+        , locations = [Location (unPos' sourceLine) (unPos' sourceColumn)]
+        }
     unPos' = fromIntegral . unPos
     go (result, state) x =
         let (_, newState) = reachOffset (errorOffset x) state
@@ -71,7 +71,7 @@ addErr v = modify appender
     appender resolution@Resolution{..} = resolution{ errors = errors |> v }
 
 makeErrorMessage :: Text -> Error
-makeErrorMessage s = Error s 0 0
+makeErrorMessage s = Error s []
 
 -- | Constructs a response object containing only the error with the given
 -- message.
@@ -85,8 +85,7 @@ addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null
 -- | @GraphQL@ error.
 data Error = Error
     { message :: Text
-    , line :: Word
-    , column :: Word
+    , locations :: [Location]
     } deriving (Eq, Show)
 
 -- | The server\'s response describes the result of executing the requested