blob: fdd12f4094deb68cb85ddd369feaecbcc3006480 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.LexerTest
( implementation
, reference
) where
import Language.GraphQL.Lexer
import qualified Data.Text as T
import Data.Void (Void)
import Test.Tasty ( TestTree
, testGroup
)
import Test.Tasty.HUnit ( testCase
, (@?=)
)
import Text.Megaparsec ( ParseErrorBundle
, parse
)
import Text.RawString.QQ (r)
reference :: TestTree
reference = testGroup "Lexer"
[ testCase "lexes strings" $ do
runParser string [r|"simple"|] @?= Right "simple"
runParser string [r|" white space "|] @?= Right " white space "
runParser string [r|"quote \""|] @?= Right [r|quote "|]
runParser string [r|"escaped \n"|] @?= Right "escaped \n"
runParser string [r|"slashes \\ \/"|] @?= Right [r|slashes \ /|]
runParser string [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
@?= Right "unicode ሴ噸邫췯"
, testCase "lexes block string" $ do
runParser blockString [r|"""simple"""|] @?= Right "simple"
runParser blockString [r|""" white space """|]
@?= Right " white space "
runParser blockString [r|"""contains " quote"""|]
@?= Right [r|contains " quote|]
runParser blockString [r|"""contains \""" triplequote"""|]
@?= Right [r|contains """ triplequote|]
runParser blockString "\"\"\"multi\nline\"\"\"" @?= Right "multi\nline"
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
@?= Right "multi\nline\nnormalized"
runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
@?= Right "multi\nline\nnormalized"
runParser blockString [r|"""unescaped \n\r\b\t\f\u1234"""|]
@?= Right [r|unescaped \n\r\b\t\f\u1234|]
runParser blockString [r|"""slashes \\ \/"""|]
@?= Right [r|slashes \\ \/|]
runParser blockString [r|"""
spans
multiple
lines
"""|] @?= Right "spans\n multiple\n lines"
, testCase "lexes numbers" $ do
runParser integer "4" @?= Right (4 :: Int)
runParser float "4.123" @?= Right 4.123
runParser integer "-4" @?= Right (-4 :: Int)
runParser integer "9" @?= Right (9 :: Int)
runParser integer "0" @?= Right (0 :: Int)
runParser float "-4.123" @?= Right (-4.123)
runParser float "0.123" @?= Right 0.123
runParser float "123e4" @?= Right 123e4
runParser float "123E4" @?= Right 123E4
runParser float "123e-4" @?= Right 123e-4
runParser float "123e+4" @?= Right 123e+4
runParser float "-1.123e4" @?= Right (-1.123e4)
runParser float "-1.123E4" @?= Right (-1.123E4)
runParser float "-1.123e-4" @?= Right (-1.123e-4)
runParser float "-1.123e+4" @?= Right (-1.123e+4)
runParser float "-1.123e4567" @?= Right (-1.123e4567)
, testCase "lexes punctuation" $ do
runParser bang "!" @?= Right '!'
runParser dollar "$" @?= Right '$'
runBetween parens "()" @?= Right ()
runParser spread "..." @?= Right "..."
runParser colon ":" @?= Right ":"
runParser equals "=" @?= Right "="
runParser at "@" @?= Right '@'
runBetween brackets "[]" @?= Right ()
runBetween braces "{}" @?= Right ()
runParser pipe "|" @?= Right "|"
]
implementation :: TestTree
implementation = testGroup "Lexer"
[ testCase "lexes empty block strings" $
runParser blockString [r|""""""|] @?= Right ""
, testCase "lexes ampersand" $
runParser amp "&" @?= Right "&"
]
runParser :: forall a. Parser a -> T.Text -> Either (ParseErrorBundle T.Text Void) a
runParser = flip parse ""
runBetween :: (Parser () -> Parser ()) -> T.Text -> Either (ParseErrorBundle T.Text Void) ()
runBetween parser = parse (parser $ pure ()) ""
|
