From 44d506d4b57e450480cf9c476bd927a43ad9c25d Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Mon, 20 Jul 2020 21:29:12 +0200
Subject: Draft the Validation API

---
 src/Language/GraphQL/AST/Document.hs |  6 +++---
 src/Language/GraphQL/AST/Encoder.hs  |  3 ++-
 src/Language/GraphQL/AST/Parser.hs   | 37 ++++++++++++++++++++++++++++++++----
 3 files changed, 38 insertions(+), 8 deletions(-)

(limited to 'src/Language/GraphQL/AST')

diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index cd1dbc6..3394bfa 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -69,9 +69,9 @@ type Document = NonEmpty Definition
 
 -- | All kinds of definitions that can occur in a GraphQL document.
 data Definition
-    = ExecutableDefinition ExecutableDefinition
-    | TypeSystemDefinition TypeSystemDefinition
-    | TypeSystemExtension TypeSystemExtension
+    = ExecutableDefinition ExecutableDefinition Location
+    | TypeSystemDefinition TypeSystemDefinition Location
+    | TypeSystemExtension TypeSystemExtension Location
     deriving (Eq, Show)
 
 -- | Top-level definition of a document, either an operation or a fragment.
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index b55566d..a0dac5b 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -50,7 +50,8 @@ document formatter defs
     | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
   where
     encodeDocument = foldr executableDefinition [] defs
-    executableDefinition (ExecutableDefinition x) acc = definition formatter x : acc
+    executableDefinition (ExecutableDefinition x _) acc =
+        definition formatter x : acc
     executableDefinition _ acc = acc
 
 -- | Converts a t'ExecutableDefinition' into a string.
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index ea517da..687d8f5 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 -- | @GraphQL@ document parser.
 module Language.GraphQL.AST.Parser
@@ -19,7 +20,15 @@ import Language.GraphQL.AST.DirectiveLocation
     )
 import Language.GraphQL.AST.Document
 import Language.GraphQL.AST.Lexer
-import Text.Megaparsec (lookAhead, option, try, (<?>))
+import Text.Megaparsec
+    ( SourcePos(..)
+    , getSourcePos
+    , lookAhead
+    , option
+    , try
+    , unPos
+    , (<?>)
+    )
 
 -- | Parser for the GraphQL documents.
 document :: Parser Document
@@ -28,10 +37,30 @@ document = unicodeBOM
     *> lexeme (NonEmpty.some definition)
 
 definition :: Parser Definition
-definition = ExecutableDefinition <$> executableDefinition
-    <|> TypeSystemDefinition <$> typeSystemDefinition
-    <|> TypeSystemExtension <$> typeSystemExtension
+definition = executableDefinition'
+    <|> typeSystemDefinition'
+    <|> typeSystemExtension'
     <?> "Definition"
+  where
+    executableDefinition' = do
+        location <- getLocation
+        definition' <- executableDefinition
+        pure $ ExecutableDefinition definition' location
+    typeSystemDefinition' = do
+        location <- getLocation
+        definition' <- typeSystemDefinition
+        pure $ TypeSystemDefinition definition' location
+    typeSystemExtension' = do
+        location <- getLocation
+        definition' <- typeSystemExtension
+        pure $ TypeSystemExtension definition' location
+
+getLocation :: Parser Location
+getLocation = fromSourcePosition <$> getSourcePos
+  where
+    fromSourcePosition SourcePos{..} =
+        Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
+    wordFromPosition = fromIntegral . unPos
 
 executableDefinition :: Parser ExecutableDefinition
 executableDefinition = DefinitionOperation <$> operationDefinition
-- 
cgit v1.2.3