graphql/tests/Language/GraphQL/AST/ParserSpec.hs
Ben Sinclair ca0f0bd32d 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.
2021-02-21 23:35:34 +11:00

223 lines
7.3 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.ParserSpec
( spec
) where
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)
import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
spec :: Spec
spec = describe "Parser" $ do
it "accepts BOM header" $
parse document "" `shouldSucceedOn` "\xfeff{foo}"
it "accepts block strings as argument" $
parse document "" `shouldSucceedOn` [r|{
hello(text: """Argument""")
}|]
it "accepts strings as argument" $
parse document "" `shouldSucceedOn` [r|{
hello(text: "Argument")
}|]
it "accepts two required arguments" $
parse document "" `shouldSucceedOn` [r|
mutation auth($username: String!, $password: String!){
test
}|]
it "accepts two string arguments" $
parse document "" `shouldSucceedOn` [r|
mutation auth{
test(username: "username", password: "password")
}|]
it "accepts two block string arguments" $
parse document "" `shouldSucceedOn` [r|
mutation auth{
test(username: """username""", password: """password""")
}|]
it "parses minimal schema definition" $
parse document "" `shouldSucceedOn` [r|schema { query: Query }|]
it "parses minimal scalar definition" $
parse document "" `shouldSucceedOn` [r|scalar Time|]
it "parses ImplementsInterfaces" $
parse document "" `shouldSucceedOn` [r|
type Person implements NamedEntity & ValuedEntity {
name: String
}
|]
it "parses a type without ImplementsInterfaces" $
parse document "" `shouldSucceedOn` [r|
type Person {
name: String
}
|]
it "parses ArgumentsDefinition in an ObjectDefinition" $
parse document "" `shouldSucceedOn` [r|
type Person {
name(first: String, last: String): String
}
|]
it "parses minimal union type definition" $
parse document "" `shouldSucceedOn` [r|
union SearchResult = Photo | Person
|]
it "parses minimal interface type definition" $
parse document "" `shouldSucceedOn` [r|
interface NamedEntity {
name: String
}
|]
it "parses minimal enum type definition" $
parse document "" `shouldSucceedOn` [r|
enum Direction {
NORTH
EAST
SOUTH
WEST
}
|]
it "parses minimal enum type definition" $
parse document "" `shouldSucceedOn` [r|
enum Direction {
NORTH
EAST
SOUTH
WEST
}
|]
it "parses minimal input object type definition" $
parse document "" `shouldSucceedOn` [r|
input Point2D {
x: Float
y: Float
}
|]
it "parses minimal input enum definition with an optional pipe" $
parse document "" `shouldSucceedOn` [r|
directive @example on
| FIELD
| 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
|]
it "parses schema extension with an operation type definition" $
parse document "" `shouldSucceedOn` [r|extend schema { query: Query }|]
it "parses schema extension with an operation type and directive" $
let newDirective = Directive "newDirective" [] $ Location 1 15
schemaExtension = SchemaExtension
$ SchemaOperationExtension [newDirective]
$ OperationTypeDefinition Query "Query" :| []
testSchemaExtension = TypeSystemExtension schemaExtension
$ Location 1 1
query = [r|extend schema @newDirective { query: Query }|]
in parse document "" query `shouldParse` (testSchemaExtension :| [])
it "parses an object extension" $
parse document "" `shouldSucceedOn` [r|
extend type Story {
isHiddenLocally: Boolean
}
|]
it "rejects variables in DefaultValue" $
parse document "" `shouldFailOn` [r|
query ($book: String = "Zarathustra", $author: String = $book) {
title
}
|]
it "parses documents beginning with a comment" $
parse document "" `shouldSucceedOn` [r|
"""
Query
"""
type Query {
queryField: String
}
|]
it "parses subscriptions" $
parse document "" `shouldSucceedOn` [r|
subscription NewMessages {
newMessage(roomId: 123) {
sender
}
}
|]