From 3ef27f9d112fcd035a8d351b6e246768355854ae Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Fri, 17 Jan 2020 12:22:29 +0100
Subject: [PATCH] Add "extend symbol" lexer to parse extensions

---
 CHANGELOG.md                            | 2 ++
 src/Language/GraphQL/AST/Document.hs    | 4 +++-
 src/Language/GraphQL/AST/Lexer.hs       | 6 ++++++
 src/Language/GraphQL/AST/Parser.hs      | 2 +-
 tests/Language/GraphQL/AST/LexerSpec.hs | 2 ++
 5 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index d48c39f..22da347 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -20,6 +20,8 @@ and this project adheres to
 - Rename `AST.OperationSelectionSet` to `AST.Document.SelectionSet`.
 - Make `Schema.Subs` a `Data.HashMap.Strict` (was a function
   `key -> Maybe value` before).
+- Make `AST.Lexer.at` a text (symbol) parser. It was a char before and is
+  `symbol "@"` now.
 
 ### Removed
 - `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 9348a45..e3fe78c 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -8,7 +8,7 @@ module Language.GraphQL.AST.Document
     ( Alias
     , Argument(..)
     , ArgumentsDefinition(..)
-    , Definition(ExecutableDefinition, TypeSystemDefinition)
+    , Definition(..)
     , Description(..)
     , Directive(..)
     , Document
@@ -26,6 +26,7 @@ module Language.GraphQL.AST.Document
     , OperationType(..)
     , OperationTypeDefinition(..)
     , OperationTypeDefinitions
+    , SchemaExtension(..)
     , Selection(..)
     , SelectionSet
     , SelectionSetOpt
@@ -34,6 +35,7 @@ module Language.GraphQL.AST.Document
     , TypeDefinition(..)
     , TypeExtension(..)
     , TypeSystemDefinition(..)
+    , TypeSystemExtension(..)
     , UnionMemberTypes(..)
     , Value(..)
     , VariableDefinition(..)
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index c2ed35c..7303fdf 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -15,6 +15,7 @@ module Language.GraphQL.AST.Lexer
     , dollar
     , comment
     , equals
+    , extend
     , integer
     , float
     , lexeme
@@ -31,6 +32,7 @@ module Language.GraphQL.AST.Lexer
 import Control.Applicative (Alternative(..), liftA2)
 import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
 import Data.Foldable (foldl')
+import Data.Functor (($>))
 import Data.List (dropWhileEnd)
 import Data.Proxy (Proxy(..))
 import Data.Void (Void)
@@ -217,3 +219,7 @@ escapeSequence = do
 -- | Parser for the "Byte Order Mark".
 unicodeBOM :: Parser ()
 unicodeBOM = optional (char '\xfeff') >> pure ()
+
+-- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
+extend :: Text -> Parser ()
+extend token = symbol "extend" $> extend token >> pure ()
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index b969b35..33deb15 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -215,7 +215,7 @@ schemaDefinition = SchemaDefinition
     <*> operationTypeDefinitions
     <?> "SchemaDefinition"
   where
-    operationTypeDefinitions  = braces $ NonEmpty.some operationTypeDefinition
+    operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
 
 operationTypeDefinition :: Parser OperationTypeDefinition
 operationTypeDefinition = OperationTypeDefinition
diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs
index 402ed02..9b5d6aa 100644
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@@ -87,6 +87,8 @@ spec = describe "Lexer" $ do
             parse blockString "" [r|""""""|] `shouldParse` ""
         it "lexes ampersand" $
             parse amp "" "&" `shouldParse` "&"
+        it "lexes schema extensions" $
+            parse (extend "schema") "" `shouldSucceedOn` "extend schema"
 
 runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
 runBetween parser = parse (parser $ pure ()) ""