Validate directives are unique per location

4 files changed, 10 insertions, 9 deletions

diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 7d0bcd0..5d21ca0 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -280,7 +280,7 @@ data NonNullType
 --
 -- Directives begin with "@", can accept arguments, and can be applied to the
 -- most GraphQL elements, providing additional information.
-data Directive = Directive Name [Argument] deriving (Eq, Show)
+data Directive = Directive Name [Argument] Location deriving (Eq, Show)
 
 -- * Type System
 
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 342a45f..fcd415e 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -191,7 +191,7 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels _)
 
 -- | Converts a 'Directive' into a string.
 directive :: Formatter -> Directive -> Lazy.Text
-directive formatter (Directive name args)
+directive formatter (Directive name args _)
     = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
 
 directives :: Formatter -> [Directive] -> Lazy.Text
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index cd2bd89..ecefaf6 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -92,8 +92,8 @@ dollar :: Parser T.Text
 dollar = symbol "$"
 
 -- | Parser for "@".
-at :: Parser Text
-at = symbol "@"
+at :: Parser ()
+at = symbol "@" >> pure ()
 
 -- | Parser for "&".
 amp :: Parser T.Text
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index f6d1539..62a247d 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -520,11 +520,12 @@ directives :: Parser [Directive]
 directives = many directive <?> "Directives"
 
 directive :: Parser Directive
-directive = Directive
-    <$  at
-    <*> name
-    <*> arguments
-    <?> "Directive"
+directive = label "Directive" $ do
+    location <- getLocation
+    at
+    directiveName <- name
+    directiveArguments <- arguments
+    pure $ Directive directiveName directiveArguments location
 
 listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
 listOptIn surround = option [] . surround . some