graphql/tests/Language/GraphQL/AST/LexerSpec.hs

99 lines
4.5 KiB
Haskell
Raw Normal View History

2019-07-10 05:57:35 +02:00
{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.AST.LexerSpec
2019-07-10 05:57:35 +02:00
( spec
) where
2019-07-22 05:50:00 +02:00
import Data.Text (Text)
2019-07-10 05:57:35 +02:00
import Data.Void (Void)
import Language.GraphQL.AST.Lexer
2019-09-27 10:50:38 +02:00
import Test.Hspec (Spec, context, describe, it)
2020-01-25 16:37:17 +01:00
import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
2019-09-27 10:50:38 +02:00
import Text.Megaparsec (ParseErrorBundle, parse)
2019-07-10 05:57:35 +02:00
spec :: Spec
spec = describe "Lexer" $ do
context "Reference tests" $ do
2019-07-22 05:50:00 +02:00
it "accepts BOM header" $
2019-09-27 10:50:38 +02:00
parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
2019-07-22 05:50:00 +02:00
2019-07-10 05:57:35 +02:00
it "lexes strings" $ do
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\""
2019-09-27 10:50:38 +02:00
`shouldParse` "unicode ሴ噸邫췯"
2019-07-10 05:57:35 +02:00
it "lexes block string" $ do
parse blockString "" "\"\"\"simple\"\"\"" `shouldParse` "simple"
parse blockString "" "\"\"\" white space \"\"\""
2019-09-27 10:50:38 +02:00
`shouldParse` " white space "
parse blockString "" "\"\"\"contains \" quote\"\"\""
`shouldParse` "contains \" quote"
parse blockString "" "\"\"\"contains \\\"\"\" triplequote\"\"\""
`shouldParse` "contains \"\"\" triplequote"
2019-09-27 10:50:38 +02:00
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 "" "\"\"\"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"
2019-07-10 05:57:35 +02:00
it "lexes numbers" $ do
2019-09-27 10:50:38 +02:00
parse integer "" "4" `shouldParse` (4 :: Int)
parse float "" "4.123" `shouldParse` 4.123
parse integer "" "-4" `shouldParse` (-4 :: Int)
parse integer "" "9" `shouldParse` (9 :: Int)
parse integer "" "0" `shouldParse` (0 :: Int)
parse float "" "-4.123" `shouldParse` (-4.123)
parse float "" "0.123" `shouldParse` 0.123
parse float "" "123e4" `shouldParse` 123e4
parse float "" "123E4" `shouldParse` 123E4
parse float "" "123e-4" `shouldParse` 123e-4
parse float "" "123e+4" `shouldParse` 123e+4
parse float "" "-1.123e4" `shouldParse` (-1.123e4)
parse float "" "-1.123E4" `shouldParse` (-1.123E4)
parse float "" "-1.123e-4" `shouldParse` (-1.123e-4)
parse float "" "-1.123e+4" `shouldParse` (-1.123e+4)
parse float "" "-1.123e4567" `shouldParse` (-1.123e4567)
2019-07-10 05:57:35 +02:00
it "lexes punctuation" $ do
parse bang "" "!" `shouldParse` "!"
parse dollar "" "$" `shouldParse` "$"
2019-09-27 10:50:38 +02:00
runBetween parens `shouldSucceedOn` "()"
parse spread "" "..." `shouldParse` "..."
parse colon "" `shouldSucceedOn` ":"
2019-09-27 10:50:38 +02:00
parse equals "" "=" `shouldParse` "="
parse at "" `shouldSucceedOn` "@"
2019-09-27 10:50:38 +02:00
runBetween brackets `shouldSucceedOn` "[]"
runBetween braces `shouldSucceedOn` "{}"
parse pipe "" "|" `shouldParse` "|"
2019-07-10 05:57:35 +02:00
context "Implementation tests" $ do
it "lexes empty block strings" $
parse blockString "" "\"\"\"\"\"\"" `shouldParse` ""
2019-07-10 05:57:35 +02:00
it "lexes ampersand" $
2019-09-27 10:50:38 +02:00
parse amp "" "&" `shouldParse` "&"
it "lexes schema extensions" $
2020-01-28 11:08:28 +01:00
parseExtend "schema" `shouldSucceedOn` "extend schema"
2020-01-25 16:37:17 +01:00
it "fails if the given token doesn't match" $
2020-01-28 11:08:28 +01:00
parseExtend "schema" `shouldFailOn` "extend shema"
parseExtend :: Text -> (Text -> Either (ParseErrorBundle Text Void) ())
parseExtend extension = parse (extend extension "" $ pure $ pure ()) ""
2019-07-10 05:57:35 +02:00
2019-07-22 05:50:00 +02:00
runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
2019-07-10 05:57:35 +02:00
runBetween parser = parse (parser $ pure ()) ""