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.
- Parser for the TypeSystemDefinition.
- `Trans.argument`.
- Schema extension parser.
### Changed
- Rename `AST.Definition` into `AST.Document.ExecutableDefinition`.

View File

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

View File

@ -32,7 +32,6 @@ 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)
@ -222,4 +221,4 @@ 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 ()
extend token = symbol "extend" *> symbol token >> pure ()

View File

@ -30,6 +30,7 @@ document = unicodeBOM
definition :: Parser Definition
definition = ExecutableDefinition <$> executableDefinition
<|> TypeSystemDefinition <$> typeSystemDefinition
<|> TypeSystemExtension <$> typeSystemExtension
<?> "Definition"
executableDefinition :: Parser ExecutableDefinition
@ -43,6 +44,10 @@ typeSystemDefinition = schemaDefinition
<|> directiveDefinition
<?> "TypeSystemDefinition"
typeSystemExtension :: Parser TypeSystemExtension
typeSystemExtension = SchemaExtension <$> schemaExtension
<?> "TypeSystemExtension"
directiveDefinition :: Parser TypeSystemDefinition
directiveDefinition = DirectiveDefinition
<$> description
@ -214,9 +219,20 @@ schemaDefinition = SchemaDefinition
<*> directives
<*> operationTypeDefinitions
<?> "SchemaDefinition"
where
operationTypeDefinitions :: Parser (NonEmpty 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 = OperationTypeDefinition
<$> operationType <* colon

View File

@ -8,7 +8,7 @@ import Data.Text (Text)
import Data.Void (Void)
import Language.GraphQL.AST.Lexer
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.RawString.QQ (r)
@ -89,6 +89,8 @@ spec = describe "Lexer" $ do
parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $
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 = parse (parser $ pure ()) ""

View File

@ -4,9 +4,11 @@ module Language.GraphQL.AST.ParserSpec
( spec
) where
import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST.Document
import Language.GraphQL.AST.Parser
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (shouldSucceedOn)
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
@ -116,3 +118,20 @@ spec = describe "Parser" $ do
| FIELD
| 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 :| [])