summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Language/GraphQL/AST/Document.hs2
-rw-r--r--src/Language/GraphQL/AST/Lexer.hs16
-rw-r--r--src/Language/GraphQL/AST/Parser.hs51
-rw-r--r--stack.yaml2
-rw-r--r--tests/Language/GraphQL/AST/LexerSpec.hs7
-rw-r--r--tests/Language/GraphQL/AST/ParserSpec.hs7
6 files changed, 48 insertions, 37 deletions
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 9de16c0..8048cf0 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -267,7 +267,7 @@ data OperationTypeDefinition
data SchemaExtension
= SchemaOperationExtension [Directive] (NonEmpty OperationTypeDefinition)
- | SchemaDirectiveExtension (NonEmpty Directive)
+ | SchemaDirectivesExtension (NonEmpty Directive)
deriving (Eq, Show)
-- ** Descriptions
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index e119303..0ba55e3 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -33,9 +33,12 @@ import Control.Applicative (Alternative(..), liftA2)
import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
import Data.Foldable (foldl')
import Data.List (dropWhileEnd)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.List.NonEmpty (NonEmpty(..))
import Data.Proxy (Proxy(..))
import Data.Void (Void)
import Text.Megaparsec ( Parsec
+ , (<?>)
, between
, chunk
, chunkToTokens
@@ -220,5 +223,14 @@ 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" *> symbol token >> pure ()
+extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
+extend token extensionLabel parsers
+ = foldr combine headParser (NonEmpty.tail parsers)
+ <?> extensionLabel
+ where
+ headParser = tryExtension $ NonEmpty.head parsers
+ combine current accumulated = accumulated <|> tryExtension current
+ tryExtension extensionParser = try
+ $ symbol "extend"
+ *> symbol token
+ *> extensionParser \ No newline at end of file
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index 204a3ea..3449903 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -9,7 +9,7 @@ module Language.GraphQL.AST.Parser
import Control.Applicative (Alternative(..), optional)
import Control.Applicative.Combinators (sepBy1)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import qualified Language.GraphQL.AST.DirectiveLocation as Directive
import Language.GraphQL.AST.DirectiveLocation
@@ -118,11 +118,8 @@ scalarTypeDefinition = ScalarTypeDefinition
<?> "ScalarTypeDefinition"
scalarTypeExtension :: Parser TypeExtension
-scalarTypeExtension = ScalarTypeExtension
- <$ extend "scalar"
- <*> name
- <*> NonEmpty.some directive
- <?> "ScalarTypeExtension"
+scalarTypeExtension = extend "scalar" "ScalarTypeExtension"
+ $ (ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
objectTypeDefinition :: Parser TypeDefinition
objectTypeDefinition = ObjectTypeDefinition
@@ -135,11 +132,11 @@ objectTypeDefinition = ObjectTypeDefinition
<?> "ObjectTypeDefinition"
objectTypeExtension :: Parser TypeExtension
-objectTypeExtension = extend "type"
- >> try fieldsDefinitionExtension
- <|> try directivesExtension
- <|> implementsInterfacesExtension
- <?> "ObjectTypeExtension"
+objectTypeExtension = extend "type" "ObjectTypeExtension"
+ $ fieldsDefinitionExtension :|
+ [ directivesExtension
+ , implementsInterfacesExtension
+ ]
where
fieldsDefinitionExtension = ObjectTypeFieldsDefinitionExtension
<$> name
@@ -169,10 +166,8 @@ unionTypeDefinition = UnionTypeDefinition
<?> "UnionTypeDefinition"
unionTypeExtension :: Parser TypeExtension
-unionTypeExtension = extend "union"
- >> try unionMemberTypesExtension
- <|> directivesExtension
- <?> "UnionTypeExtension"
+unionTypeExtension = extend "union" "UnionTypeExtension"
+ $ unionMemberTypesExtension :| [directivesExtension]
where
unionMemberTypesExtension = UnionTypeUnionMemberTypesExtension
<$> name
@@ -202,10 +197,8 @@ interfaceTypeDefinition = InterfaceTypeDefinition
<?> "InterfaceTypeDefinition"
interfaceTypeExtension :: Parser TypeExtension
-interfaceTypeExtension = extend "interface"
- >> try fieldsDefinitionExtension
- <|> directivesExtension
- <?> "InterfaceTypeExtension"
+interfaceTypeExtension = extend "interface" "InterfaceTypeExtension"
+ $ fieldsDefinitionExtension :| [directivesExtension]
where
fieldsDefinitionExtension = InterfaceTypeFieldsDefinitionExtension
<$> name
@@ -225,10 +218,8 @@ enumTypeDefinition = EnumTypeDefinition
<?> "EnumTypeDefinition"
enumTypeExtension :: Parser TypeExtension
-enumTypeExtension = extend "enum"
- >> try enumValuesDefinitionExtension
- <|> directivesExtension
- <?> "EnumTypeExtension"
+enumTypeExtension = extend "enum" "EnumTypeExtension"
+ $ enumValuesDefinitionExtension :| [directivesExtension]
where
enumValuesDefinitionExtension = EnumTypeEnumValuesDefinitionExtension
<$> name
@@ -248,10 +239,8 @@ inputObjectTypeDefinition = InputObjectTypeDefinition
<?> "InputObjectTypeDefinition"
inputObjectTypeExtension :: Parser TypeExtension
-inputObjectTypeExtension = extend "input"
- >> try inputFieldsDefinitionExtension
- <|> directivesExtension
- <?> "InputObjectTypeExtension"
+inputObjectTypeExtension = extend "input" "InputObjectTypeExtension"
+ $ inputFieldsDefinitionExtension :| [directivesExtension]
where
inputFieldsDefinitionExtension = InputObjectTypeInputFieldsDefinitionExtension
<$> name
@@ -314,11 +303,11 @@ operationTypeDefinitions :: Parser (NonEmpty OperationTypeDefinition)
operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
schemaExtension :: Parser SchemaExtension
-schemaExtension = extend "schema"
- >> try schemaOperationExtension
- <|> SchemaDirectiveExtension <$> NonEmpty.some directive
- <?> "SchemaExtension"
+schemaExtension = extend "schema" "SchemaExtension"
+ $ schemaOperationExtension :| [directivesExtension]
where
+ directivesExtension = SchemaDirectivesExtension
+ <$> NonEmpty.some directive
schemaOperationExtension = SchemaOperationExtension
<$> directives
<*> operationTypeDefinitions
diff --git a/stack.yaml b/stack.yaml
index 1d1e93e..3faeb3c 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-14.21
+resolver: lts-14.22
packages:
- .
diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs
index 4938b0f..0b4cb31 100644
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@@ -88,9 +88,12 @@ spec = describe "Lexer" $ do
it "lexes ampersand" $
parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $
- parse (extend "schema") "" `shouldSucceedOn` "extend schema"
+ parseExtend "schema" `shouldSucceedOn` "extend schema"
it "fails if the given token doesn't match" $
- parse (extend "schema") "" `shouldFailOn` "extend shema"
+ parseExtend "schema" `shouldFailOn` "extend shema"
+
+parseExtend :: Text -> (Text -> Either (ParseErrorBundle Text Void) ())
+parseExtend extension = parse (extend extension "" $ pure $ pure ()) ""
runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
runBetween parser = parse (parser $ pure ()) ""
diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs
index f06f6c1..4fae5b1 100644
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@@ -135,3 +135,10 @@ spec = describe "Parser" $ do
$ OperationTypeDefinition Query "Query" :| []
query = [r|extend schema @newDirective { query: Query }|]
in parse document "" query `shouldParse` (testSchemaExtension :| [])
+
+ it "parses an object extension" $
+ parse document "" `shouldSucceedOn` [r|
+ extend type Story {
+ isHiddenLocally: Boolean
+ }
+ |] \ No newline at end of file
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 22:16:12 +0000