Replace gql in Encoder tests with multiline string
All checks were successful
Build / audit (push) Successful in 17s
Build / test (push) Successful in 6m16s
Build / doc (push) Successful in 5m16s

This commit is contained in:
Eugen Wissner 2024-10-14 20:50:34 +02:00
parent ba07f8298b
commit b056b4256f
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 117 additions and 160 deletions

View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.EncoderSpec module Language.GraphQL.AST.EncoderSpec
( spec ( spec
) where ) where
@ -7,7 +6,6 @@ module Language.GraphQL.AST.EncoderSpec
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.AST.Encoder import Language.GraphQL.AST.Encoder
import Language.GraphQL.TH
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain) import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain)
import Test.QuickCheck (choose, oneof, forAll) import Test.QuickCheck (choose, oneof, forAll)
import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Text.Lazy as Text.Lazy
@ -50,110 +48,89 @@ spec = do
it "uses strings for short string values" $ it "uses strings for short string values" $
value pretty (Full.String "Short text") `shouldBe` "\"Short text\"" value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
it "uses block strings for text with new lines, with newline symbol" $ it "uses block strings for text with new lines, with newline symbol" $
let expected = [gql| let expected = "\"\"\"\n\
""" \ Line 1\n\
Line 1 \ Line 2\n\
Line 2 \\"\"\""
"""
|]
actual = value pretty $ Full.String "Line 1\nLine 2" actual = value pretty $ Full.String "Line 1\nLine 2"
in actual `shouldBe` expected in actual `shouldBe` expected
it "uses block strings for text with new lines, with CR symbol" $ it "uses block strings for text with new lines, with CR symbol" $
let expected = [gql| let expected = "\"\"\"\n\
""" \ Line 1\n\
Line 1 \ Line 2\n\
Line 2 \\"\"\""
"""
|]
actual = value pretty $ Full.String "Line 1\rLine 2" actual = value pretty $ Full.String "Line 1\rLine 2"
in actual `shouldBe` expected in actual `shouldBe` expected
it "uses block strings for text with new lines, with CR symbol followed by newline" $ it "uses block strings for text with new lines, with CR symbol followed by newline" $
let expected = [gql| let expected = "\"\"\"\n\
""" \ Line 1\n\
Line 1 \ Line 2\n\
Line 2 \\"\"\""
"""
|]
actual = value pretty $ Full.String "Line 1\r\nLine 2" actual = value pretty $ Full.String "Line 1\r\nLine 2"
in actual `shouldBe` expected in actual `shouldBe` expected
it "encodes as one line string if has escaped symbols" $ do it "encodes as one line string if has escaped symbols" $ do
let let genNotAllowedSymbol = oneof
genNotAllowedSymbol = oneof [ choose ('\x0000', '\x0008')
[ choose ('\x0000', '\x0008') , choose ('\x000B', '\x000C')
, choose ('\x000B', '\x000C') , choose ('\x000E', '\x001F')
, choose ('\x000E', '\x001F') , pure '\x007F'
, pure '\x007F' ]
]
forAll genNotAllowedSymbol $ \x -> do forAll genNotAllowedSymbol $ \x -> do
let let rawValue = "Short \n" <> Text.Lazy.cons x "text"
rawValue = "Short \n" <> Text.Lazy.cons x "text" encoded = Text.Lazy.unpack
encoded = value pretty $ value pretty
$ Full.String $ Text.Lazy.toStrict rawValue $ Full.String
shouldStartWith (Text.Lazy.unpack encoded) "\"" $ Text.Lazy.toStrict rawValue
shouldEndWith (Text.Lazy.unpack encoded) "\"" shouldStartWith encoded "\""
shouldNotContain (Text.Lazy.unpack encoded) "\"\"\"" shouldEndWith encoded "\""
shouldNotContain encoded "\"\"\""
it "Hello world" $ it "Hello world" $
let actual = value pretty let actual = value pretty
$ Full.String "Hello,\n World!\n\nYours,\n GraphQL." $ Full.String "Hello,\n World!\n\nYours,\n GraphQL."
expected = [gql| expected = "\"\"\"\n\
""" \ Hello,\n\
Hello, \ World!\n\
World! \\n\
\ Yours,\n\
Yours, \ GraphQL.\n\
GraphQL. \\"\"\""
"""
|]
in actual `shouldBe` expected in actual `shouldBe` expected
it "has only newlines" $ it "has only newlines" $
let actual = value pretty $ Full.String "\n" let actual = value pretty $ Full.String "\n"
expected = [gql| expected = "\"\"\"\n\n\n\"\"\""
"""
"""
|]
in actual `shouldBe` expected in actual `shouldBe` expected
it "has newlines and one symbol at the begining" $ it "has newlines and one symbol at the begining" $
let actual = value pretty $ Full.String "a\n\n" let actual = value pretty $ Full.String "a\n\n"
expected = [gql| expected = "\"\"\"\n\
""" \ a\n\
a \\n\
\\n\
\\"\"\""
"""|]
in actual `shouldBe` expected in actual `shouldBe` expected
it "has newlines and one symbol at the end" $ it "has newlines and one symbol at the end" $
let actual = value pretty $ Full.String "\n\na" let actual = value pretty $ Full.String "\n\na"
expected = [gql| expected = "\"\"\"\n\
""" \\n\
\\n\
\ a\n\
a \\"\"\""
"""
|]
in actual `shouldBe` expected in actual `shouldBe` expected
it "has newlines and one symbol in the middle" $ it "has newlines and one symbol in the middle" $
let actual = value pretty $ Full.String "\na\n" let actual = value pretty $ Full.String "\na\n"
expected = [gql| expected = "\"\"\"\n\
""" \\n\
\ a\n\
a \\n\
\\"\"\""
"""
|]
in actual `shouldBe` expected in actual `shouldBe` expected
it "skip trailing whitespaces" $ it "skip trailing whitespaces" $
let actual = value pretty $ Full.String " Short\ntext " let actual = value pretty $ Full.String " Short\ntext "
expected = [gql| expected = "\"\"\"\n\
""" \ Short\n\
Short \ text\n\
text \\"\"\""
"""
|]
in actual `shouldBe` expected in actual `shouldBe` expected
describe "definition" $ describe "definition" $
@ -165,14 +142,12 @@ spec = do
fieldSelection = pure $ Full.FieldSelection field fieldSelection = pure $ Full.FieldSelection field
operation = Full.DefinitionOperation operation = Full.DefinitionOperation
$ Full.SelectionSet fieldSelection location $ Full.SelectionSet fieldSelection location
expected = Text.Lazy.snoc [gql| expected = "{\n\
{ \ field(message: \"\"\"\n\
field(message: """ \ line1\n\
line1 \ line2\n\
line2 \ \"\"\")\n\
""") \}\n"
}
|] '\n'
actual = definition pretty operation actual = definition pretty operation
in actual `shouldBe` expected in actual `shouldBe` expected
@ -187,12 +162,10 @@ spec = do
mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType" mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType"
operations = queryType :| pure mutationType operations = queryType :| pure mutationType
definition' = Full.SchemaDefinition [] operations definition' = Full.SchemaDefinition [] operations
expected = Text.Lazy.snoc [gql| expected = "schema {\n\
schema { \ query: QueryRootType\n\
query: QueryRootType \ mutation: MutationType\n\
mutation: MutationType \}\n"
}
|] '\n'
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected
@ -211,11 +184,9 @@ spec = do
$ Full.InterfaceTypeDefinition mempty "UUID" mempty $ Full.InterfaceTypeDefinition mempty "UUID" mempty
$ pure $ pure
$ Full.FieldDefinition mempty "value" arguments someType mempty $ Full.FieldDefinition mempty "value" arguments someType mempty
expected = [gql| expected = "interface UUID {\n\
interface UUID { \ value(arg: String): String\n\
value(arg: String): String \}"
}
|]
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected
@ -223,11 +194,9 @@ spec = do
let definition' = Full.TypeDefinition let definition' = Full.TypeDefinition
$ Full.UnionTypeDefinition mempty "SearchResult" mempty $ Full.UnionTypeDefinition mempty "SearchResult" mempty
$ Full.UnionMemberTypes ["Photo", "Person"] $ Full.UnionMemberTypes ["Photo", "Person"]
expected = [gql| expected = "union SearchResult =\n\
union SearchResult = \ | Photo\n\
| Photo \ | Person"
| Person
|]
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected
@ -240,14 +209,12 @@ spec = do
] ]
definition' = Full.TypeDefinition definition' = Full.TypeDefinition
$ Full.EnumTypeDefinition mempty "Direction" mempty values $ Full.EnumTypeDefinition mempty "Direction" mempty values
expected = [gql| expected = "enum Direction {\n\
enum Direction { \ NORTH\n\
NORTH \ EAST\n\
EAST \ SOUTH\n\
SOUTH \ WEST\n\
WEST \}"
}
|]
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected
@ -260,12 +227,10 @@ spec = do
] ]
definition' = Full.TypeDefinition definition' = Full.TypeDefinition
$ Full.InputObjectTypeDefinition mempty "ExampleInputObject" mempty fields $ Full.InputObjectTypeDefinition mempty "ExampleInputObject" mempty fields
expected = [gql| expected = "input ExampleInputObject {\n\
input ExampleInputObject { \ a: String\n\
a: String \ b: Int!\n\
b: Int! \}"
}
|]
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected
@ -274,10 +239,8 @@ spec = do
let definition' = Full.DirectiveDefinition mempty "example" mempty False let definition' = Full.DirectiveDefinition mempty "example" mempty False
$ pure $ pure
$ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
expected = [gql| expected = "@example() on\n\
@example() on \ | FIELD"
| FIELD
|]
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected
@ -285,9 +248,7 @@ spec = do
let definition' = Full.DirectiveDefinition mempty "example" mempty True let definition' = Full.DirectiveDefinition mempty "example" mempty True
$ pure $ pure
$ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
expected = [gql| expected = "@example() repeatable on\n\
@example() repeatable on \ | FIELD"
| FIELD
|]
actual = typeSystemDefinition pretty definition' actual = typeSystemDefinition pretty definition'
in actual `shouldBe` expected in actual `shouldBe` expected

