From ba710a3c968f954d69d3412d91b06debb4fc5a6d Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 15 Jan 2020 20:20:50 +0100 Subject: [PATCH] Parse complete TypeSystemDefinition --- CHANGELOG.md | 2 +- src/Language/GraphQL/AST/Document.hs | 2 +- src/Language/GraphQL/AST/Lexer.hs | 5 +- src/Language/GraphQL/AST/Parser.hs | 81 +++++++++++++++++++----- tests/Language/GraphQL/AST/LexerSpec.hs | 2 +- tests/Language/GraphQL/AST/ParserSpec.hs | 7 ++ 6 files changed, 78 insertions(+), 21 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 21d2ef4..d48c39f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,7 @@ and this project adheres to ## [Unreleased] ### Added - AST for the GraphQL schema. -- Parser for the SchemaDefinition and TypeDefinition. +- Parser for the TypeSystemDefinition. - `Trans.argument`. ### Changed diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 9b156b2..9348a45 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -248,7 +248,7 @@ data TypeSystemDefinition = SchemaDefinition [Directive] OperationTypeDefinitions | TypeDefinition TypeDefinition | DirectiveDefinition - Description Name ArgumentsDefinition DirectiveLocation + Description Name ArgumentsDefinition (NonEmpty DirectiveLocation) deriving (Eq, Show) -- ** Type System Extensions diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs index 1cb3363..c2ed35c 100644 --- a/src/Language/GraphQL/AST/Lexer.hs +++ b/src/Language/GraphQL/AST/Lexer.hs @@ -51,6 +51,7 @@ import Text.Megaparsec ( Parsec ) import Text.Megaparsec.Char (char, digitChar, space1) import qualified Text.Megaparsec.Char.Lexer as Lexer +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -87,8 +88,8 @@ dollar :: Parser T.Text dollar = symbol "$" -- | Parser for "@". -at :: Parser Char -at = char '@' +at :: Parser Text +at = symbol "@" -- | Parser for "&". amp :: Parser T.Text diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index bb8a273..b969b35 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -9,7 +9,14 @@ 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.Text (Text) +import qualified Language.GraphQL.AST.DirectiveLocation as Directive +import Language.GraphQL.AST.DirectiveLocation + ( DirectiveLocation + , ExecutableDirectiveLocation + , TypeSystemDirectiveLocation + ) import Language.GraphQL.AST.Document import Language.GraphQL.AST.Lexer import Text.Megaparsec (lookAhead, option, try, ()) @@ -33,8 +40,50 @@ executableDefinition = DefinitionOperation <$> operationDefinition typeSystemDefinition :: Parser TypeSystemDefinition typeSystemDefinition = schemaDefinition <|> TypeDefinition <$> typeDefinition + <|> directiveDefinition "TypeSystemDefinition" +directiveDefinition :: Parser TypeSystemDefinition +directiveDefinition = DirectiveDefinition + <$> description + <* symbol "directive" + <* at + <*> name + <*> argumentsDefinition + <* symbol "on" + <*> directiveLocations + +directiveLocations :: Parser (NonEmpty DirectiveLocation) +directiveLocations = optional pipe + *> directiveLocation `NonEmpty.sepBy1` pipe + +directiveLocation :: Parser DirectiveLocation +directiveLocation + = Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation + <|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation + +executableDirectiveLocation :: Parser ExecutableDirectiveLocation +executableDirectiveLocation = Directive.Query <$ symbol "QUERY" + <|> Directive.Mutation <$ symbol "MUTATION" + <|> Directive.Subscription <$ symbol "SUBSCRIPTION" + <|> Directive.Field <$ symbol "FIELD" + <|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION" + <|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD" + <|> Directive.InlineFragment <$ "INLINE_FRAGMENT" + +typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation +typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA" + <|> Directive.Scalar <$ symbol "SCALAR" + <|> Directive.Object <$ symbol "OBJECT" + <|> Directive.FieldDefinition <$ symbol "FIELD_DEFINITION" + <|> Directive.ArgumentDefinition <$ symbol "ARGUMENT_DEFINITION" + <|> Directive.Interface <$ symbol "INTERFACE" + <|> Directive.Union <$ symbol "UNION" + <|> Directive.Enum <$ symbol "ENUM" + <|> Directive.EnumValue <$ symbol "ENUM_VALUE" + <|> Directive.InputObject <$ symbol "INPUT_OBJECT" + <|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION" + typeDefinition :: Parser TypeDefinition typeDefinition = scalarTypeDefinition <|> objectTypeDefinition @@ -49,7 +98,7 @@ scalarTypeDefinition = ScalarTypeDefinition <$> description <* symbol "scalar" <*> name - <*> opt directives + <*> directives "ScalarTypeDefinition" objectTypeDefinition :: Parser TypeDefinition @@ -58,7 +107,7 @@ objectTypeDefinition = ObjectTypeDefinition <* symbol "type" <*> name <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1) - <*> opt directives + <*> directives <*> braces (many fieldDefinition) "ObjectTypeDefinition" @@ -72,7 +121,7 @@ unionTypeDefinition = UnionTypeDefinition <$> description <* symbol "union" <*> name - <*> opt directives + <*> directives <*> option (UnionMemberTypes []) (unionMemberTypes sepBy1) "UnionTypeDefinition" @@ -91,7 +140,7 @@ interfaceTypeDefinition = InterfaceTypeDefinition <$> description <* symbol "interface" <*> name - <*> opt directives + <*> directives <*> braces (many fieldDefinition) "InterfaceTypeDefinition" @@ -100,28 +149,28 @@ enumTypeDefinition = EnumTypeDefinition <$> description <* symbol "enum" <*> name - <*> opt directives - <*> opt enumValuesDefinition + <*> directives + <*> enumValuesDefinition "EnumTypeDefinition" where - enumValuesDefinition = braces (some enumValueDefinition) + enumValuesDefinition = listOptIn braces enumValueDefinition inputObjectTypeDefinition :: Parser TypeDefinition inputObjectTypeDefinition = InputObjectTypeDefinition <$> description <* symbol "input" <*> name - <*> opt directives - <*> opt inputFieldsDefinition + <*> directives + <*> inputFieldsDefinition "InputObjectTypeDefinition" where - inputFieldsDefinition = braces (some inputValueDefinition) + inputFieldsDefinition = listOptIn braces inputValueDefinition enumValueDefinition :: Parser EnumValueDefinition enumValueDefinition = EnumValueDefinition <$> description <*> enumValue - <*> opt directives + <*> directives "EnumValueDefinition" implementsInterfaces :: @@ -141,28 +190,28 @@ inputValueDefinition = InputValueDefinition <* colon <*> type' <*> defaultValue - <*> opt directives + <*> directives "InputValueDefinition" argumentsDefinition :: Parser ArgumentsDefinition argumentsDefinition = ArgumentsDefinition - <$> parens (many inputValueDefinition) + <$> listOptIn parens inputValueDefinition "ArgumentsDefinition" fieldDefinition :: Parser FieldDefinition fieldDefinition = FieldDefinition <$> description <*> name - <*> opt argumentsDefinition + <*> argumentsDefinition <* colon <*> type' - <*> opt directives + <*> directives "FieldDefinition" schemaDefinition :: Parser TypeSystemDefinition schemaDefinition = SchemaDefinition <$ symbol "schema" - <*> opt directives + <*> directives <*> operationTypeDefinitions "SchemaDefinition" where diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs index a0acb9f..402ed02 100644 --- a/tests/Language/GraphQL/AST/LexerSpec.hs +++ b/tests/Language/GraphQL/AST/LexerSpec.hs @@ -77,7 +77,7 @@ spec = describe "Lexer" $ do parse spread "" "..." `shouldParse` "..." parse colon "" ":" `shouldParse` ":" parse equals "" "=" `shouldParse` "=" - parse at "" "@" `shouldParse` '@' + parse at "" "@" `shouldParse` "@" runBetween brackets `shouldSucceedOn` "[]" runBetween braces `shouldSucceedOn` "{}" parse pipe "" "|" `shouldParse` "|" diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs index e561863..2e55389 100644 --- a/tests/Language/GraphQL/AST/ParserSpec.hs +++ b/tests/Language/GraphQL/AST/ParserSpec.hs @@ -109,3 +109,10 @@ spec = describe "Parser" $ do y: Float } |] + + it "parses minimal input enum definition with an optional pipe" $ + parse document "" `shouldSucceedOn` [r| + directive @example on + | FIELD + | FRAGMENT_SPREAD + |]