From a6bd2370b6ba6f9eba6f0911ce9f8e8042a7f26b Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 26 Jan 2020 11:55:15 +0100 Subject: [PATCH] Parse type extensions Signed-off-by: Eugen Wissner --- CHANGELOG.md | 2 +- src/Language/GraphQL/AST/Document.hs | 2 +- src/Language/GraphQL/AST/Parser.hs | 98 ++++++++++++++++++++++++++-- 3 files changed, 96 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7d5e230..87c6423 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 TypeSystemDefinition. +- Type system definition parser. - `Trans.argument`. - Schema extension parser. diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 6ed5f50..9de16c0 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -305,7 +305,7 @@ data TypeExtension | InterfaceTypeDirectivesExtension Name (NonEmpty Directive) | UnionTypeUnionMemberTypesExtension Name [Directive] (UnionMemberTypes NonEmpty) - | UnionDirectivesExtension Name (NonEmpty Directive) + | UnionTypeDirectivesExtension Name (NonEmpty Directive) | EnumTypeEnumValuesDefinitionExtension Name [Directive] (NonEmpty EnumValueDefinition) | EnumTypeDirectivesExtension Name (NonEmpty Directive) diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index a750651..204a3ea 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -46,6 +46,7 @@ typeSystemDefinition = schemaDefinition typeSystemExtension :: Parser TypeSystemExtension typeSystemExtension = SchemaExtension <$> schemaExtension + <|> TypeExtension <$> typeExtension "TypeSystemExtension" directiveDefinition :: Parser TypeSystemDefinition @@ -57,6 +58,7 @@ directiveDefinition = DirectiveDefinition <*> argumentsDefinition <* symbol "on" <*> directiveLocations + "DirectiveDefinition" directiveLocations :: Parser (NonEmpty DirectiveLocation) directiveLocations = optional pipe @@ -98,6 +100,15 @@ typeDefinition = scalarTypeDefinition <|> inputObjectTypeDefinition "TypeDefinition" +typeExtension :: Parser TypeExtension +typeExtension = scalarTypeExtension + <|> objectTypeExtension + <|> interfaceTypeExtension + <|> unionTypeExtension + <|> enumTypeExtension + <|> inputObjectTypeExtension + "TypeExtension" + scalarTypeDefinition :: Parser TypeDefinition scalarTypeDefinition = ScalarTypeDefinition <$> description @@ -106,6 +117,13 @@ scalarTypeDefinition = ScalarTypeDefinition <*> directives "ScalarTypeDefinition" +scalarTypeExtension :: Parser TypeExtension +scalarTypeExtension = ScalarTypeExtension + <$ extend "scalar" + <*> name + <*> NonEmpty.some directive + "ScalarTypeExtension" + objectTypeDefinition :: Parser TypeDefinition objectTypeDefinition = ObjectTypeDefinition <$> description @@ -116,6 +134,26 @@ objectTypeDefinition = ObjectTypeDefinition <*> braces (many fieldDefinition) "ObjectTypeDefinition" +objectTypeExtension :: Parser TypeExtension +objectTypeExtension = extend "type" + >> try fieldsDefinitionExtension + <|> try directivesExtension + <|> implementsInterfacesExtension + "ObjectTypeExtension" + where + fieldsDefinitionExtension = ObjectTypeFieldsDefinitionExtension + <$> name + <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1) + <*> directives + <*> braces (NonEmpty.some fieldDefinition) + directivesExtension = ObjectTypeDirectivesExtension + <$> name + <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1) + <*> NonEmpty.some directive + implementsInterfacesExtension = ObjectTypeImplementsInterfacesExtension + <$> name + <*> implementsInterfaces NonEmpty.sepBy1 + description :: Parser Description description = Description <$> optional (string <|> blockString) @@ -130,6 +168,20 @@ unionTypeDefinition = UnionTypeDefinition <*> option (UnionMemberTypes []) (unionMemberTypes sepBy1) "UnionTypeDefinition" +unionTypeExtension :: Parser TypeExtension +unionTypeExtension = extend "union" + >> try unionMemberTypesExtension + <|> directivesExtension + "UnionTypeExtension" + where + unionMemberTypesExtension = UnionTypeUnionMemberTypesExtension + <$> name + <*> directives + <*> unionMemberTypes NonEmpty.sepBy1 + directivesExtension = UnionTypeDirectivesExtension + <$> name + <*> NonEmpty.some directive + unionMemberTypes :: Foldable t => (Parser Text -> Parser Text -> Parser (t NamedType)) -> @@ -149,16 +201,42 @@ interfaceTypeDefinition = InterfaceTypeDefinition <*> braces (many fieldDefinition) "InterfaceTypeDefinition" +interfaceTypeExtension :: Parser TypeExtension +interfaceTypeExtension = extend "interface" + >> try fieldsDefinitionExtension + <|> directivesExtension + "InterfaceTypeExtension" + where + fieldsDefinitionExtension = InterfaceTypeFieldsDefinitionExtension + <$> name + <*> directives + <*> braces (NonEmpty.some fieldDefinition) + directivesExtension = InterfaceTypeDirectivesExtension + <$> name + <*> NonEmpty.some directive + enumTypeDefinition :: Parser TypeDefinition enumTypeDefinition = EnumTypeDefinition <$> description <* symbol "enum" <*> name <*> directives - <*> enumValuesDefinition + <*> listOptIn braces enumValueDefinition "EnumTypeDefinition" + +enumTypeExtension :: Parser TypeExtension +enumTypeExtension = extend "enum" + >> try enumValuesDefinitionExtension + <|> directivesExtension + "EnumTypeExtension" where - enumValuesDefinition = listOptIn braces enumValueDefinition + enumValuesDefinitionExtension = EnumTypeEnumValuesDefinitionExtension + <$> name + <*> directives + <*> braces (NonEmpty.some enumValueDefinition) + directivesExtension = EnumTypeDirectivesExtension + <$> name + <*> NonEmpty.some directive inputObjectTypeDefinition :: Parser TypeDefinition inputObjectTypeDefinition = InputObjectTypeDefinition @@ -166,10 +244,22 @@ inputObjectTypeDefinition = InputObjectTypeDefinition <* symbol "input" <*> name <*> directives - <*> inputFieldsDefinition + <*> listOptIn braces inputValueDefinition "InputObjectTypeDefinition" + +inputObjectTypeExtension :: Parser TypeExtension +inputObjectTypeExtension = extend "input" + >> try inputFieldsDefinitionExtension + <|> directivesExtension + "InputObjectTypeExtension" where - inputFieldsDefinition = listOptIn braces inputValueDefinition + inputFieldsDefinitionExtension = InputObjectTypeInputFieldsDefinitionExtension + <$> name + <*> directives + <*> braces (NonEmpty.some inputValueDefinition) + directivesExtension = InputObjectTypeDirectivesExtension + <$> name + <*> NonEmpty.some directive enumValueDefinition :: Parser EnumValueDefinition enumValueDefinition = EnumValueDefinition