View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.AST.LexerSpec module Language.GraphQL.AST.LexerSpec
( spec ( spec
) where ) where
@ -7,7 +6,6 @@ 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)
@ -19,38 +17,39 @@ spec = describe "Lexer" $ do
parse unicodeBOM "" `shouldSucceedOn` "\xfeff" parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
it "lexes strings" $ do it "lexes strings" $ do
parse string "" [gql|"simple"|] `shouldParse` "simple" parse string "" "\"simple\"" `shouldParse` "simple"
parse string "" [gql|" white space "|] `shouldParse` " white space " parse string "" "\" white space \"" `shouldParse` " white space "
parse string "" [gql|"quote \""|] `shouldParse` [gql|quote "|] parse string "" "\"quote \\\"\"" `shouldParse` "quote \""
parse string "" [gql|"escaped \n"|] `shouldParse` "escaped \n" parse string "" "\"escaped \\n\"" `shouldParse` "escaped \n"
parse string "" [gql|"slashes \\ \/"|] `shouldParse` [gql|slashes \ /|] parse string "" "\"slashes \\\\ \\/\"" `shouldParse` "slashes \\ /"
parse string "" [gql|"unicode \u1234\u5678\u90AB\uCDEF"|] parse string "" "\"unicode \\u1234\\u5678\\u90AB\\uCDEF\""
`shouldParse` "unicode ሴ噸邫췯" `shouldParse` "unicode ሴ噸邫췯"
it "lexes block string" $ do it "lexes block string" $ do
parse blockString "" [gql|"""simple"""|] `shouldParse` "simple" parse blockString "" "\"\"\"simple\"\"\"" `shouldParse` "simple"
parse blockString "" [gql|""" white space """|] parse blockString "" "\"\"\" white space \"\"\""
`shouldParse` " white space " `shouldParse` " white space "
parse blockString "" [gql|"""contains " quote"""|] parse blockString "" "\"\"\"contains \" quote\"\"\""
`shouldParse` [gql|contains " quote|] `shouldParse` "contains \" quote"
parse blockString "" [gql|"""contains \""" triplequote"""|] parse blockString "" "\"\"\"contains \\\"\"\" triplequote\"\"\""
`shouldParse` [gql|contains """ triplequote|] `shouldParse` "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 "" [gql|"""unescaped \n\r\b\t\f\u1234"""|] parse blockString "" "\"\"\"unescaped \\n\\r\\b\\t\\f\\u1234\"\"\""
`shouldParse` [gql|unescaped \n\r\b\t\f\u1234|] `shouldParse` "unescaped \\n\\r\\b\\t\\f\\u1234"
parse blockString "" [gql|"""slashes \\ \/"""|] parse blockString "" "\"\"\"slashes \\\\ \\/\"\"\""
`shouldParse` [gql|slashes \\ \/|] `shouldParse` "slashes \\\\ \\/"
parse blockString "" [gql|""" parse blockString "" "\"\"\"\n\
\\n\
spans \ spans\n\
multiple \ multiple\n\
lines \ lines\n\
\\n\
"""|] `shouldParse` "spans\n multiple\n lines" \\"\"\""
`shouldParse` "spans\n multiple\n lines"
it "lexes numbers" $ do it "lexes numbers" $ do
parse integer "" "4" `shouldParse` (4 :: Int) parse integer "" "4" `shouldParse` (4 :: Int)
@ -84,7 +83,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 "" [gql|""""""|] `shouldParse` "" parse blockString "" "\"\"\"\"\"\"" `shouldParse` ""
it "lexes ampersand" $ it "lexes ampersand" $
parse amp "" "&" `shouldParse` "&" parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $ it "lexes schema extensions" $

View File

@ -5,9 +5,7 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.ExecuteSpec module Language.GraphQL.ExecuteSpec
( spec ( spec
@ -23,7 +21,6 @@ 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 qualified Language.GraphQL.Type as Type import qualified Language.GraphQL.Type as Type
import Language.GraphQL.Type import Language.GraphQL.Type
@ -269,15 +266,15 @@ spec :: Spec
spec = spec =
describe "execute" $ do describe "execute" $ do
it "rejects recursive fragments" $ it "rejects recursive fragments" $
let sourceQuery = [gql| let sourceQuery = "\
{ \{\n\
...cyclicFragment \ ...cyclicFragment\n\
} \}\n\
\\n\
fragment cyclicFragment on Query { \fragment cyclicFragment on Query {\n\
...cyclicFragment \ ...cyclicFragment\n\
} \}\
|] \"
expected = Response (Object mempty) mempty expected = Response (Object mempty) mempty
in sourceQuery `shouldResolveTo` expected in sourceQuery `shouldResolveTo` expected