graphql/tests/Language/GraphQL/AST/ParserSpec.hs

252 lines
8.5 KiB
Haskell
Raw Normal View History

2019-07-22 05:50:00 +02:00
{-# LANGUAGE OverloadedStrings #-}
2019-09-06 07:48:01 +02:00
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.ParserSpec
2019-07-22 05:50:00 +02:00
( spec
) where
2020-01-25 16:37:17 +01:00
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import qualified Data.Text as Text
2020-01-25 16:37:17 +01:00
import Language.GraphQL.AST.Document
import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
import Language.GraphQL.AST.Parser
2021-09-23 08:23:38 +02:00
import Language.GraphQL.TH
2022-01-06 14:49:54 +01:00
import Test.Hspec (Spec, describe, it, context)
2020-05-22 10:11:48 +02:00
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
2019-07-22 05:50:00 +02:00
import Text.Megaparsec (parse)
import Test.QuickCheck (property, NonEmptyList (..), mapSize)
import Language.GraphQL.AST.Arbitrary
2019-07-22 05:50:00 +02:00
spec :: Spec
2019-09-06 07:48:01 +02:00
spec = describe "Parser" $ do
2019-07-22 05:50:00 +02:00
it "accepts BOM header" $
2019-09-27 10:50:38 +02:00
parse document "" `shouldSucceedOn` "\xfeff{foo}"
2019-09-06 07:48:01 +02:00
2022-01-06 14:49:54 +01:00
context "Arguments" $ do
it "accepts block strings as argument" $
parse document "" `shouldSucceedOn` [gql|{
hello(text: """Argument""")
}|]
it "accepts strings as argument" $
parse document "" `shouldSucceedOn` [gql|{
hello(text: "Argument")
}|]
it "accepts int as argument1" $
2022-01-06 14:49:54 +01:00
parse document "" `shouldSucceedOn` [gql|{
user(id: 4)
}|]
it "accepts boolean as argument" $
parse document "" `shouldSucceedOn` [gql|{
hello(flag: true) { field1 }
}|]
it "accepts float as argument" $
parse document "" `shouldSucceedOn` [gql|{
body(height: 172.5) { height }
}|]
it "accepts empty list as argument" $
parse document "" `shouldSucceedOn` [gql|{
query(list: []) { field1 }
}|]
it "accepts two required arguments" $
parse document "" `shouldSucceedOn` [gql|
mutation auth($username: String!, $password: String!){
test
}|]
it "accepts two string arguments" $
parse document "" `shouldSucceedOn` [gql|
mutation auth{
test(username: "username", password: "password")
}|]
it "accepts two block string arguments" $
parse document "" `shouldSucceedOn` [gql|
mutation auth{
test(username: """username""", password: """password""")
}|]
it "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
let
query' :: Text
arguments = map printArgument $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
query' = "query(" <> Text.intercalate ", " arguments <> ")" in
parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
2020-01-03 07:20:48 +01:00
it "parses minimal schema definition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|schema { query: Query }|]
2020-01-05 07:42:04 +01:00
it "parses minimal scalar definition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|scalar Time|]
2020-01-05 07:42:04 +01:00
it "parses ImplementsInterfaces" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-01-05 07:42:04 +01:00
type Person implements NamedEntity & ValuedEntity {
name: String
}
|]
it "parses a type without ImplementsInterfaces" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-01-05 07:42:04 +01:00
type Person {
name: String
}
|]
it "parses ArgumentsDefinition in an ObjectDefinition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-01-05 07:42:04 +01:00
type Person {
name(first: String, last: String): String
}
|]
2020-01-07 13:56:58 +01:00
it "parses minimal union type definition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-01-07 13:56:58 +01:00
union SearchResult = Photo | Person
|]
2020-01-11 08:32:25 +01:00
it "parses minimal interface type definition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-01-11 08:32:25 +01:00
interface NamedEntity {
name: String
}
|]
it "parses minimal enum type definition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
enum Direction {
NORTH
EAST
SOUTH
WEST
}
|]
it "parses minimal input object type definition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
input Point2D {
x: Float
y: Float
}
|]
2020-01-15 20:20:50 +01:00
it "parses minimal input enum definition with an optional pipe" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-01-15 20:20:50 +01:00
directive @example on
| FIELD
| FRAGMENT_SPREAD
|]
2020-01-25 16:37:17 +01:00
it "parses two minimal directive definitions" $
let directive nm loc =
TypeSystemDefinition
(DirectiveDefinition
(Description Nothing)
nm
(ArgumentsDefinition [])
(loc :| []))
example1 =
directive "example1"
(DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
2021-09-23 08:23:38 +02:00
(Location {line = 1, column = 1})
example2 =
directive "example2"
(DirLoc.ExecutableDirectiveLocation DirLoc.Field)
2021-09-23 08:23:38 +02:00
(Location {line = 2, column = 1})
testSchemaExtension = example1 :| [ example2 ]
2021-09-23 08:23:38 +02:00
query = [gql|
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})
2021-09-23 08:23:38 +02:00
query = [gql|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
in parse document "" query `shouldParse` (defn :| [ ])
2020-01-25 16:37:17 +01:00
it "parses schema extension with a new directive" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn`[gql|
2020-01-25 16:37:17 +01:00
extend schema @newDirective
|]
it "parses schema extension with an operation type definition" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|extend schema { query: Query }|]
2020-01-25 16:37:17 +01:00
it "parses schema extension with an operation type and directive" $
let newDirective = Directive "newDirective" [] $ Location 1 15
2020-07-20 21:29:12 +02:00
schemaExtension = SchemaExtension
2020-01-25 16:37:17 +01:00
$ SchemaOperationExtension [newDirective]
$ OperationTypeDefinition Query "Query" :| []
2020-07-20 21:29:12 +02:00
testSchemaExtension = TypeSystemExtension schemaExtension
$ Location 1 1
2021-09-23 08:23:38 +02:00
query = [gql|extend schema @newDirective { query: Query }|]
2020-01-25 16:37:17 +01:00
in parse document "" query `shouldParse` (testSchemaExtension :| [])
2020-01-28 11:08:28 +01:00
it "parses an object extension" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-01-28 11:08:28 +01:00
extend type Story {
isHiddenLocally: Boolean
}
2020-05-22 10:11:48 +02:00
|]
it "rejects variables in DefaultValue" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldFailOn` [gql|
2020-05-22 10:11:48 +02:00
query ($book: String = "Zarathustra", $author: String = $book) {
title
}
|]
2022-01-06 14:49:54 +01:00
it "rejects empty selection set" $
parse document "" `shouldFailOn` [gql|
query {
innerField {}
}
|]
it "parses documents beginning with a comment" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
"""
Query
"""
type Query {
queryField: String
}
|]
2020-07-11 06:34:10 +02:00
it "parses subscriptions" $
2021-09-23 08:23:38 +02:00
parse document "" `shouldSucceedOn` [gql|
2020-07-11 06:34:10 +02:00
subscription NewMessages {
newMessage(roomId: 123) {
sender
}
}
|]