From ca0f0bd32d3334dfe7e016f11c9582c6e54e5422 Mon Sep 17 00:00:00 2001 From: Ben Sinclair Date: Sun, 21 Feb 2021 02:06:27 +1100 Subject: [PATCH] Fix some issues with directive definitions I found some issues with directive definitions: - I couldn't use `on FIELD_DEFINITION`, I believe because `FIELD` was parsed first in `executableDirectiveLocation`. I've combined both `executableDirectiveLocation` and `typetypeSystemDirectiveLocation` into one function which can reorder them to ensure every directive location gets a fair chance at parsing. Not actually to do with directives, some literals weren't being parsed correctly. - The GraphQL spec defines list to be `[]` or `[Value]`, but empty literal lists weren't being parsed correctly because of using `some` instead of `many`. - The GraphQL spec defines objects to be `{}` or `{Name: Value}`, but empty literal objects had the same issue. --- CHANGELOG.md | 6 ++- src/Language/GraphQL/AST/Parser.hs | 58 ++++++++++-------------- tests/Language/GraphQL/AST/ParserSpec.hs | 51 +++++++++++++++++++++ 3 files changed, 80 insertions(+), 35 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 246c907..017a14c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,10 @@ and this project adheres to - `Language.GraphQL.Execute.OrderedMap` is a map data structure, that preserves insertion order. +### Fixed +- Parser now accepts empty lists and objects. +- Parser now accepts all directive locations. + ## [0.11.1.0] - 2021-02-07 ### Added - `Validate.Rules`: @@ -109,7 +113,7 @@ and this project adheres to `locations`. - Parsing comments in the front of definitions. - Some missing labels were added to the parsers, some labels were fixed to - refer to the AST nodes being parsed. + refer to the AST nodes being parsed. ### Added - `AST` reexports `AST.Parser`. diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index 46c8fa3..05f7c43 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -14,11 +14,7 @@ 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.DirectiveLocation (DirectiveLocation) import qualified Language.GraphQL.AST.Document as Full import Language.GraphQL.AST.Lexer import Text.Megaparsec @@ -96,34 +92,28 @@ directiveLocations = optional pipe "DirectiveLocations" directiveLocation :: Parser DirectiveLocation -directiveLocation - = Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation - <|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation +directiveLocation = e (Directive.Query <$ symbol "QUERY") + <|> e (Directive.Mutation <$ symbol "MUTATION") + <|> e (Directive.Subscription <$ symbol "SUBSCRIPTION") + <|> t (Directive.FieldDefinition <$ symbol "FIELD_DEFINITION") + <|> e (Directive.Field <$ symbol "FIELD") + <|> e (Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION") + <|> e (Directive.FragmentSpread <$ "FRAGMENT_SPREAD") + <|> e (Directive.InlineFragment <$ "INLINE_FRAGMENT") + <|> t (Directive.Schema <$ symbol "SCHEMA") + <|> t (Directive.Scalar <$ symbol "SCALAR") + <|> t (Directive.Object <$ symbol "OBJECT") + <|> t (Directive.ArgumentDefinition <$ symbol "ARGUMENT_DEFINITION") + <|> t (Directive.Interface <$ symbol "INTERFACE") + <|> t (Directive.Union <$ symbol "UNION") + <|> t (Directive.EnumValue <$ symbol "ENUM_VALUE") + <|> t (Directive.Enum <$ symbol "ENUM") + <|> t (Directive.InputObject <$ symbol "INPUT_OBJECT") + <|> t (Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION") "DirectiveLocation" - -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" - "ExecutableDirectiveLocation" - -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" - "TypeSystemDirectiveLocation" + where + e = fmap Directive.ExecutableDirectiveLocation + t = fmap Directive.TypeSystemDirectiveLocation typeDefinition :: Full.Description -> Parser Full.TypeDefinition typeDefinition description' = scalarTypeDefinition description' @@ -471,8 +461,8 @@ constValue = Full.ConstFloat <$> try float <|> Full.ConstNull <$ nullValue <|> Full.ConstString <$> stringValue <|> Full.ConstEnum <$> try enumValue - <|> Full.ConstList <$> brackets (some constValue) - <|> Full.ConstObject <$> braces (some $ objectField $ valueNode constValue) + <|> Full.ConstList <$> brackets (many constValue) + <|> Full.ConstObject <$> braces (many $ objectField $ valueNode constValue) "Value" booleanValue :: Parser Bool diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs index 5c4d39e..a47fc11 100644 --- a/tests/Language/GraphQL/AST/ParserSpec.hs +++ b/tests/Language/GraphQL/AST/ParserSpec.hs @@ -6,6 +6,7 @@ module Language.GraphQL.AST.ParserSpec import Data.List.NonEmpty (NonEmpty(..)) import Language.GraphQL.AST.Document +import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc import Language.GraphQL.AST.Parser import Test.Hspec (Spec, describe, it) import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn) @@ -119,6 +120,56 @@ spec = describe "Parser" $ do | FRAGMENT_SPREAD |] + it "parses two minimal directive definitions" $ + let directive nm loc = + TypeSystemDefinition + (DirectiveDefinition + (Description Nothing) + nm + (ArgumentsDefinition []) + (loc :| [])) + example1 = + directive "example1" + (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition) + (Location {line = 2, column = 17}) + example2 = + directive "example2" + (DirLoc.ExecutableDirectiveLocation DirLoc.Field) + (Location {line = 3, column = 17}) + testSchemaExtension = example1 :| [ example2 ] + query = [r| + directive @example1 on FIELD_DEFINITION + directive @example2 on FIELD + |] + in parse document "" query `shouldParse` testSchemaExtension + + it "parses a directive definition with a default empty list argument" $ + let directive nm loc args = + TypeSystemDefinition + (DirectiveDefinition + (Description Nothing) + nm + (ArgumentsDefinition + [ InputValueDefinition + (Description Nothing) + argName + argType + argValue + [] + | (argName, argType, argValue) <- args]) + (loc :| [])) + defn = + directive "test" + (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition) + [("foo", + TypeList (TypeNamed "String"), + Just + $ Node (ConstList []) + $ Location {line = 1, column = 33})] + (Location {line = 1, column = 1}) + query = [r|directive @test(foo: [String] = []) on FIELD_DEFINITION|] + in parse document "" query `shouldParse` (defn :| [ ]) + it "parses schema extension with a new directive" $ parse document "" `shouldSucceedOn`[r| extend schema @newDirective