From e8b82122c646ba159146c986cc8983d66f790142 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Tue, 28 Jan 2020 11:08:28 +0100 Subject: Try all extension parsers --- src/Language/GraphQL/AST/Document.hs | 2 +- src/Language/GraphQL/AST/Lexer.hs | 16 +++++++++-- src/Language/GraphQL/AST/Parser.hs | 51 ++++++++++++++---------------------- 3 files changed, 35 insertions(+), 34 deletions(-) (limited to 'src/Language/GraphQL') 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 -- cgit v1.2.3