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.
This commit is contained in:
Ben Sinclair 2021-02-21 02:06:27 +11:00
parent 10e4d64052
commit ca0f0bd32d
3 changed files with 80 additions and 35 deletions

View File

@ -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`:

View File

@ -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

View File

@ -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