aboutsummaryrefslogtreecommitdiff
path: root/tests/Language/GraphQL/AST
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Language/GraphQL/AST')
-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
4 files changed, 326 insertions, 343 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\
+ \}"
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:52:12 +0000