Parse queries with megaparsec
This commit is contained in:
103
tests/Language/GraphQL/LexerTest.hs
Normal file
103
tests/Language/GraphQL/LexerTest.hs
Normal file
@ -0,0 +1,103 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Language.GraphQL.LexerTest
|
||||
( implementation
|
||||
, reference
|
||||
) where
|
||||
|
||||
import Control.Applicative (Alternative(..))
|
||||
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
|
||||
runParser float "4.123" @?= Right 4.123
|
||||
runParser integer "-4" @?= Right (-4)
|
||||
runParser integer "9" @?= Right 9
|
||||
runParser integer "0" @?= Right 0
|
||||
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 ()) ""
|
||||
@ -1,32 +1,37 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
#endif
|
||||
|
||||
import Data.Attoparsec.Text (parseOnly)
|
||||
import qualified Data.Text.IO as Text
|
||||
import Test.Tasty (TestTree, defaultMain, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
import qualified Data.GraphQL.Parser as Parser
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.GraphQL.Encoder as Encoder
|
||||
|
||||
import qualified Test.StarWars.QueryTests as SW
|
||||
import qualified Language.GraphQL.LexerTest as LexerTest
|
||||
import qualified Data.GraphQL.Parser as Parser
|
||||
import qualified Data.Text.IO as T.IO
|
||||
import Text.Megaparsec ( errorBundlePretty
|
||||
, parse
|
||||
)
|
||||
import Test.Tasty ( TestTree
|
||||
, defaultMain
|
||||
, testGroup
|
||||
)
|
||||
import Test.Tasty.HUnit ( assertEqual
|
||||
, assertFailure
|
||||
, testCase
|
||||
)
|
||||
import Paths_graphql (getDataFileName)
|
||||
import qualified Test.StarWars.QueryTests as SW
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain . testGroup "Tests" . (: [SW.test]) =<< kitchenTest
|
||||
main = defaultMain $ testGroup "Tests"
|
||||
[ testGroup "Reference tests" [LexerTest.reference, SW.test]
|
||||
, testGroup "Implementation tests" [LexerTest.implementation]
|
||||
, kitchenTest
|
||||
]
|
||||
|
||||
kitchenTest :: IO TestTree
|
||||
kitchenTest = testCase "Kitchen Sink"
|
||||
<$> (assertEqual "Encode" <$> expected <*> actual)
|
||||
where
|
||||
expected = Text.readFile
|
||||
=<< getDataFileName "tests/data/kitchen-sink.min.graphql"
|
||||
kitchenTest :: TestTree
|
||||
kitchenTest = testCase "Kitchen Sink" $ do
|
||||
dataFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"
|
||||
expected <- T.IO.readFile dataFileName
|
||||
|
||||
actual = either (error "Parsing error!") Encoder.document
|
||||
. parseOnly Parser.document
|
||||
<$> expected
|
||||
either
|
||||
(assertFailure . errorBundlePretty)
|
||||
(assertEqual "Encode" expected . Encoder.document)
|
||||
$ parse Parser.document dataFileName expected
|
||||
|
||||
Reference in New Issue
Block a user