From 5e9bf9648d891591fcb1f0e1c7b250fb80b1ddc6 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 21 Jun 2019 10:44:58 +0200 Subject: Parse queries with megaparsec --- tests/Language/GraphQL/LexerTest.hs | 103 ++++++++++++++++++++++++++++++++++++ tests/tasty.hs | 53 ++++++++++--------- 2 files changed, 132 insertions(+), 24 deletions(-) create mode 100644 tests/Language/GraphQL/LexerTest.hs (limited to 'tests') diff --git a/tests/Language/GraphQL/LexerTest.hs b/tests/Language/GraphQL/LexerTest.hs new file mode 100644 index 0000000..a8eb4a3 --- /dev/null +++ b/tests/Language/GraphQL/LexerTest.hs @@ -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 ()) "" diff --git a/tests/tasty.hs b/tests/tasty.hs index aa8da50..5d4036d 100644 --- a/tests/tasty.hs +++ b/tests/tasty.hs @@ -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 -- cgit v1.2.3