aboutsummaryrefslogtreecommitdiff
path: root/tests/Language/GraphQL
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Language/GraphQL')
-rw-r--r--tests/Language/GraphQL/AST/Arbitrary.hs60
-rw-r--r--tests/Language/GraphQL/AST/EncoderSpec.hs223
-rw-r--r--tests/Language/GraphQL/AST/LexerSpec.hs51
-rw-r--r--tests/Language/GraphQL/AST/ParserSpec.hs335
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs21
-rw-r--r--tests/Language/GraphQL/THSpec.hs24
-rw-r--r--tests/Language/GraphQL/Validate/RulesSpec.hs734
7 files changed, 686 insertions, 762 deletions
diff --git a/tests/Language/GraphQL/AST/Arbitrary.hs b/tests/Language/GraphQL/AST/Arbitrary.hs
index 4f74bf3..69247b1 100644
--- a/tests/Language/GraphQL/AST/Arbitrary.hs
+++ b/tests/Language/GraphQL/AST/Arbitrary.hs
@@ -1,15 +1,26 @@
{-# LANGUAGE OverloadedStrings #-}
-module Language.GraphQL.AST.Arbitrary where
+module Language.GraphQL.AST.Arbitrary
+ ( AnyArgument(..)
+ , AnyLocation(..)
+ , AnyName(..)
+ , AnyNode(..)
+ , AnyObjectField(..)
+ , AnyValue(..)
+ , printArgument
+ ) where
import qualified Language.GraphQL.AST.Document as Doc
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
import Test.QuickCheck.Gen (Gen (..))
-import Data.Text (Text, pack)
+import Data.Text (Text)
+import qualified Data.Text as Text
import Data.Functor ((<&>))
-newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show)
+newtype AnyPrintableChar = AnyPrintableChar
+ { getAnyPrintableChar :: Char
+ } deriving (Eq, Show)
alpha :: String
alpha = ['a'..'z'] <> ['A'..'Z']
@@ -20,30 +31,42 @@ num = ['0'..'9']
instance Arbitrary AnyPrintableChar where
arbitrary = AnyPrintableChar <$> elements chars
where
- chars = alpha <> num <> ['_']
+ chars = alpha <> num <> ['_']
-newtype AnyPrintableText = AnyPrintableText { getAnyPrintableText :: Text } deriving (Eq, Show)
+newtype AnyPrintableText = AnyPrintableText
+ { getAnyPrintableText :: Text
+ } deriving (Eq, Show)
instance Arbitrary AnyPrintableText where
arbitrary = do
nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar))
- pure $ AnyPrintableText (pack $ map getAnyPrintableChar nonEmptyStr)
+ pure $ AnyPrintableText
+ $ Text.pack
+ $ map getAnyPrintableChar nonEmptyStr
-- https://spec.graphql.org/June2018/#Name
-newtype AnyName = AnyName { getAnyName :: Text } deriving (Eq, Show)
+newtype AnyName = AnyName
+ { getAnyName :: Text
+ } deriving (Eq, Show)
instance Arbitrary AnyName where
arbitrary = do
firstChar <- elements $ alpha <> ['_']
rest <- (arbitrary :: Gen [AnyPrintableChar])
- pure $ AnyName (pack $ firstChar : map getAnyPrintableChar rest)
+ pure $ AnyName
+ $ Text.pack
+ $ firstChar : map getAnyPrintableChar rest
-newtype AnyLocation = AnyLocation { getAnyLocation :: Doc.Location } deriving (Eq, Show)
+newtype AnyLocation = AnyLocation
+ { getAnyLocation :: Doc.Location
+ } deriving (Eq, Show)
instance Arbitrary AnyLocation where
arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary)
-newtype AnyNode a = AnyNode { getAnyNode :: Doc.Node a } deriving (Eq, Show)
+newtype AnyNode a = AnyNode
+ { getAnyNode :: Doc.Node a
+ } deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyNode a) where
arbitrary = do
@@ -51,7 +74,9 @@ instance Arbitrary a => Arbitrary (AnyNode a) where
node' <- flip Doc.Node location' <$> arbitrary
pure $ AnyNode node'
-newtype AnyObjectField a = AnyObjectField { getAnyObjectField :: Doc.ObjectField a } deriving (Eq, Show)
+newtype AnyObjectField a = AnyObjectField
+ { getAnyObjectField :: Doc.ObjectField a
+ } deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyObjectField a) where
arbitrary = do
@@ -60,8 +85,9 @@ instance Arbitrary a => Arbitrary (AnyObjectField a) where
location' <- getAnyLocation <$> arbitrary
pure $ AnyObjectField $ Doc.ObjectField name' value' location'
-newtype AnyValue = AnyValue { getAnyValue :: Doc.Value }
- deriving (Eq, Show)
+newtype AnyValue = AnyValue
+ { getAnyValue :: Doc.Value
+ } deriving (Eq, Show)
instance Arbitrary AnyValue
where
@@ -88,8 +114,9 @@ instance Arbitrary AnyValue
, Doc.Object <$> objectGen
]
-newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument }
- deriving (Eq, Show)
+newtype AnyArgument a = AnyArgument
+ { getAnyArgument :: Doc.Argument
+ } deriving (Eq, Show)
instance Arbitrary a => Arbitrary (AnyArgument a) where
arbitrary = do
@@ -99,4 +126,5 @@ instance Arbitrary a => Arbitrary (AnyArgument a) where
pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location'
printArgument :: AnyArgument AnyValue -> Text
-printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) = name' <> ": " <> (pack . show) value'
+printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) =
+ name' <> ": " <> (Text.pack . show) value'
diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs
index 3fa6a02..e98d5ef 100644
--- a/tests/Language/GraphQL/AST/EncoderSpec.hs
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.EncoderSpec
( spec
) where
@@ -7,20 +6,17 @@ module Language.GraphQL.AST.EncoderSpec
import Data.List.NonEmpty (NonEmpty(..))
import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.AST.Encoder
-import Language.GraphQL.TH
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain)
import Test.QuickCheck (choose, oneof, forAll)
import qualified Data.Text.Lazy as Text.Lazy
+import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
spec :: Spec
spec = do
describe "value" $ do
- context "null value" $ do
- let testNull formatter = value formatter Full.Null `shouldBe` "null"
- it "minified" $ testNull minified
- it "pretty" $ testNull pretty
-
context "minified" $ do
+ it "encodes null" $
+ value minified Full.Null `shouldBe` "null"
it "escapes \\" $
value minified (Full.String "\\") `shouldBe` "\"\\\\\""
it "escapes double quotes" $
@@ -46,113 +42,95 @@ spec = do
it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\""
context "pretty" $ do
+ it "encodes null" $
+ value pretty Full.Null `shouldBe` "null"
+
it "uses strings for short string values" $
value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
it "uses block strings for text with new lines, with newline symbol" $
- let expected = [gql|
- """
- Line 1
- Line 2
- """
- |]
+ let expected = "\"\"\"\n\
+ \ Line 1\n\
+ \ Line 2\n\
+ \\"\"\""
actual = value pretty $ Full.String "Line 1\nLine 2"
in actual `shouldBe` expected
it "uses block strings for text with new lines, with CR symbol" $
- let expected = [gql|
- """
- Line 1
- Line 2
- """
- |]
+ let expected = "\"\"\"\n\
+ \ Line 1\n\
+ \ Line 2\n\
+ \\"\"\""
actual = value pretty $ Full.String "Line 1\rLine 2"
in actual `shouldBe` expected
it "uses block strings for text with new lines, with CR symbol followed by newline" $
- let expected = [gql|
- """
- Line 1
- Line 2
- """
- |]
+ let expected = "\"\"\"\n\
+ \ Line 1\n\
+ \ Line 2\n\
+ \\"\"\""
actual = value pretty $ Full.String "Line 1\r\nLine 2"
in actual `shouldBe` expected
it "encodes as one line string if has escaped symbols" $ do
- let
- genNotAllowedSymbol = oneof
- [ choose ('\x0000', '\x0008')
- , choose ('\x000B', '\x000C')
- , choose ('\x000E', '\x001F')
- , pure '\x007F'
- ]
-
+ let genNotAllowedSymbol = oneof
+ [ choose ('\x0000', '\x0008')
+ , choose ('\x000B', '\x000C')
+ , choose ('\x000E', '\x001F')
+ , pure '\x007F'
+ ]
forAll genNotAllowedSymbol $ \x -> do
- let
- rawValue = "Short \n" <> Text.Lazy.cons x "text"
- encoded = value pretty
- $ Full.String $ Text.Lazy.toStrict rawValue
- shouldStartWith (Text.Lazy.unpack encoded) "\""
- shouldEndWith (Text.Lazy.unpack encoded) "\""
- shouldNotContain (Text.Lazy.unpack encoded) "\"\"\""
+ let rawValue = "Short \n" <> Text.Lazy.cons x "text"
+ encoded = Text.Lazy.unpack
+ $ value pretty
+ $ Full.String
+ $ Text.Lazy.toStrict rawValue
+ shouldStartWith encoded "\""
+ shouldEndWith encoded "\""
+ shouldNotContain encoded "\"\"\""
it "Hello world" $
let actual = value pretty
$ Full.String "Hello,\n World!\n\nYours,\n GraphQL."
- expected = [gql|
- """
- Hello,
- World!
-
- Yours,
- GraphQL.
- """
- |]
+ expected = "\"\"\"\n\
+ \ Hello,\n\
+ \ World!\n\
+ \\n\
+ \ Yours,\n\
+ \ GraphQL.\n\
+ \\"\"\""
in actual `shouldBe` expected
it "has only newlines" $
let actual = value pretty $ Full.String "\n"
- expected = [gql|
- """
-
-
- """
- |]
+ expected = "\"\"\"\n\n\n\"\"\""
in actual `shouldBe` expected
it "has newlines and one symbol at the begining" $
let actual = value pretty $ Full.String "a\n\n"
- expected = [gql|
- """
- a
-
-
- """|]
+ expected = "\"\"\"\n\
+ \ a\n\
+ \\n\
+ \\n\
+ \\"\"\""
in actual `shouldBe` expected
it "has newlines and one symbol at the end" $
let actual = value pretty $ Full.String "\n\na"
- expected = [gql|
- """
-
-
- a
- """
- |]
+ expected = "\"\"\"\n\
+ \\n\
+ \\n\
+ \ a\n\
+ \\"\"\""
in actual `shouldBe` expected
it "has newlines and one symbol in the middle" $
let actual = value pretty $ Full.String "\na\n"
- expected = [gql|
- """
-
- a
-
- """
- |]
+ expected = "\"\"\"\n\
+ \\n\
+ \ a\n\
+ \\n\
+ \\"\"\""
in actual `shouldBe` expected
it "skip trailing whitespaces" $
let actual = value pretty $ Full.String " Short\ntext "
- expected = [gql|
- """
- Short
- text
- """
- |]
+ expected = "\"\"\"\n\
+ \ Short\n\
+ \ text\n\
+ \\"\"\""
in actual `shouldBe` expected
describe "definition" $
@@ -164,14 +142,12 @@ spec = do
fieldSelection = pure $ Full.FieldSelection field
operation = Full.DefinitionOperation
$ Full.SelectionSet fieldSelection location
- expected = Text.Lazy.snoc [gql|
- {
- field(message: """
- line1
- line2
- """)
- }
- |] '\n'
+ expected = "{\n\
+ \ field(message: \"\"\"\n\
+ \ line1\n\
+ \ line2\n\
+ \ \"\"\")\n\
+ \}\n"
actual = definition pretty operation
in actual `shouldBe` expected
@@ -186,12 +162,10 @@ spec = do
mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType"
operations = queryType :| pure mutationType
definition' = Full.SchemaDefinition [] operations
- expected = Text.Lazy.snoc [gql|
- schema {
- query: QueryRootType
- mutation: MutationType
- }
- |] '\n'
+ expected = "schema {\n\
+ \ query: QueryRootType\n\
+ \ mutation: MutationType\n\
+ \}\n"
actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected
@@ -210,11 +184,9 @@ spec = do
$ Full.InterfaceTypeDefinition mempty "UUID" mempty
$ pure
$ Full.FieldDefinition mempty "value" arguments someType mempty
- expected = [gql|
- interface UUID {
- value(arg: String): String
- }
- |]
+ expected = "interface UUID {\n\
+ \ value(arg: String): String\n\
+ \}"
actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected
@@ -222,11 +194,9 @@ spec = do
let definition' = Full.TypeDefinition
$ Full.UnionTypeDefinition mempty "SearchResult" mempty
$ Full.UnionMemberTypes ["Photo", "Person"]
- expected = [gql|
- union SearchResult =
- | Photo
- | Person
- |]
+ expected = "union SearchResult =\n\
+ \ | Photo\n\
+ \ | Person"
actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected
@@ -239,14 +209,12 @@ spec = do
]
definition' = Full.TypeDefinition
$ Full.EnumTypeDefinition mempty "Direction" mempty values
- expected = [gql|
- enum Direction {
- NORTH
- EAST
- SOUTH
- WEST
- }
- |]
+ expected = "enum Direction {\n\
+ \ NORTH\n\
+ \ EAST\n\
+ \ SOUTH\n\
+ \ WEST\n\
+ \}"
actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected
@@ -259,11 +227,28 @@ spec = do
]
definition' = Full.TypeDefinition
$ Full.InputObjectTypeDefinition mempty "ExampleInputObject" mempty fields
- expected = [gql|
- input ExampleInputObject {
- a: String
- b: Int!
- }
- |]
+ expected = "input ExampleInputObject {\n\
+ \ a: String\n\
+ \ b: Int!\n\
+ \}"
actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected
+
+ context "directive definition" $ do
+ it "encodes a directive definition" $ do
+ let definition' = Full.DirectiveDefinition mempty "example" mempty False
+ $ pure
+ $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
+ expected = "@example() on\n\
+ \ | FIELD"
+ actual = typeSystemDefinition pretty definition'
+ in actual `shouldBe` expected
+
+ it "encodes a repeatable directive definition" $ do
+ let definition' = Full.DirectiveDefinition mempty "example" mempty True
+ $ pure
+ $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
+ expected = "@example() repeatable on\n\
+ \ | FIELD"
+ actual = typeSystemDefinition pretty definition'
+ in actual `shouldBe` expected
diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs
index e22c6b0..3cfa22e 100644
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.LexerSpec
( spec
) where
@@ -7,7 +6,6 @@ module Language.GraphQL.AST.LexerSpec
import Data.Text (Text)
import Data.Void (Void)
import Language.GraphQL.AST.Lexer
-import Language.GraphQL.TH
import Test.Hspec (Spec, context, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
import Text.Megaparsec (ParseErrorBundle, parse)
@@ -19,38 +17,39 @@ spec = describe "Lexer" $ do
parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
it "lexes strings" $ do
- parse string "" [gql|"simple"|] `shouldParse` "simple"
- parse string "" [gql|" white space "|] `shouldParse` " white space "
- parse string "" [gql|"quote \""|] `shouldParse` [gql|quote "|]
- parse string "" [gql|"escaped \n"|] `shouldParse` "escaped \n"
- parse string "" [gql|"slashes \\ \/"|] `shouldParse` [gql|slashes \ /|]
- parse string "" [gql|"unicode \u1234\u5678\u90AB\uCDEF"|]
+ parse string "" "\"simple\"" `shouldParse` "simple"
+ parse string "" "\" white space \"" `shouldParse` " white space "
+ parse string "" "\"quote \\\"\"" `shouldParse` "quote \""
+ parse string "" "\"escaped \\n\"" `shouldParse` "escaped \n"
+ parse string "" "\"slashes \\\\ \\/\"" `shouldParse` "slashes \\ /"
+ parse string "" "\"unicode \\u1234\\u5678\\u90AB\\uCDEF\""
`shouldParse` "unicode ሴ噸邫췯"
it "lexes block string" $ do
- parse blockString "" [gql|"""simple"""|] `shouldParse` "simple"
- parse blockString "" [gql|""" white space """|]
+ parse blockString "" "\"\"\"simple\"\"\"" `shouldParse` "simple"
+ parse blockString "" "\"\"\" white space \"\"\""
`shouldParse` " white space "
- parse blockString "" [gql|"""contains " quote"""|]
- `shouldParse` [gql|contains " quote|]
- parse blockString "" [gql|"""contains \""" triplequote"""|]
- `shouldParse` [gql|contains """ triplequote|]
+ parse blockString "" "\"\"\"contains \" quote\"\"\""
+ `shouldParse` "contains \" quote"
+ parse blockString "" "\"\"\"contains \\\"\"\" triplequote\"\"\""
+ `shouldParse` "contains \"\"\" triplequote"
parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline"
parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldParse` "multi\nline\nnormalized"
parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldParse` "multi\nline\nnormalized"
- parse blockString "" [gql|"""unescaped \n\r\b\t\f\u1234"""|]
- `shouldParse` [gql|unescaped \n\r\b\t\f\u1234|]
- parse blockString "" [gql|"""slashes \\ \/"""|]
- `shouldParse` [gql|slashes \\ \/|]
- parse blockString "" [gql|"""
-
- spans
- multiple
- lines
-
- """|] `shouldParse` "spans\n multiple\n lines"
+ parse blockString "" "\"\"\"unescaped \\n\\r\\b\\t\\f\\u1234\"\"\""
+ `shouldParse` "unescaped \\n\\r\\b\\t\\f\\u1234"
+ parse blockString "" "\"\"\"slashes \\\\ \\/\"\"\""
+ `shouldParse` "slashes \\\\ \\/"
+ parse blockString "" "\"\"\"\n\
+ \\n\
+ \ spans\n\
+ \ multiple\n\
+ \ lines\n\
+ \\n\
+ \\"\"\""
+ `shouldParse` "spans\n multiple\n lines"
it "lexes numbers" $ do
parse integer "" "4" `shouldParse` (4 :: Int)
@@ -84,7 +83,7 @@ spec = describe "Lexer" $ do
context "Implementation tests" $ do
it "lexes empty block strings" $
- parse blockString "" [gql|""""""|] `shouldParse` ""
+ parse blockString "" "\"\"\"\"\"\"" `shouldParse` ""
it "lexes ampersand" $
parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $
diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs
index 13faa21..3bd2576 100644
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@@ -1,18 +1,20 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.ParserSpec
( spec
) where
import Data.List.NonEmpty (NonEmpty(..))
-import Data.Text (Text)
import qualified Data.Text as Text
import Language.GraphQL.AST.Document
import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
import Language.GraphQL.AST.Parser
-import Language.GraphQL.TH
import Test.Hspec (Spec, describe, it, context)
-import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
+import Test.Hspec.Megaparsec
+ ( shouldParse
+ , shouldFailOn
+ , parseSatisfies
+ , shouldSucceedOn
+ )
import Text.Megaparsec (parse)
import Test.QuickCheck (property, NonEmptyList (..), mapSize)
import Language.GraphQL.AST.Arbitrary
@@ -23,182 +25,154 @@ spec = describe "Parser" $ do
parse document "" `shouldSucceedOn` "\xfeff{foo}"
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" $
- 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' <> " }")
+ it "accepts block strings as argument" $
+ parse document "" `shouldSucceedOn`
+ "{ hello(text: \"\"\"Argument\"\"\") }"
+
+ it "accepts strings as argument" $
+ parse document "" `shouldSucceedOn` "{ hello(text: \"Argument\") }"
+
+ it "accepts int as argument" $
+ parse document "" `shouldSucceedOn` "{ user(id: 4) }"
+
+ it "accepts boolean as argument" $
+ parse document "" `shouldSucceedOn`
+ "{ hello(flag: true) { field1 } }"
+
+ it "accepts float as argument" $
+ parse document "" `shouldSucceedOn`
+ "{ body(height: 172.5) { height } }"
+
+ it "accepts empty list as argument" $
+ parse document "" `shouldSucceedOn` "{ query(list: []) { field1 } }"
+
+ it "accepts two required arguments" $
+ parse document "" `shouldSucceedOn`
+ "mutation auth($username: String!, $password: String!) { test }"
+
+ it "accepts two string arguments" $
+ parse document "" `shouldSucceedOn`
+ "mutation auth { test(username: \"username\", password: \"password\") }"
+
+ it "accepts two block string arguments" $
+ let given = "mutation auth {\n\
+ \ test(username: \"\"\"username\"\"\", password: \"\"\"password\"\"\")\n\
+ \}"
+ in parse document "" `shouldSucceedOn` given
+
+ it "fails to parse an empty argument list in parens" $
+ parse document "" `shouldFailOn` "{ test() }"
+
+ it "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
+ let arguments' = map printArgument
+ $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
+ query' = "query(" <> Text.intercalate ", " arguments' <> ")"
+ in parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
it "parses minimal schema definition" $
- parse document "" `shouldSucceedOn` [gql|schema { query: Query }|]
+ parse document "" `shouldSucceedOn` "schema { query: Query }"
it "parses minimal scalar definition" $
- parse document "" `shouldSucceedOn` [gql|scalar Time|]
+ parse document "" `shouldSucceedOn` "scalar Time"
it "parses ImplementsInterfaces" $
- parse document "" `shouldSucceedOn` [gql|
- type Person implements NamedEntity & ValuedEntity {
- name: String
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "type Person implements NamedEntity & ValuedEntity {\n\
+ \ name: String\n\
+ \}"
it "parses a type without ImplementsInterfaces" $
- parse document "" `shouldSucceedOn` [gql|
- type Person {
- name: String
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "type Person {\n\
+ \ name: String\n\
+ \}"
it "parses ArgumentsDefinition in an ObjectDefinition" $
- parse document "" `shouldSucceedOn` [gql|
- type Person {
- name(first: String, last: String): String
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "type Person {\n\
+ \ name(first: String, last: String): String\n\
+ \}"
it "parses minimal union type definition" $
- parse document "" `shouldSucceedOn` [gql|
- union SearchResult = Photo | Person
- |]
+ parse document "" `shouldSucceedOn`
+ "union SearchResult = Photo | Person"
it "parses minimal interface type definition" $
- parse document "" `shouldSucceedOn` [gql|
- interface NamedEntity {
- name: String
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "interface NamedEntity {\n\
+ \ name: String\n\
+ \}"
it "parses minimal enum type definition" $
- parse document "" `shouldSucceedOn` [gql|
- enum Direction {
- NORTH
- EAST
- SOUTH
- WEST
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "enum Direction {\n\
+ \ NORTH\n\
+ \ EAST\n\
+ \ SOUTH\n\
+ \ WEST\n\
+ \}"
it "parses minimal input object type definition" $
- parse document "" `shouldSucceedOn` [gql|
- input Point2D {
- x: Float
- y: Float
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "input Point2D {\n\
+ \ x: Float\n\
+ \ y: Float\n\
+ \}"
it "parses minimal input enum definition with an optional pipe" $
- parse document "" `shouldSucceedOn` [gql|
- directive @example on
- | FIELD
- | FRAGMENT_SPREAD
- |]
+ parse document "" `shouldSucceedOn`
+ "directive @example on\n\
+ \ | FIELD\n\
+ \ | 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 = 1, column = 1})
- example2 =
- directive "example2"
- (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
- (Location {line = 2, column = 1})
- testSchemaExtension = example1 :| [ example2 ]
- query = [gql|
- directive @example1 on FIELD_DEFINITION
- directive @example2 on FIELD
- |]
+ let directive name' loc = TypeSystemDefinition
+ $ DirectiveDefinition
+ (Description Nothing)
+ name'
+ (ArgumentsDefinition [])
+ False
+ (loc :| [])
+ example1 = directive "example1"
+ (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
+ (Location {line = 1, column = 1})
+ example2 = directive "example2"
+ (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
+ (Location {line = 2, column = 1})
+ testSchemaExtension = example1 :| [example2]
+ query = Text.unlines
+ [ "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 = [gql|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
- in parse document "" query `shouldParse` (defn :| [ ])
+ let argumentValue = Just
+ $ Node (ConstList [])
+ $ Location{ line = 1, column = 33 }
+ loc = DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition
+ argumentValueDefinition = InputValueDefinition
+ (Description Nothing)
+ "foo"
+ (TypeList (TypeNamed "String"))
+ argumentValue
+ []
+ definition = DirectiveDefinition
+ (Description Nothing)
+ "test"
+ (ArgumentsDefinition [argumentValueDefinition])
+ False
+ (loc :| [])
+ directive = TypeSystemDefinition definition
+ $ Location{ line = 1, column = 1 }
+ query = "directive @test(foo: [String] = []) on FIELD_DEFINITION"
+ in parse document "" query `shouldParse` (directive :| [])
it "parses schema extension with a new directive" $
- parse document "" `shouldSucceedOn`[gql|
- extend schema @newDirective
- |]
+ parse document "" `shouldSucceedOn` "extend schema @newDirective"
it "parses schema extension with an operation type definition" $
- parse document "" `shouldSucceedOn` [gql|extend schema { query: Query }|]
+ parse document "" `shouldSucceedOn` "extend schema { query: Query }"
it "parses schema extension with an operation type and directive" $
let newDirective = Directive "newDirective" [] $ Location 1 15
@@ -207,45 +181,42 @@ spec = describe "Parser" $ do
$ OperationTypeDefinition Query "Query" :| []
testSchemaExtension = TypeSystemExtension schemaExtension
$ Location 1 1
- query = [gql|extend schema @newDirective { query: Query }|]
+ query = "extend schema @newDirective { query: Query }"
in parse document "" query `shouldParse` (testSchemaExtension :| [])
+ it "parses a repeatable directive definition" $
+ let given = "directive @test repeatable on FIELD_DEFINITION"
+ isRepeatable (TypeSystemDefinition definition' _ :| [])
+ | DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable
+ isRepeatable _ = False
+ in parse document "" given `parseSatisfies` isRepeatable
+
it "parses an object extension" $
- parse document "" `shouldSucceedOn` [gql|
- extend type Story {
- isHiddenLocally: Boolean
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "extend type Story { isHiddenLocally: Boolean }"
it "rejects variables in DefaultValue" $
- parse document "" `shouldFailOn` [gql|
- query ($book: String = "Zarathustra", $author: String = $book) {
- title
- }
- |]
+ parse document "" `shouldFailOn`
+ "query ($book: String = \"Zarathustra\", $author: String = $book) {\n\
+ \ title\n\
+ \}"
it "rejects empty selection set" $
- parse document "" `shouldFailOn` [gql|
- query {
- innerField {}
- }
- |]
+ parse document "" `shouldFailOn` "query { innerField {} }"
it "parses documents beginning with a comment" $
- parse document "" `shouldSucceedOn` [gql|
- """
- Query
- """
- type Query {
- queryField: String
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "\"\"\"\n\
+ \Query\n\
+ \\"\"\"\n\
+ \type Query {\n\
+ \ queryField: String\n\
+ \}"
it "parses subscriptions" $
- parse document "" `shouldSucceedOn` [gql|
- subscription NewMessages {
- newMessage(roomId: 123) {
- sender
- }
- }
- |]
+ parse document "" `shouldSucceedOn`
+ "subscription NewMessages {\n\
+ \ newMessage(roomId: 123) {\n\
+ \ sender\n\
+ \ }\n\
+ \}"
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index 52bd410..953f739 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -5,9 +5,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.ExecuteSpec
( spec
@@ -23,7 +21,6 @@ import Language.GraphQL.AST (Document, Location(..), Name)
import Language.GraphQL.AST.Parser (document)
import Language.GraphQL.Error
import Language.GraphQL.Execute (execute)
-import Language.GraphQL.TH
import qualified Language.GraphQL.Type.Schema as Schema
import qualified Language.GraphQL.Type as Type
import Language.GraphQL.Type
@@ -269,15 +266,15 @@ spec :: Spec
spec =
describe "execute" $ do
it "rejects recursive fragments" $
- let sourceQuery = [gql|
- {
- ...cyclicFragment
- }
-
- fragment cyclicFragment on Query {
- ...cyclicFragment
- }
- |]
+ let sourceQuery = "\
+ \{\n\
+ \ ...cyclicFragment\n\
+ \}\n\
+ \\n\
+ \fragment cyclicFragment on Query {\n\
+ \ ...cyclicFragment\n\
+ \}\
+ \"
expected = Response (Object mempty) mempty
in sourceQuery `shouldResolveTo` expected
diff --git a/tests/Language/GraphQL/THSpec.hs b/tests/Language/GraphQL/THSpec.hs
new file mode 100644
index 0000000..2858ab2
--- /dev/null
+++ b/tests/Language/GraphQL/THSpec.hs
@@ -0,0 +1,24 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE QuasiQuotes #-}
+
+module Language.GraphQL.THSpec
+ ( spec
+ ) where
+
+import Language.GraphQL.TH (gql)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+spec :: Spec
+spec =
+ describe "gql" $
+ it "replaces CRNL with NL" $
+ let expected = "line1\nline2\nline3"
+ actual = [gql|
+ line1
+ line2
+ line3
+ |]
+ in actual `shouldBe` expected
diff --git a/tests/Language/GraphQL/Validate/RulesSpec.hs b/tests/Language/GraphQL/Validate/RulesSpec.hs
index 7bdbd86..c48b329 100644
--- a/tests/Language/GraphQL/Validate/RulesSpec.hs
+++ b/tests/Language/GraphQL/Validate/RulesSpec.hs
@@ -3,7 +3,6 @@
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.Validate.RulesSpec
( spec
@@ -13,8 +12,9 @@ import Data.Foldable (toList)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import qualified Language.GraphQL.AST as AST
-import Language.GraphQL.TH
import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.Schema as Schema
+import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Validate
@@ -22,7 +22,9 @@ import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain)
import Text.Megaparsec (parse, errorBundlePretty)
petSchema :: Schema IO
-petSchema = schema queryType Nothing (Just subscriptionType) mempty
+petSchema = schema queryType Nothing (Just subscriptionType)
+ $ HashMap.singleton "repeat"
+ $ Schema.Directive Nothing mempty True [DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field]
queryType :: ObjectType IO
queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
@@ -169,18 +171,16 @@ spec =
describe "document" $ do
context "executableDefinitionsRule" $
it "rejects type definitions" $
- let queryString = [gql|
- query getDogName {
- dog {
- name
- color
- }
- }
-
- extend type Dog {
- color: String
- }
- |]
+ let queryString = "query getDogName {\n\
+ \ dog {\n\
+ \ name\n\
+ \ color\n\
+ \ }\n\
+ \}\n\
+ \\n\
+ \extend type Dog {\n\
+ \ color: String\n\
+ \}"
expected = Error
{ message =
"Definition must be OperationDefinition or \
@@ -191,15 +191,13 @@ spec =
context "singleFieldSubscriptionsRule" $ do
it "rejects multiple subscription root fields" $
- let queryString = [gql|
- subscription sub {
- newMessage {
- body
- sender
- }
- disallowedSecondRootField
- }
- |]
+ let queryString = "subscription sub {\n\
+ \ newMessage {\n\
+ \ body\n\
+ \ sender\n\
+ \ }\n\
+ \ disallowedSecondRootField\n\
+ \}"
expected = Error
{ message =
"Subscription \"sub\" must select only one top \
@@ -209,19 +207,17 @@ spec =
in validate queryString `shouldContain` [expected]
it "rejects multiple subscription root fields coming from a fragment" $
- let queryString = [gql|
- subscription sub {
- ...multipleSubscriptions
- }
-
- fragment multipleSubscriptions on Subscription {
- newMessage {
- body
- sender
- }
- disallowedSecondRootField
- }
- |]
+ let queryString = "subscription sub {\n\
+ \ ...multipleSubscriptions\n\
+ \}\n\
+ \\n\
+ \fragment multipleSubscriptions on Subscription {\n\
+ \ newMessage {\n\
+ \ body\n\
+ \ sender\n\
+ \ }\n\
+ \ disallowedSecondRootField\n\
+ \}"
expected = Error
{ message =
"Subscription \"sub\" must select only one top \
@@ -231,26 +227,24 @@ spec =
in validate queryString `shouldContain` [expected]
it "finds corresponding subscription fragment" $
- let queryString = [gql|
- subscription sub {
- ...anotherSubscription
- ...multipleSubscriptions
- }
- fragment multipleSubscriptions on Subscription {
- newMessage {
- body
- }
- disallowedSecondRootField {
- sender
- }
- }
- fragment anotherSubscription on Subscription {
- newMessage {
- body
- sender
- }
- }
- |]
+ let queryString = "subscription sub {\n\
+ \ ...anotherSubscription\n\
+ \ ...multipleSubscriptions\n\
+ \}\n\
+ \fragment multipleSubscriptions on Subscription {\n\
+ \ newMessage {\n\
+ \ body\n\
+ \ }\n\
+ \ disallowedSecondRootField {\n\
+ \ sender\n\
+ \ }\n\
+ \}\n\
+ \fragment anotherSubscription on Subscription {\n\
+ \ newMessage {\n\
+ \ body\n\
+ \ sender\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Subscription \"sub\" must select only one top \
@@ -261,21 +255,19 @@ spec =
context "loneAnonymousOperationRule" $
it "rejects multiple anonymous operations" $
- let queryString = [gql|
- {
- dog {
- name
- }
- }
-
- query getName {
- dog {
- owner {
- name
- }
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ name\n\
+ \ }\n\
+ \}\n\
+ \\n\
+ \query getName {\n\
+ \ dog {\n\
+ \ owner {\n\
+ \ name\n\
+ \ }\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"This anonymous operation must be the only defined \
@@ -286,19 +278,17 @@ spec =
context "uniqueOperationNamesRule" $
it "rejects operations with the same name" $
- let queryString = [gql|
- query dogOperation {
- dog {
- name
- }
- }
-
- mutation dogOperation {
- mutateDog {
- id
- }
- }
- |]
+ let queryString = "query dogOperation {\n\
+ \ dog {\n\
+ \ name\n\
+ \ }\n\
+ \}\n\
+ \\n\
+ \mutation dogOperation {\n\
+ \ mutateDog {\n\
+ \ id\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"There can be only one operation named \
@@ -309,23 +299,21 @@ spec =
context "uniqueFragmentNamesRule" $
it "rejects fragments with the same name" $
- let queryString = [gql|
- {
- dog {
- ...fragmentOne
- }
- }
-
- fragment fragmentOne on Dog {
- name
- }
-
- fragment fragmentOne on Dog {
- owner {
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ ...fragmentOne\n\
+ \ }\n\
+ \}\n\
+ \\n\
+ \fragment fragmentOne on Dog {\n\
+ \ name\n\
+ \}\n\
+ \\n\
+ \fragment fragmentOne on Dog {\n\
+ \ owner {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"There can be only one fragment named \
@@ -336,13 +324,11 @@ spec =
context "fragmentSpreadTargetDefinedRule" $
it "rejects the fragment spread without a target" $
- let queryString = [gql|
- {
- dog {
- ...undefinedFragment
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ ...undefinedFragment\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fragment target \"undefinedFragment\" is \
@@ -353,16 +339,14 @@ spec =
context "fragmentSpreadTypeExistenceRule" $ do
it "rejects fragment spreads without an unknown target type" $
- let queryString = [gql|
- {
- dog {
- ...notOnExistingType
- }
- }
- fragment notOnExistingType on NotInSchema {
- name
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ ...notOnExistingType\n\
+ \ }\n\
+ \}\n\
+ \fragment notOnExistingType on NotInSchema {\n\
+ \ name\n\
+ \}"
expected = Error
{ message =
"Fragment \"notOnExistingType\" is specified on \
@@ -373,13 +357,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "rejects inline fragments without a target" $
- let queryString = [gql|
- {
- ... on NotInSchema {
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ ... on NotInSchema {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Inline fragment is specified on type \
@@ -390,16 +372,14 @@ spec =
context "fragmentsOnCompositeTypesRule" $ do
it "rejects fragments on scalar types" $
- let queryString = [gql|
- {
- dog {
- ...fragOnScalar
- }
- }
- fragment fragOnScalar on Int {
- name
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ ...fragOnScalar\n\
+ \ }\n\
+ \}\n\
+ \fragment fragOnScalar on Int {\n\
+ \ name\n\
+ \}"
expected = Error
{ message =
"Fragment cannot condition on non composite type \
@@ -409,13 +389,11 @@ spec =
in validate queryString `shouldContain` [expected]
it "rejects inline fragments on scalar types" $
- let queryString = [gql|
- {
- ... on Boolean {
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ ... on Boolean {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fragment cannot condition on non composite type \
@@ -426,17 +404,15 @@ spec =
context "noUnusedFragmentsRule" $
it "rejects unused fragments" $
- let queryString = [gql|
- fragment nameFragment on Dog { # unused
- name
- }
-
- {
- dog {
- name
- }
- }
- |]
+ let queryString = "fragment nameFragment on Dog { # unused\n\
+ \ name\n\
+ \}\n\
+ \\n\
+ \{\n\
+ \ dog {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fragment \"nameFragment\" is never used."
@@ -446,21 +422,19 @@ spec =
context "noFragmentCyclesRule" $
it "rejects spreads that form cycles" $
- let queryString = [gql|
- {
- dog {
- ...nameFragment
- }
- }
- fragment nameFragment on Dog {
- name
- ...barkVolumeFragment
- }
- fragment barkVolumeFragment on Dog {
- barkVolume
- ...nameFragment
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ ...nameFragment\n\
+ \ }\n\
+ \}\n\
+ \fragment nameFragment on Dog {\n\
+ \ name\n\
+ \ ...barkVolumeFragment\n\
+ \}\n\
+ \fragment barkVolumeFragment on Dog {\n\
+ \ barkVolume\n\
+ \ ...nameFragment\n\
+ \}"
error1 = Error
{ message =
"Cannot spread fragment \"barkVolumeFragment\" \
@@ -479,13 +453,11 @@ spec =
context "uniqueArgumentNamesRule" $
it "rejects duplicate field arguments" $
- let queryString = [gql|
- {
- dog {
- isHousetrained(atOtherHomes: true, atOtherHomes: true)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ isHousetrained(atOtherHomes: true, atOtherHomes: true)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"There can be only one argument named \
@@ -494,15 +466,13 @@ spec =
}
in validate queryString `shouldBe` [expected]
- context "uniqueDirectiveNamesRule" $
+ context "uniqueDirectiveNamesRule" $ do
it "rejects more than one directive per location" $
- let queryString = [gql|
- query ($foo: Boolean = true, $bar: Boolean = false) {
- dog @skip(if: $foo) @skip(if: $bar) {
- name
- }
- }
- |]
+ let queryString = "query ($foo: Boolean = true, $bar: Boolean = false) {\n\
+ \ dog @skip(if: $foo) @skip(if: $bar) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"There can be only one directive named \"skip\"."
@@ -510,15 +480,21 @@ spec =
}
in validate queryString `shouldBe` [expected]
+ it "allows repeating repeatable directives" $
+ let queryString = "query {\n\
+ \ dog @repeat @repeat {\n\
+ \ name\n\
+ \ }\n\
+ \}"
+ in validate queryString `shouldBe` []
+
context "uniqueVariableNamesRule" $
it "rejects duplicate variables" $
- let queryString = [gql|
- query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) {
- dog {
- isHousetrained(atOtherHomes: $atOtherHomes)
- }
- }
- |]
+ let queryString = "query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) {\n\
+ \ dog {\n\
+ \ isHousetrained(atOtherHomes: $atOtherHomes)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"There can be only one variable named \
@@ -529,13 +505,11 @@ spec =
context "variablesAreInputTypesRule" $
it "rejects non-input types as variables" $
- let queryString = [gql|
- query takesDogBang($dog: Dog!) {
- dog {
- isHousetrained(atOtherHomes: $dog)
- }
- }
- |]
+ let queryString = "query takesDogBang($dog: Dog!) {\n\
+ \ dog {\n\
+ \ isHousetrained(atOtherHomes: $dog)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Variable \"$dog\" cannot be non-input type \
@@ -546,17 +520,15 @@ spec =
context "noUndefinedVariablesRule" $ do
it "rejects undefined variables" $
- let queryString = [gql|
- query variableIsNotDefinedUsedInSingleFragment {
- dog {
- ...isHousetrainedFragment
- }
- }
-
- fragment isHousetrainedFragment on Dog {
- isHousetrained(atOtherHomes: $atOtherHomes)
- }
- |]
+ let queryString = "query variableIsNotDefinedUsedInSingleFragment {\n\
+ \ dog {\n\
+ \ ...isHousetrainedFragment\n\
+ \ }\n\
+ \}\n\
+ \\n\
+ \fragment isHousetrainedFragment on Dog {\n\
+ \ isHousetrained(atOtherHomes: $atOtherHomes)\n\
+ \}"
expected = Error
{ message =
"Variable \"$atOtherHomes\" is not defined by \
@@ -567,13 +539,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "gets variable location inside an input object" $
- let queryString = [gql|
- query {
- findDog (complex: { name: $name }) {
- name
- }
- }
- |]
+ let queryString = "query {\n\
+ \ findDog (complex: { name: $name }) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message = "Variable \"$name\" is not defined."
, locations = [AST.Location 2 29]
@@ -581,13 +551,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "gets variable location inside an array" $
- let queryString = [gql|
- query {
- findCats (commands: [JUMP, $command]) {
- name
- }
- }
- |]
+ let queryString = "query {\n\
+ \ findCats (commands: [JUMP, $command]) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message = "Variable \"$command\" is not defined."
, locations = [AST.Location 2 30]
@@ -596,13 +564,11 @@ spec =
context "noUnusedVariablesRule" $ do
it "rejects unused variables" $
- let queryString = [gql|
- query variableUnused($atOtherHomes: Boolean) {
- dog {
- isHousetrained
- }
- }
- |]
+ let queryString = "query variableUnused($atOtherHomes: Boolean) {\n\
+ \ dog {\n\
+ \ isHousetrained\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Variable \"$atOtherHomes\" is never used in \
@@ -612,24 +578,20 @@ spec =
in validate queryString `shouldBe` [expected]
it "detects variables in properties of input objects" $
- let queryString = [gql|
- query withVar ($name: String!) {
- findDog (complex: { name: $name }) {
- name
- }
- }
- |]
+ let queryString = "query withVar ($name: String!) {\n\
+ \ findDog (complex: { name: $name }) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
in validate queryString `shouldBe` []
context "uniqueInputFieldNamesRule" $
it "rejects duplicate fields in input objects" $
- let queryString = [gql|
- {
- findDog(complex: { name: "Fido", name: "Jack" }) {
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ findDog(complex: { name: \"Fido\", name: \"Jack\" }) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"There can be only one input field named \"name\"."
@@ -639,13 +601,11 @@ spec =
context "fieldsOnCorrectTypeRule" $
it "rejects undefined fields" $
- let queryString = [gql|
- {
- dog {
- meowVolume
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ meowVolume\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Cannot query field \"meowVolume\" on type \"Dog\"."
@@ -655,15 +615,13 @@ spec =
context "scalarLeafsRule" $
it "rejects scalar fields with not empty selection set" $
- let queryString = [gql|
- {
- dog {
- barkVolume {
- sinceWhen
- }
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ barkVolume {\n\
+ \ sinceWhen\n\
+ \ }\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Field \"barkVolume\" must not have a selection \
@@ -674,13 +632,11 @@ spec =
context "knownArgumentNamesRule" $ do
it "rejects field arguments missing in the type" $
- let queryString = [gql|
- {
- dog {
- doesKnowCommand(command: CLEAN_UP_HOUSE, dogCommand: SIT)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ doesKnowCommand(command: CLEAN_UP_HOUSE, dogCommand: SIT)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Unknown argument \"command\" on field \
@@ -690,13 +646,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "rejects directive arguments missing in the definition" $
- let queryString = [gql|
- {
- dog {
- isHousetrained(atOtherHomes: true) @include(unless: false, if: true)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ isHousetrained(atOtherHomes: true) @include(unless: false, if: true)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Unknown argument \"unless\" on directive \
@@ -707,13 +661,11 @@ spec =
context "knownDirectiveNamesRule" $
it "rejects undefined directives" $
- let queryString = [gql|
- {
- dog {
- isHousetrained(atOtherHomes: true) @ignore(if: true)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ isHousetrained(atOtherHomes: true) @ignore(if: true)\n\
+ \ }\n\
+ \}"
expected = Error
{ message = "Unknown directive \"@ignore\"."
, locations = [AST.Location 3 40]
@@ -722,13 +674,11 @@ spec =
context "knownInputFieldNamesRule" $
it "rejects undefined input object fields" $
- let queryString = [gql|
- {
- findDog(complex: { favoriteCookieFlavor: "Bacon", name: "Jack" }) {
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ findDog(complex: { favoriteCookieFlavor: \"Bacon\", name: \"Jack\" }) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Field \"favoriteCookieFlavor\" is not defined \
@@ -739,13 +689,11 @@ spec =
context "directivesInValidLocationsRule" $
it "rejects directives in invalid locations" $
- let queryString = [gql|
- query @skip(if: $foo) {
- dog {
- name
- }
- }
- |]
+ let queryString = "query @skip(if: $foo) {\n\
+ \ dog {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Directive \"@skip\" may not be used on QUERY."
@@ -755,14 +703,12 @@ spec =
context "overlappingFieldsCanBeMergedRule" $ do
it "fails to merge fields of mismatching types" $
- let queryString = [gql|
- {
- dog {
- name: nickname
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ name: nickname\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fields \"name\" conflict because \"nickname\" and \
@@ -774,14 +720,12 @@ spec =
in validate queryString `shouldBe` [expected]
it "fails if the arguments of the same field don't match" $
- let queryString = [gql|
- {
- dog {
- doesKnowCommand(dogCommand: SIT)
- doesKnowCommand(dogCommand: HEEL)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ doesKnowCommand(dogCommand: SIT)\n\
+ \ doesKnowCommand(dogCommand: HEEL)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fields \"doesKnowCommand\" conflict because they \
@@ -793,14 +737,12 @@ spec =
in validate queryString `shouldBe` [expected]
it "fails to merge same-named field and alias" $
- let queryString = [gql|
- {
- dog {
- doesKnowCommand(dogCommand: SIT)
- doesKnowCommand: isHousetrained(atOtherHomes: true)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ doesKnowCommand(dogCommand: SIT)\n\
+ \ doesKnowCommand: isHousetrained(atOtherHomes: true)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fields \"doesKnowCommand\" conflict because \
@@ -812,18 +754,16 @@ spec =
in validate queryString `shouldBe` [expected]
it "looks for fields after a successfully merged field pair" $
- let queryString = [gql|
- {
- dog {
- name
- doesKnowCommand(dogCommand: SIT)
- }
- dog {
- name
- doesKnowCommand: isHousetrained(atOtherHomes: true)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ name\n\
+ \ doesKnowCommand(dogCommand: SIT)\n\
+ \ }\n\
+ \ dog {\n\
+ \ name\n\
+ \ doesKnowCommand: isHousetrained(atOtherHomes: true)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fields \"doesKnowCommand\" conflict because \
@@ -836,15 +776,13 @@ spec =
context "possibleFragmentSpreadsRule" $ do
it "rejects object inline spreads outside object scope" $
- let queryString = [gql|
- {
- dog {
- ... on Cat {
- meowVolume
- }
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ ... on Cat {\n\
+ \ meowVolume\n\
+ \ }\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Fragment cannot be spread here as objects of type \
@@ -854,17 +792,15 @@ spec =
in validate queryString `shouldBe` [expected]
it "rejects object named spreads outside object scope" $
- let queryString = [gql|
- {
- dog {
- ... catInDogFragmentInvalid
- }
- }
-
- fragment catInDogFragmentInvalid on Cat {
- meowVolume
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ ... catInDogFragmentInvalid\n\
+ \ }\n\
+ \}\n\
+ \\n\
+ \fragment catInDogFragmentInvalid on Cat {\n\
+ \ meowVolume\n\
+ \}"
expected = Error
{ message =
"Fragment \"catInDogFragmentInvalid\" cannot be \
@@ -876,13 +812,11 @@ spec =
context "providedRequiredInputFieldsRule" $
it "rejects missing required input fields" $
- let queryString = [gql|
- {
- findDog(complex: { name: null }) {
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ findDog(complex: { name: null }) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Input field \"name\" of type \"DogData\" is \
@@ -893,13 +827,11 @@ spec =
context "providedRequiredArgumentsRule" $ do
it "checks for (non-)nullable arguments" $
- let queryString = [gql|
- {
- dog {
- doesKnowCommand(dogCommand: null)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ doesKnowCommand(dogCommand: null)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Field \"doesKnowCommand\" argument \"dogCommand\" \
@@ -911,13 +843,11 @@ spec =
context "variablesInAllowedPositionRule" $ do
it "rejects wrongly typed variable arguments" $
- let queryString = [gql|
- query dogCommandArgQuery($dogCommandArg: DogCommand) {
- dog {
- doesKnowCommand(dogCommand: $dogCommandArg)
- }
- }
- |]
+ let queryString = "query dogCommandArgQuery($dogCommandArg: DogCommand) {\n\
+ \ dog {\n\
+ \ doesKnowCommand(dogCommand: $dogCommandArg)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Variable \"$dogCommandArg\" of type \
@@ -928,13 +858,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "rejects wrongly typed variable arguments" $
- let queryString = [gql|
- query intCannotGoIntoBoolean($intArg: Int) {
- dog {
- isHousetrained(atOtherHomes: $intArg)
- }
- }
- |]
+ let queryString = "query intCannotGoIntoBoolean($intArg: Int) {\n\
+ \ dog {\n\
+ \ isHousetrained(atOtherHomes: $intArg)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Variable \"$intArg\" of type \"Int\" used in \
@@ -945,13 +873,11 @@ spec =
context "valuesOfCorrectTypeRule" $ do
it "rejects values of incorrect types" $
- let queryString = [gql|
- {
- dog {
- isHousetrained(atOtherHomes: 3)
- }
- }
- |]
+ let queryString = "{\n\
+ \ dog {\n\
+ \ isHousetrained(atOtherHomes: 3)\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Value 3 cannot be coerced to type \"Boolean\"."
@@ -960,13 +886,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "uses the location of a single list value" $
- let queryString = [gql|
- {
- cat {
- doesKnowCommands(catCommands: [3])
- }
- }
- |]
+ let queryString = "{\n\
+ \ cat {\n\
+ \ doesKnowCommands(catCommands: [3])\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Value 3 cannot be coerced to type \"CatCommand!\"."
@@ -975,13 +899,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "validates input object properties once" $
- let queryString = [gql|
- {
- findDog(complex: { name: 3 }) {
- name
- }
- }
- |]
+ let queryString = "{\n\
+ \ findDog(complex: { name: 3 }) {\n\
+ \ name\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"Value 3 cannot be coerced to type \"String!\"."
@@ -990,13 +912,11 @@ spec =
in validate queryString `shouldBe` [expected]
it "checks for required list members" $
- let queryString = [gql|
- {
- cat {
- doesKnowCommands(catCommands: [null])
- }
- }
- |]
+ let queryString = "{\n\
+ \ cat {\n\
+ \ doesKnowCommands(catCommands: [null])\n\
+ \ }\n\
+ \}"
expected = Error
{ message =
"List of non-null values of type \"CatCommand\" \
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:51:55 +0000