Parse schema extensions

This commit is contained in:
Eugen Wissner 2020-01-25 16:37:17 +01:00
parent cb5270b197
commit b4a3c98114
6 changed files with 44 additions and 10 deletions

View File

@ -11,6 +11,7 @@ and this project adheres to
- AST for the GraphQL schema. - AST for the GraphQL schema.
- Parser for the TypeSystemDefinition. - Parser for the TypeSystemDefinition.
- `Trans.argument`. - `Trans.argument`.
- Schema extension parser.
### Changed ### Changed
- Rename `AST.Definition` into `AST.Document.ExecutableDefinition`. - Rename `AST.Definition` into `AST.Document.ExecutableDefinition`.

View File

@ -25,7 +25,6 @@ module Language.GraphQL.AST.Document
, OperationDefinition(..) , OperationDefinition(..)
, OperationType(..) , OperationType(..)
, OperationTypeDefinition(..) , OperationTypeDefinition(..)
, OperationTypeDefinitions
, SchemaExtension(..) , SchemaExtension(..)
, Selection(..) , Selection(..)
, SelectionSet , SelectionSet
@ -247,7 +246,7 @@ data Directive = Directive Name [Argument] deriving (Eq, Show)
-- * Type System -- * Type System
data TypeSystemDefinition data TypeSystemDefinition
= SchemaDefinition [Directive] OperationTypeDefinitions = SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
| TypeDefinition TypeDefinition | TypeDefinition TypeDefinition
| DirectiveDefinition | DirectiveDefinition
Description Name ArgumentsDefinition (NonEmpty DirectiveLocation) Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
@ -262,14 +261,12 @@ data TypeSystemExtension
-- ** Schema -- ** Schema
type OperationTypeDefinitions = NonEmpty OperationTypeDefinition
data OperationTypeDefinition data OperationTypeDefinition
= OperationTypeDefinition OperationType NamedType = OperationTypeDefinition OperationType NamedType
deriving (Eq, Show) deriving (Eq, Show)
data SchemaExtension data SchemaExtension
= SchemaOperationExtension [Directive] OperationTypeDefinitions = SchemaOperationExtension [Directive] (NonEmpty OperationTypeDefinition)
| SchemaDirectiveExtension (NonEmpty Directive) | SchemaDirectiveExtension (NonEmpty Directive)
deriving (Eq, Show) deriving (Eq, Show)

View File

@ -32,7 +32,6 @@ module Language.GraphQL.AST.Lexer
import Control.Applicative (Alternative(..), liftA2) import Control.Applicative (Alternative(..), liftA2)
import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord) import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
import Data.Foldable (foldl') import Data.Foldable (foldl')
import Data.Functor (($>))
import Data.List (dropWhileEnd) import Data.List (dropWhileEnd)
import Data.Proxy (Proxy(..)) import Data.Proxy (Proxy(..))
import Data.Void (Void) import Data.Void (Void)
@ -222,4 +221,4 @@ unicodeBOM = optional (char '\xfeff') >> pure ()
-- | Parses "extend" followed by a 'symbol'. It is used by schema extensions. -- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
extend :: Text -> Parser () extend :: Text -> Parser ()
extend token = symbol "extend" $> extend token >> pure () extend token = symbol "extend" *> symbol token >> pure ()

View File

@ -30,6 +30,7 @@ document = unicodeBOM
definition :: Parser Definition definition :: Parser Definition
definition = ExecutableDefinition <$> executableDefinition definition = ExecutableDefinition <$> executableDefinition
<|> TypeSystemDefinition <$> typeSystemDefinition <|> TypeSystemDefinition <$> typeSystemDefinition
<|> TypeSystemExtension <$> typeSystemExtension
<?> "Definition" <?> "Definition"
executableDefinition :: Parser ExecutableDefinition executableDefinition :: Parser ExecutableDefinition
@ -43,6 +44,10 @@ typeSystemDefinition = schemaDefinition
<|> directiveDefinition <|> directiveDefinition
<?> "TypeSystemDefinition" <?> "TypeSystemDefinition"
typeSystemExtension :: Parser TypeSystemExtension
typeSystemExtension = SchemaExtension <$> schemaExtension
<?> "TypeSystemExtension"
directiveDefinition :: Parser TypeSystemDefinition directiveDefinition :: Parser TypeSystemDefinition
directiveDefinition = DirectiveDefinition directiveDefinition = DirectiveDefinition
<$> description <$> description
@ -214,9 +219,20 @@ schemaDefinition = SchemaDefinition
<*> directives <*> directives
<*> operationTypeDefinitions <*> operationTypeDefinitions
<?> "SchemaDefinition" <?> "SchemaDefinition"
where
operationTypeDefinitions :: Parser (NonEmpty OperationTypeDefinition)
operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
schemaExtension :: Parser SchemaExtension
schemaExtension = extend "schema"
>> try schemaOperationExtension
<|> SchemaDirectiveExtension <$> NonEmpty.some directive
<?> "SchemaExtension"
where
schemaOperationExtension = SchemaOperationExtension
<$> directives
<*> operationTypeDefinitions
operationTypeDefinition :: Parser OperationTypeDefinition operationTypeDefinition :: Parser OperationTypeDefinition
operationTypeDefinition = OperationTypeDefinition operationTypeDefinition = OperationTypeDefinition
<$> operationType <* colon <$> operationType <* colon

View File

@ -8,7 +8,7 @@ import Data.Text (Text)
import Data.Void (Void) import Data.Void (Void)
import Language.GraphQL.AST.Lexer import Language.GraphQL.AST.Lexer
import Test.Hspec (Spec, context, describe, it) import Test.Hspec (Spec, context, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn) import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
import Text.Megaparsec (ParseErrorBundle, parse) import Text.Megaparsec (ParseErrorBundle, parse)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
@ -89,6 +89,8 @@ spec = describe "Lexer" $ do
parse amp "" "&" `shouldParse` "&" parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $ it "lexes schema extensions" $
parse (extend "schema") "" `shouldSucceedOn` "extend schema" parse (extend "schema") "" `shouldSucceedOn` "extend schema"
it "fails if the given token doesn't match" $
parse (extend "schema") "" `shouldFailOn` "extend shema"
runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) () runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
runBetween parser = parse (parser $ pure ()) "" runBetween parser = parse (parser $ pure ()) ""

View File

@ -4,9 +4,11 @@ module Language.GraphQL.AST.ParserSpec
( spec ( spec
) where ) where
import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST.Document
import Language.GraphQL.AST.Parser import Language.GraphQL.AST.Parser
import Test.Hspec (Spec, describe, it) import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (shouldSucceedOn) import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
import Text.Megaparsec (parse) import Text.Megaparsec (parse)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
@ -116,3 +118,20 @@ spec = describe "Parser" $ do
| FIELD | FIELD
| FRAGMENT_SPREAD | FRAGMENT_SPREAD
|] |]
it "parses schema extension with a new directive" $
parse document "" `shouldSucceedOn`[r|
extend schema @newDirective
|]
it "parses schema extension with an operation type definition" $
parse document "" `shouldSucceedOn` [r|extend schema { query: Query }|]
it "parses schema extension with an operation type and directive" $
let newDirective = Directive "newDirective" []
testSchemaExtension = TypeSystemExtension
$ SchemaExtension
$ SchemaOperationExtension [newDirective]
$ OperationTypeDefinition Query "Query" :| []
query = [r|extend schema @newDirective { query: Query }|]
in parse document "" query `shouldParse` (testSchemaExtension :| [])