OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Don't append a trailing newline in gql

Browse Source
This commit is contained in:
Eugen Wissner 2021-09-22 08:50:20 +02:00
parent a3f18932bd
commit eedab9e742
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 114 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Language/GraphQL/TH.hs
View File

@ -11,18 +11,21 @@ import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Language.Haskell.TH (Exp(..), Lit(..)) import Language.Haskell.TH (Exp(..), Lit(..))
stripIndentation :: String -> String stripIndentation :: String -> String
stripIndentation code = unlines stripIndentation code = reverse
$ reverse $ dropNewlines
$ dropWhile null
$ reverse $ reverse
$ unlines
$ indent spaces <$> lines withoutLeadingNewlines $ indent spaces <$> lines withoutLeadingNewlines
where where
indent 0 xs = xs indent 0 xs = xs
indent count (' ' : xs) = indent (count - 1) xs indent count (' ' : xs) = indent (count - 1) xs
indent _ xs = xs indent _ xs = xs
withoutLeadingNewlines = dropWhile (== '\n') code withoutLeadingNewlines = dropNewlines code
dropNewlines = dropWhile (== '\n')
spaces = length $ takeWhile (== ' ') withoutLeadingNewlines spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
-- | Removes leading and trailing newlines. Indentation of the first line is
-- removed from each line of the string.
gql :: QuasiQuoter gql :: QuasiQuoter
gql = QuasiQuoter gql = QuasiQuoter
{ quoteExp = pure . LitE . StringL . stripIndentation { quoteExp = pure . LitE . StringL . stripIndentation

38
tests/Language/GraphQL/AST/LexerSpec.hs
View File

@ -7,10 +7,10 @@ module Language.GraphQL.AST.LexerSpec
import Data.Text (Text) import Data.Text (Text)
import Data.Void (Void) import Data.Void (Void)
import Language.GraphQL.AST.Lexer import Language.GraphQL.AST.Lexer
import Language.GraphQL.TH
import Test.Hspec (Spec, context, describe, it) import Test.Hspec (Spec, context, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn) import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
import Text.Megaparsec (ParseErrorBundle, parse) import Text.Megaparsec (ParseErrorBundle, parse)
import Text.RawString.QQ (r)
spec :: Spec spec :: Spec
spec = describe "Lexer" $ do spec = describe "Lexer" $ do
@ -19,32 +19,32 @@ spec = describe "Lexer" $ do
parse unicodeBOM "" `shouldSucceedOn` "\xfeff" parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
it "lexes strings" $ do it "lexes strings" $ do
parse string "" [r|"simple"|] `shouldParse` "simple" parse string "" [gql|"simple"|] `shouldParse` "simple"
parse string "" [r|" white space "|] `shouldParse` " white space " parse string "" [gql|" white space "|] `shouldParse` " white space "
parse string "" [r|"quote \""|] `shouldParse` [r|quote "|] parse string "" [gql|"quote \""|] `shouldParse` [gql|quote "|]
parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n" parse string "" [gql|"escaped \n"|] `shouldParse` "escaped \n"
parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|] parse string "" [gql|"slashes \\ \/"|] `shouldParse` [gql|slashes \ /|]
parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|] parse string "" [gql|"unicode \u1234\u5678\u90AB\uCDEF"|]
`shouldParse` "unicode ሴ噸邫췯" `shouldParse` "unicode ሴ噸邫췯"
it "lexes block string" $ do it "lexes block string" $ do
parse blockString "" [r|"""simple"""|] `shouldParse` "simple" parse blockString "" [gql|"""simple"""|] `shouldParse` "simple"
parse blockString "" [r|""" white space """|] parse blockString "" [gql|""" white space """|]
`shouldParse` " white space " `shouldParse` " white space "
parse blockString "" [r|"""contains " quote"""|] parse blockString "" [gql|"""contains " quote"""|]
`shouldParse` [r|contains " quote|] `shouldParse` [gql|contains " quote|]
parse blockString "" [r|"""contains \""" triplequote"""|] parse blockString "" [gql|"""contains \""" triplequote"""|]
`shouldParse` [r|contains """ triplequote|] `shouldParse` [gql|contains """ triplequote|]
parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline" parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline"
parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\"" parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldParse` "multi\nline\nnormalized" `shouldParse` "multi\nline\nnormalized"
parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\"" parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
`shouldParse` "multi\nline\nnormalized" `shouldParse` "multi\nline\nnormalized"
parse blockString "" [r|"""unescaped \n\r\b\t\f\u1234"""|] parse blockString "" [gql|"""unescaped \n\r\b\t\f\u1234"""|]
`shouldParse` [r|unescaped \n\r\b\t\f\u1234|] `shouldParse` [gql|unescaped \n\r\b\t\f\u1234|]
parse blockString "" [r|"""slashes \\ \/"""|] parse blockString "" [gql|"""slashes \\ \/"""|]
`shouldParse` [r|slashes \\ \/|] `shouldParse` [gql|slashes \\ \/|]
parse blockString "" [r|""" parse blockString "" [gql|"""
spans spans
multiple multiple
@ -84,7 +84,7 @@ spec = describe "Lexer" $ do
context "Implementation tests" $ do context "Implementation tests" $ do
it "lexes empty block strings" $ it "lexes empty block strings" $
parse blockString "" [r|""""""|] `shouldParse` "" parse blockString "" [gql|""""""|] `shouldParse` ""
it "lexes ampersand" $ it "lexes ampersand" $
parse amp "" "&" `shouldParse` "&" parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $ it "lexes schema extensions" $

4
tests/Language/GraphQL/ExecuteSpec.hs
View File

@ -21,6 +21,7 @@ import Language.GraphQL.AST (Document, Location(..), Name)
import Language.GraphQL.AST.Parser (document) import Language.GraphQL.AST.Parser (document)
import Language.GraphQL.Error import Language.GraphQL.Error
import Language.GraphQL.Execute (execute) import Language.GraphQL.Execute (execute)
import Language.GraphQL.TH
import qualified Language.GraphQL.Type.Schema as Schema import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Type import Language.GraphQL.Type
import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.In as In
@ -28,7 +29,6 @@ import qualified Language.GraphQL.Type.Out as Out
import Prelude hiding (id) import Prelude hiding (id)
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse) import Text.Megaparsec (parse)
import Text.RawString.QQ (r)
data PhilosopherException = PhilosopherException data PhilosopherException = PhilosopherException
deriving Show deriving Show
@ -200,7 +200,7 @@ spec :: Spec
spec = spec =
describe "execute" $ do describe "execute" $ do
it "rejects recursive fragments" $ it "rejects recursive fragments" $
let sourceQuery = [r| let sourceQuery = [gql|
{ {
...cyclicFragment ...cyclicFragment
} }

172
tests/Language/GraphQL/Validate/RulesSpec.hs
View File

@ -13,13 +13,13 @@ import Data.Foldable (toList)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text) import Data.Text (Text)
import qualified Language.GraphQL.AST as AST import qualified Language.GraphQL.AST as AST
import Language.GraphQL.TH
import Language.GraphQL.Type import Language.GraphQL.Type
import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Validate import Language.GraphQL.Validate
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain) import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain)
import Text.Megaparsec (parse, errorBundlePretty) import Text.Megaparsec (parse, errorBundlePretty)
import Text.RawString.QQ (r)
petSchema :: Schema IO petSchema :: Schema IO
petSchema = schema queryType Nothing (Just subscriptionType) mempty petSchema = schema queryType Nothing (Just subscriptionType) mempty
@ -163,7 +163,7 @@ spec =
describe "document" $ do describe "document" $ do
context "executableDefinitionsRule" $ context "executableDefinitionsRule" $
it "rejects type definitions" $ it "rejects type definitions" $
let queryString = [r| let queryString = [gql|
query getDogName { query getDogName {
dog { dog {
name name
@ -179,13 +179,13 @@ spec =
{ message = { message =
"Definition must be OperationDefinition or \ "Definition must be OperationDefinition or \
\FragmentDefinition." \FragmentDefinition."
, locations = [AST.Location 9 19] , locations = [AST.Location 8 1]
} }
in validate queryString `shouldContain` [expected] in validate queryString `shouldContain` [expected]
context "singleFieldSubscriptionsRule" $ do context "singleFieldSubscriptionsRule" $ do
it "rejects multiple subscription root fields" $ it "rejects multiple subscription root fields" $
let queryString = [r| let queryString = [gql|
subscription sub { subscription sub {
newMessage { newMessage {
body body
@ -198,12 +198,12 @@ spec =
{ message = { message =
"Subscription \"sub\" must select only one top \ "Subscription \"sub\" must select only one top \
\level field." \level field."
, locations = [AST.Location 2 19] , locations = [AST.Location 1 1]
} }
in validate queryString `shouldContain` [expected] in validate queryString `shouldContain` [expected]
it "rejects multiple subscription root fields coming from a fragment" $ it "rejects multiple subscription root fields coming from a fragment" $
let queryString = [r| let queryString = [gql|
subscription sub { subscription sub {
...multipleSubscriptions ...multipleSubscriptions
} }
@ -220,12 +220,12 @@ spec =
{ message = { message =
"Subscription \"sub\" must select only one top \ "Subscription \"sub\" must select only one top \
\level field." \level field."
, locations = [AST.Location 2 19] , locations = [AST.Location 1 1]
} }
in validate queryString `shouldContain` [expected] in validate queryString `shouldContain` [expected]
it "finds corresponding subscription fragment" $ it "finds corresponding subscription fragment" $
let queryString = [r| let queryString = [gql|
subscription sub { subscription sub {
...anotherSubscription ...anotherSubscription
...multipleSubscriptions ...multipleSubscriptions
@ -249,13 +249,13 @@ spec =
{ message = { message =
"Subscription \"sub\" must select only one top \ "Subscription \"sub\" must select only one top \
\level field." \level field."
, locations = [AST.Location 2 19] , locations = [AST.Location 1 1]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "loneAnonymousOperationRule" $ context "loneAnonymousOperationRule" $
it "rejects multiple anonymous operations" $ it "rejects multiple anonymous operations" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
name name
@ -274,13 +274,13 @@ spec =
{ message = { message =
"This anonymous operation must be the only defined \ "This anonymous operation must be the only defined \
\operation." \operation."
, locations = [AST.Location 2 19] , locations = [AST.Location 1 1]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "uniqueOperationNamesRule" $ context "uniqueOperationNamesRule" $
it "rejects operations with the same name" $ it "rejects operations with the same name" $
let queryString = [r| let queryString = [gql|
query dogOperation { query dogOperation {
dog { dog {
name name
@ -297,13 +297,13 @@ spec =
{ message = { message =
"There can be only one operation named \ "There can be only one operation named \
\\"dogOperation\"." \\"dogOperation\"."
, locations = [AST.Location 2 19, AST.Location 8 19] , locations = [AST.Location 1 1, AST.Location 7 1]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "uniqueFragmentNamesRule" $ context "uniqueFragmentNamesRule" $
it "rejects fragments with the same name" $ it "rejects fragments with the same name" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
...fragmentOne ...fragmentOne
@ -324,13 +324,13 @@ spec =
{ message = { message =
"There can be only one fragment named \ "There can be only one fragment named \
\\"fragmentOne\"." \\"fragmentOne\"."
, locations = [AST.Location 8 19, AST.Location 12 19] , locations = [AST.Location 7 1, AST.Location 11 1]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "fragmentSpreadTargetDefinedRule" $ context "fragmentSpreadTargetDefinedRule" $
it "rejects the fragment spread without a target" $ it "rejects the fragment spread without a target" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
...undefinedFragment ...undefinedFragment
@ -341,13 +341,13 @@ spec =
{ message = { message =
"Fragment target \"undefinedFragment\" is \ "Fragment target \"undefinedFragment\" is \
\undefined." \undefined."
, locations = [AST.Location 4 23] , locations = [AST.Location 3 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "fragmentSpreadTypeExistenceRule" $ do context "fragmentSpreadTypeExistenceRule" $ do
it "rejects fragment spreads without an unknown target type" $ it "rejects fragment spreads without an unknown target type" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
...notOnExistingType ...notOnExistingType
@ -362,12 +362,12 @@ spec =
"Fragment \"notOnExistingType\" is specified on \ "Fragment \"notOnExistingType\" is specified on \
\type \"NotInSchema\" which doesn't exist in the \ \type \"NotInSchema\" which doesn't exist in the \
\schema." \schema."
, locations = [AST.Location 4 23] , locations = [AST.Location 3 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "rejects inline fragments without a target" $ it "rejects inline fragments without a target" $
let queryString = [r| let queryString = [gql|
{ {
... on NotInSchema { ... on NotInSchema {
name name
@ -378,13 +378,13 @@ spec =
{ message = { message =
"Inline fragment is specified on type \ "Inline fragment is specified on type \
\\"NotInSchema\" which doesn't exist in the schema." \\"NotInSchema\" which doesn't exist in the schema."
, locations = [AST.Location 3 21] , locations = [AST.Location 2 3]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "fragmentsOnCompositeTypesRule" $ do context "fragmentsOnCompositeTypesRule" $ do
it "rejects fragments on scalar types" $ it "rejects fragments on scalar types" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
...fragOnScalar ...fragOnScalar
@ -398,12 +398,12 @@ spec =
{ message = { message =
"Fragment cannot condition on non composite type \ "Fragment cannot condition on non composite type \
\\"Int\"." \\"Int\"."
, locations = [AST.Location 7 19] , locations = [AST.Location 6 1]
} }
in validate queryString `shouldContain` [expected] in validate queryString `shouldContain` [expected]
it "rejects inline fragments on scalar types" $ it "rejects inline fragments on scalar types" $
let queryString = [r| let queryString = [gql|
{ {
... on Boolean { ... on Boolean {
name name
@ -414,13 +414,13 @@ spec =
{ message = { message =
"Fragment cannot condition on non composite type \ "Fragment cannot condition on non composite type \
\\"Boolean\"." \\"Boolean\"."
, locations = [AST.Location 3 21] , locations = [AST.Location 2 3]
} }
in validate queryString `shouldContain` [expected] in validate queryString `shouldContain` [expected]
context "noUnusedFragmentsRule" $ context "noUnusedFragmentsRule" $
it "rejects unused fragments" $ it "rejects unused fragments" $
let queryString = [r| let queryString = [gql|
fragment nameFragment on Dog { # unused fragment nameFragment on Dog { # unused
name name
} }
@ -434,13 +434,13 @@ spec =
expected = Error expected = Error
{ message = { message =
"Fragment \"nameFragment\" is never used." "Fragment \"nameFragment\" is never used."
, locations = [AST.Location 2 19] , locations = [AST.Location 1 1]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "noFragmentCyclesRule" $ context "noFragmentCyclesRule" $
it "rejects spreads that form cycles" $ it "rejects spreads that form cycles" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
...nameFragment ...nameFragment
@ -460,20 +460,20 @@ spec =
"Cannot spread fragment \"barkVolumeFragment\" \ "Cannot spread fragment \"barkVolumeFragment\" \
\within itself (via barkVolumeFragment -> \ \within itself (via barkVolumeFragment -> \
\nameFragment -> barkVolumeFragment)." \nameFragment -> barkVolumeFragment)."
, locations = [AST.Location 11 19] , locations = [AST.Location 10 1]
} }
error2 = Error error2 = Error
{ message = { message =
"Cannot spread fragment \"nameFragment\" within \ "Cannot spread fragment \"nameFragment\" within \
\itself (via nameFragment -> barkVolumeFragment -> \ \itself (via nameFragment -> barkVolumeFragment -> \
\nameFragment)." \nameFragment)."
, locations = [AST.Location 7 19] , locations = [AST.Location 6 1]
} }
in validate queryString `shouldBe` [error1, error2] in validate queryString `shouldBe` [error1, error2]
context "uniqueArgumentNamesRule" $ context "uniqueArgumentNamesRule" $
it "rejects duplicate field arguments" $ it "rejects duplicate field arguments" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
isHousetrained(atOtherHomes: true, atOtherHomes: true) isHousetrained(atOtherHomes: true, atOtherHomes: true)
@ -484,13 +484,13 @@ spec =
{ message = { message =
"There can be only one argument named \ "There can be only one argument named \
\\"atOtherHomes\"." \\"atOtherHomes\"."
, locations = [AST.Location 4 38, AST.Location 4 58] , locations = [AST.Location 3 20, AST.Location 3 40]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "uniqueDirectiveNamesRule" $ context "uniqueDirectiveNamesRule" $
it "rejects more than one directive per location" $ it "rejects more than one directive per location" $
let queryString = [r| let queryString = [gql|
query ($foo: Boolean = true, $bar: Boolean = false) { query ($foo: Boolean = true, $bar: Boolean = false) {
dog @skip(if: $foo) @skip(if: $bar) { dog @skip(if: $foo) @skip(if: $bar) {
name name
@ -500,13 +500,13 @@ spec =
expected = Error expected = Error
{ message = { message =
"There can be only one directive named \"skip\"." "There can be only one directive named \"skip\"."
, locations = [AST.Location 3 25, AST.Location 3 41] , locations = [AST.Location 2 7, AST.Location 2 23]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "uniqueVariableNamesRule" $ context "uniqueVariableNamesRule" $
it "rejects duplicate variables" $ it "rejects duplicate variables" $
let queryString = [r| let queryString = [gql|
query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) { query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) {
dog { dog {
isHousetrained(atOtherHomes: $atOtherHomes) isHousetrained(atOtherHomes: $atOtherHomes)
@ -517,13 +517,13 @@ spec =
{ message = { message =
"There can be only one variable named \ "There can be only one variable named \
\\"atOtherHomes\"." \\"atOtherHomes\"."
, locations = [AST.Location 2 43, AST.Location 2 67] , locations = [AST.Location 1 25, AST.Location 1 49]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "variablesAreInputTypesRule" $ context "variablesAreInputTypesRule" $
it "rejects non-input types as variables" $ it "rejects non-input types as variables" $
let queryString = [r| let queryString = [gql|
query takesDogBang($dog: Dog!) { query takesDogBang($dog: Dog!) {
dog { dog {
isHousetrained(atOtherHomes: $dog) isHousetrained(atOtherHomes: $dog)
@ -534,13 +534,13 @@ spec =
{ message = { message =
"Variable \"$dog\" cannot be non-input type \ "Variable \"$dog\" cannot be non-input type \
\\"Dog\"." \\"Dog\"."
, locations = [AST.Location 2 38] , locations = [AST.Location 1 20]
} }
in validate queryString `shouldContain` [expected] in validate queryString `shouldContain` [expected]
context "noUndefinedVariablesRule" $ context "noUndefinedVariablesRule" $
it "rejects undefined variables" $ it "rejects undefined variables" $
let queryString = [r| let queryString = [gql|
query variableIsNotDefinedUsedInSingleFragment { query variableIsNotDefinedUsedInSingleFragment {
dog { dog {
...isHousetrainedFragment ...isHousetrainedFragment
@ -556,13 +556,13 @@ spec =
"Variable \"$atOtherHomes\" is not defined by \ "Variable \"$atOtherHomes\" is not defined by \
\operation \ \operation \
\\"variableIsNotDefinedUsedInSingleFragment\"." \\"variableIsNotDefinedUsedInSingleFragment\"."
, locations = [AST.Location 9 50] , locations = [AST.Location 8 32]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "noUnusedVariablesRule" $ context "noUnusedVariablesRule" $
it "rejects unused variables" $ it "rejects unused variables" $
let queryString = [r| let queryString = [gql|
query variableUnused($atOtherHomes: Boolean) { query variableUnused($atOtherHomes: Boolean) {
dog { dog {
isHousetrained isHousetrained
@ -573,13 +573,13 @@ spec =
{ message = { message =
"Variable \"$atOtherHomes\" is never used in \ "Variable \"$atOtherHomes\" is never used in \
\operation \"variableUnused\"." \operation \"variableUnused\"."
, locations = [AST.Location 2 40] , locations = [AST.Location 1 22]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "uniqueInputFieldNamesRule" $ context "uniqueInputFieldNamesRule" $
it "rejects duplicate fields in input objects" $ it "rejects duplicate fields in input objects" $
let queryString = [r| let queryString = [gql|
{ {
findDog(complex: { name: "Fido", name: "Jack" }) { findDog(complex: { name: "Fido", name: "Jack" }) {
name name
@ -589,13 +589,13 @@ spec =
expected = Error expected = Error
{ message = { message =
"There can be only one input field named \"name\"." "There can be only one input field named \"name\"."
, locations = [AST.Location 3 40, AST.Location 3 54] , locations = [AST.Location 2 22, AST.Location 2 36]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "fieldsOnCorrectTypeRule" $ context "fieldsOnCorrectTypeRule" $
it "rejects undefined fields" $ it "rejects undefined fields" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
meowVolume meowVolume
@ -605,13 +605,13 @@ spec =
expected = Error expected = Error
{ message = { message =
"Cannot query field \"meowVolume\" on type \"Dog\"." "Cannot query field \"meowVolume\" on type \"Dog\"."
, locations = [AST.Location 4 23] , locations = [AST.Location 3 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "scalarLeafsRule" $ context "scalarLeafsRule" $
it "rejects scalar fields with not empty selection set" $ it "rejects scalar fields with not empty selection set" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
barkVolume { barkVolume {
@ -624,13 +624,13 @@ spec =
{ message = { message =
"Field \"barkVolume\" must not have a selection \ "Field \"barkVolume\" must not have a selection \
\since type \"Int\" has no subfields." \since type \"Int\" has no subfields."
, locations = [AST.Location 4 23] , locations = [AST.Location 3 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "knownArgumentNamesRule" $ do context "knownArgumentNamesRule" $ do
it "rejects field arguments missing in the type" $ it "rejects field arguments missing in the type" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
doesKnowCommand(command: CLEAN_UP_HOUSE, dogCommand: SIT) doesKnowCommand(command: CLEAN_UP_HOUSE, dogCommand: SIT)
@ -641,12 +641,12 @@ spec =
{ message = { message =
"Unknown argument \"command\" on field \ "Unknown argument \"command\" on field \
\\"Dog.doesKnowCommand\"." \\"Dog.doesKnowCommand\"."
, locations = [AST.Location 4 39] , locations = [AST.Location 3 21]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "rejects directive arguments missing in the definition" $ it "rejects directive arguments missing in the definition" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
isHousetrained(atOtherHomes: true) @include(unless: false, if: true) isHousetrained(atOtherHomes: true) @include(unless: false, if: true)
@ -657,13 +657,13 @@ spec =
{ message = { message =
"Unknown argument \"unless\" on directive \ "Unknown argument \"unless\" on directive \
\\"@include\"." \\"@include\"."
, locations = [AST.Location 4 67] , locations = [AST.Location 3 49]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "knownDirectiveNamesRule" $ context "knownDirectiveNamesRule" $
it "rejects undefined directives" $ it "rejects undefined directives" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
isHousetrained(atOtherHomes: true) @ignore(if: true) isHousetrained(atOtherHomes: true) @ignore(if: true)
@ -672,13 +672,13 @@ spec =
|] |]
expected = Error expected = Error
{ message = "Unknown directive \"@ignore\"." { message = "Unknown directive \"@ignore\"."
, locations = [AST.Location 4 58] , locations = [AST.Location 3 40]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "knownInputFieldNamesRule" $ context "knownInputFieldNamesRule" $
it "rejects undefined input object fields" $ it "rejects undefined input object fields" $
let queryString = [r| let queryString = [gql|
{ {
findDog(complex: { favoriteCookieFlavor: "Bacon", name: "Jack" }) { findDog(complex: { favoriteCookieFlavor: "Bacon", name: "Jack" }) {
name name
@ -689,13 +689,13 @@ spec =
{ message = { message =
"Field \"favoriteCookieFlavor\" is not defined \ "Field \"favoriteCookieFlavor\" is not defined \
\by type \"DogData\"." \by type \"DogData\"."
, locations = [AST.Location 3 40] , locations = [AST.Location 2 22]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "directivesInValidLocationsRule" $ context "directivesInValidLocationsRule" $
it "rejects directives in invalid locations" $ it "rejects directives in invalid locations" $
let queryString = [r| let queryString = [gql|
query @skip(if: $foo) { query @skip(if: $foo) {
dog { dog {
name name
@ -705,13 +705,13 @@ spec =
expected = Error expected = Error
{ message = { message =
"Directive \"@skip\" may not be used on QUERY." "Directive \"@skip\" may not be used on QUERY."
, locations = [AST.Location 2 25] , locations = [AST.Location 1 7]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "overlappingFieldsCanBeMergedRule" $ do context "overlappingFieldsCanBeMergedRule" $ do
it "fails to merge fields of mismatching types" $ it "fails to merge fields of mismatching types" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
name: nickname name: nickname
@ -725,12 +725,12 @@ spec =
\\"name\" are different fields. Use different \ \\"name\" are different fields. Use different \
\aliases on the fields to fetch both if this was \ \aliases on the fields to fetch both if this was \
\intentional." \intentional."
, locations = [AST.Location 4 23, AST.Location 5 23] , locations = [AST.Location 3 5, AST.Location 4 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "fails if the arguments of the same field don't match" $ it "fails if the arguments of the same field don't match" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
doesKnowCommand(dogCommand: SIT) doesKnowCommand(dogCommand: SIT)
@ -744,12 +744,12 @@ spec =
\have different arguments. Use different aliases \ \have different arguments. Use different aliases \
\on the fields to fetch both if this was \ \on the fields to fetch both if this was \
\intentional." \intentional."
, locations = [AST.Location 4 23, AST.Location 5 23] , locations = [AST.Location 3 5, AST.Location 4 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "fails to merge same-named field and alias" $ it "fails to merge same-named field and alias" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
doesKnowCommand(dogCommand: SIT) doesKnowCommand(dogCommand: SIT)
@ -763,12 +763,12 @@ spec =
\\"doesKnowCommand\" and \"isHousetrained\" are \ \\"doesKnowCommand\" and \"isHousetrained\" are \
\different fields. Use different aliases on the \ \different fields. Use different aliases on the \
\fields to fetch both if this was intentional." \fields to fetch both if this was intentional."
, locations = [AST.Location 4 23, AST.Location 5 23] , locations = [AST.Location 3 5, AST.Location 4 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "looks for fields after a successfully merged field pair" $ it "looks for fields after a successfully merged field pair" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
name name
@ -786,13 +786,13 @@ spec =
\\"doesKnowCommand\" and \"isHousetrained\" are \ \\"doesKnowCommand\" and \"isHousetrained\" are \
\different fields. Use different aliases on the \ \different fields. Use different aliases on the \
\fields to fetch both if this was intentional." \fields to fetch both if this was intentional."
, locations = [AST.Location 5 23, AST.Location 9 23] , locations = [AST.Location 4 5, AST.Location 8 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "possibleFragmentSpreadsRule" $ do context "possibleFragmentSpreadsRule" $ do
it "rejects object inline spreads outside object scope" $ it "rejects object inline spreads outside object scope" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
... on Cat { ... on Cat {
@ -805,12 +805,12 @@ spec =
{ message = { message =
"Fragment cannot be spread here as objects of type \ "Fragment cannot be spread here as objects of type \
\\"Dog\" can never be of type \"Cat\"." \\"Dog\" can never be of type \"Cat\"."
, locations = [AST.Location 4 23] , locations = [AST.Location 3 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "rejects object named spreads outside object scope" $ it "rejects object named spreads outside object scope" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
... catInDogFragmentInvalid ... catInDogFragmentInvalid
@ -826,13 +826,13 @@ spec =
"Fragment \"catInDogFragmentInvalid\" cannot be \ "Fragment \"catInDogFragmentInvalid\" cannot be \
\spread here as objects of type \"Dog\" can never \ \spread here as objects of type \"Dog\" can never \
\be of type \"Cat\"." \be of type \"Cat\"."
, locations = [AST.Location 4 23] , locations = [AST.Location 3 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "providedRequiredInputFieldsRule" $ context "providedRequiredInputFieldsRule" $
it "rejects missing required input fields" $ it "rejects missing required input fields" $
let queryString = [r| let queryString = [gql|
{ {
findDog(complex: { name: null }) { findDog(complex: { name: null }) {
name name
@ -843,13 +843,13 @@ spec =
{ message = { message =
"Input field \"name\" of type \"DogData\" is \ "Input field \"name\" of type \"DogData\" is \
\required, but it was not provided." \required, but it was not provided."
, locations = [AST.Location 3 38] , locations = [AST.Location 2 20]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "providedRequiredArgumentsRule" $ do context "providedRequiredArgumentsRule" $ do
it "checks for (non-)nullable arguments" $ it "checks for (non-)nullable arguments" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
doesKnowCommand(dogCommand: null) doesKnowCommand(dogCommand: null)
@ -861,13 +861,13 @@ spec =
"Field \"doesKnowCommand\" argument \"dogCommand\" \ "Field \"doesKnowCommand\" argument \"dogCommand\" \
\of type \"DogCommand\" is required, but it was \ \of type \"DogCommand\" is required, but it was \
\not provided." \not provided."
, locations = [AST.Location 4 23] , locations = [AST.Location 3 5]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "variablesInAllowedPositionRule" $ do context "variablesInAllowedPositionRule" $ do
it "rejects wrongly typed variable arguments" $ it "rejects wrongly typed variable arguments" $
let queryString = [r| let queryString = [gql|
query dogCommandArgQuery($dogCommandArg: DogCommand) { query dogCommandArgQuery($dogCommandArg: DogCommand) {
dog { dog {
doesKnowCommand(dogCommand: $dogCommandArg) doesKnowCommand(dogCommand: $dogCommandArg)
@ -879,12 +879,12 @@ spec =
"Variable \"$dogCommandArg\" of type \ "Variable \"$dogCommandArg\" of type \
\\"DogCommand\" used in position expecting type \ \\"DogCommand\" used in position expecting type \
\\"!DogCommand\"." \\"!DogCommand\"."
, locations = [AST.Location 2 44] , locations = [AST.Location 1 26]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "rejects wrongly typed variable arguments" $ it "rejects wrongly typed variable arguments" $
let queryString = [r| let queryString = [gql|
query intCannotGoIntoBoolean($intArg: Int) { query intCannotGoIntoBoolean($intArg: Int) {
dog { dog {
isHousetrained(atOtherHomes: $intArg) isHousetrained(atOtherHomes: $intArg)
@ -895,13 +895,13 @@ spec =
{ message = { message =
"Variable \"$intArg\" of type \"Int\" used in \ "Variable \"$intArg\" of type \"Int\" used in \
\position expecting type \"Boolean\"." \position expecting type \"Boolean\"."
, locations = [AST.Location 2 48] , locations = [AST.Location 1 30]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
context "valuesOfCorrectTypeRule" $ do context "valuesOfCorrectTypeRule" $ do
it "rejects values of incorrect types" $ it "rejects values of incorrect types" $
let queryString = [r| let queryString = [gql|
{ {
dog { dog {
isHousetrained(atOtherHomes: 3) isHousetrained(atOtherHomes: 3)
@ -911,12 +911,12 @@ spec =
expected = Error expected = Error
{ message = { message =
"Value 3 cannot be coerced to type \"Boolean\"." "Value 3 cannot be coerced to type \"Boolean\"."
, locations = [AST.Location 4 52] , locations = [AST.Location 3 34]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "uses the location of a single list value" $ it "uses the location of a single list value" $
let queryString = [r| let queryString = [gql|
{ {
cat { cat {
doesKnowCommands(catCommands: [3]) doesKnowCommands(catCommands: [3])
@ -926,12 +926,12 @@ spec =
expected = Error expected = Error
{ message = { message =
"Value 3 cannot be coerced to type \"!CatCommand\"." "Value 3 cannot be coerced to type \"!CatCommand\"."
, locations = [AST.Location 4 54] , locations = [AST.Location 3 36]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "validates input object properties once" $ it "validates input object properties once" $
let queryString = [r| let queryString = [gql|
{ {
findDog(complex: { name: 3 }) { findDog(complex: { name: 3 }) {
name name
@ -941,12 +941,12 @@ spec =
expected = Error expected = Error
{ message = { message =
"Value 3 cannot be coerced to type \"!String\"." "Value 3 cannot be coerced to type \"!String\"."
, locations = [AST.Location 3 46] , locations = [AST.Location 2 28]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
it "checks for required list members" $ it "checks for required list members" $
let queryString = [r| let queryString = [gql|
{ {
cat { cat {
doesKnowCommands(catCommands: [null]) doesKnowCommands(catCommands: [null])
@ -957,6 +957,6 @@ spec =
{ message = { message =
"List of non-null values of type \"CatCommand\" \ "List of non-null values of type \"CatCommand\" \
\cannot contain null values." \cannot contain null values."
, locations = [AST.Location 4 54] , locations = [AST.Location 3 36]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]