From eb98c3625866d6dbdf8d0f7943f6ebf55799bd57 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 27 Sep 2019 10:50:38 +0200 Subject: [PATCH] Introduce hspec-megaparsec Fixes #13. --- graphql.cabal | 3 +- package.yaml | 1 + tests/Language/GraphQL/LexerSpec.hs | 126 ++++++++++++--------------- tests/Language/GraphQL/ParserSpec.hs | 18 ++-- tests/Test/KitchenSinkSpec.hs | 33 +++---- 5 files changed, 80 insertions(+), 101 deletions(-) diff --git a/graphql.cabal b/graphql.cabal index 9d02aa5..f164100 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ff53309ec0180b799fcc69ff3a53a6c9411940332e75ebc8097a83d40c085d98 +-- hash: 7396988b6b8e966751eaf92b5a8c1cb820f7a3dbbf60736ea46faab4653fb40c name: graphql version: 0.5.0.1 @@ -85,6 +85,7 @@ test-suite tasty , graphql , hspec , hspec-expectations + , hspec-megaparsec , megaparsec , raw-strings-qq , text diff --git a/package.yaml b/package.yaml index eb45953..40b5d04 100644 --- a/package.yaml +++ b/package.yaml @@ -49,4 +49,5 @@ tests: - graphql - hspec - hspec-expectations + - hspec-megaparsec - raw-strings-qq diff --git a/tests/Language/GraphQL/LexerSpec.hs b/tests/Language/GraphQL/LexerSpec.hs index b5b605d..274b29a 100644 --- a/tests/Language/GraphQL/LexerSpec.hs +++ b/tests/Language/GraphQL/LexerSpec.hs @@ -1,104 +1,92 @@ -{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module Language.GraphQL.LexerSpec ( spec ) where -import Data.Either (isRight) import Data.Text (Text) import Data.Void (Void) import Language.GraphQL.Lexer -import Test.Hspec ( Spec - , context - , describe - , it - , shouldBe - , shouldSatisfy - ) -import Text.Megaparsec ( ParseErrorBundle - , parse - ) +import Test.Hspec (Spec, context, describe, it) +import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn) +import Text.Megaparsec (ParseErrorBundle, parse) import Text.RawString.QQ (r) spec :: Spec spec = describe "Lexer" $ do context "Reference tests" $ do it "accepts BOM header" $ - runParser unicodeBOM "\xfeff" `shouldSatisfy` isRight + parse unicodeBOM "" `shouldSucceedOn` "\xfeff" it "lexes strings" $ do - runParser string [r|"simple"|] `shouldBe` Right "simple" - runParser string [r|" white space "|] `shouldBe` Right " white space " - runParser string [r|"quote \""|] `shouldBe` Right [r|quote "|] - runParser string [r|"escaped \n"|] `shouldBe` Right "escaped \n" - runParser string [r|"slashes \\ \/"|] `shouldBe` Right [r|slashes \ /|] - runParser string [r|"unicode \u1234\u5678\u90AB\uCDEF"|] - `shouldBe` Right "unicode ሴ噸邫췯" + parse string "" [r|"simple"|] `shouldParse` "simple" + parse string "" [r|" white space "|] `shouldParse` " white space " + parse string "" [r|"quote \""|] `shouldParse` [r|quote "|] + parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n" + parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|] + parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|] + `shouldParse` "unicode ሴ噸邫췯" it "lexes block string" $ do - runParser blockString [r|"""simple"""|] `shouldBe` Right "simple" - runParser blockString [r|""" white space """|] - `shouldBe` Right " white space " - runParser blockString [r|"""contains " quote"""|] - `shouldBe` Right [r|contains " quote|] - runParser blockString [r|"""contains \""" triplequote"""|] - `shouldBe` Right [r|contains """ triplequote|] - runParser blockString "\"\"\"multi\nline\"\"\"" `shouldBe` Right "multi\nline" - runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\"" - `shouldBe` Right "multi\nline\nnormalized" - runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\"" - `shouldBe` Right "multi\nline\nnormalized" - runParser blockString [r|"""unescaped \n\r\b\t\f\u1234"""|] - `shouldBe` Right [r|unescaped \n\r\b\t\f\u1234|] - runParser blockString [r|"""slashes \\ \/"""|] - `shouldBe` Right [r|slashes \\ \/|] - runParser blockString [r|""" + parse blockString "" [r|"""simple"""|] `shouldParse` "simple" + parse blockString "" [r|""" white space """|] + `shouldParse` " white space " + parse blockString "" [r|"""contains " quote"""|] + `shouldParse` [r|contains " quote|] + parse blockString "" [r|"""contains \""" triplequote"""|] + `shouldParse` [r|contains """ triplequote|] + 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 "" [r|"""unescaped \n\r\b\t\f\u1234"""|] + `shouldParse` [r|unescaped \n\r\b\t\f\u1234|] + parse blockString "" [r|"""slashes \\ \/"""|] + `shouldParse` [r|slashes \\ \/|] + parse blockString "" [r|""" spans multiple lines - """|] `shouldBe` Right "spans\n multiple\n lines" + """|] `shouldParse` "spans\n multiple\n lines" it "lexes numbers" $ do - runParser integer "4" `shouldBe` Right (4 :: Int) - runParser float "4.123" `shouldBe` Right 4.123 - runParser integer "-4" `shouldBe` Right (-4 :: Int) - runParser integer "9" `shouldBe` Right (9 :: Int) - runParser integer "0" `shouldBe` Right (0 :: Int) - runParser float "-4.123" `shouldBe` Right (-4.123) - runParser float "0.123" `shouldBe` Right 0.123 - runParser float "123e4" `shouldBe` Right 123e4 - runParser float "123E4" `shouldBe` Right 123E4 - runParser float "123e-4" `shouldBe` Right 123e-4 - runParser float "123e+4" `shouldBe` Right 123e+4 - runParser float "-1.123e4" `shouldBe` Right (-1.123e4) - runParser float "-1.123E4" `shouldBe` Right (-1.123E4) - runParser float "-1.123e-4" `shouldBe` Right (-1.123e-4) - runParser float "-1.123e+4" `shouldBe` Right (-1.123e+4) - runParser float "-1.123e4567" `shouldBe` Right (-1.123e4567) + 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) it "lexes punctuation" $ do - runParser bang "!" `shouldBe` Right '!' - runParser dollar "$" `shouldBe` Right '$' - runBetween parens "()" `shouldSatisfy` isRight - runParser spread "..." `shouldBe` Right "..." - runParser colon ":" `shouldBe` Right ":" - runParser equals "=" `shouldBe` Right "=" - runParser at "@" `shouldBe` Right '@' - runBetween brackets "[]" `shouldSatisfy` isRight - runBetween braces "{}" `shouldSatisfy` isRight - runParser pipe "|" `shouldBe` Right "|" + parse bang "" "!" `shouldParse` '!' + parse dollar "" "$" `shouldParse` '$' + runBetween parens `shouldSucceedOn` "()" + parse spread "" "..." `shouldParse` "..." + parse colon "" ":" `shouldParse` ":" + parse equals "" "=" `shouldParse` "=" + parse at "" "@" `shouldParse` '@' + runBetween brackets `shouldSucceedOn` "[]" + runBetween braces `shouldSucceedOn` "{}" + parse pipe "" "|" `shouldParse` "|" context "Implementation tests" $ do it "lexes empty block strings" $ - runParser blockString [r|""""""|] `shouldBe` Right "" + parse blockString "" [r|""""""|] `shouldParse` "" it "lexes ampersand" $ - runParser amp "&" `shouldBe` Right "&" - -runParser :: forall a. Parser a -> Text -> Either (ParseErrorBundle Text Void) a -runParser = flip parse "" + parse amp "" "&" `shouldParse` "&" runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) () runBetween parser = parse (parser $ pure ()) "" diff --git a/tests/Language/GraphQL/ParserSpec.hs b/tests/Language/GraphQL/ParserSpec.hs index 6425ea5..9b71c62 100644 --- a/tests/Language/GraphQL/ParserSpec.hs +++ b/tests/Language/GraphQL/ParserSpec.hs @@ -4,27 +4,23 @@ module Language.GraphQL.ParserSpec ( spec ) where -import Data.Either (isRight) import Language.GraphQL.Parser (document) -import Test.Hspec ( Spec - , describe - , it - , shouldSatisfy - ) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.Megaparsec (shouldSucceedOn) import Text.Megaparsec (parse) import Text.RawString.QQ (r) spec :: Spec spec = describe "Parser" $ do it "accepts BOM header" $ - parse document "" "\xfeff{foo}" `shouldSatisfy` isRight + parse document "" `shouldSucceedOn` "\xfeff{foo}" it "accepts block strings as argument" $ - parse document "" [r|{ + parse document "" `shouldSucceedOn` [r|{ hello(text: """Argument""") - }|] `shouldSatisfy` isRight + }|] it "accepts strings as argument" $ - parse document "" [r|{ + parse document "" `shouldSucceedOn` [r|{ hello(text: "Argument") - }|] `shouldSatisfy` isRight + }|] diff --git a/tests/Test/KitchenSinkSpec.hs b/tests/Test/KitchenSinkSpec.hs index ae3c2c4..674f85b 100644 --- a/tests/Test/KitchenSinkSpec.hs +++ b/tests/Test/KitchenSinkSpec.hs @@ -6,19 +6,13 @@ module Test.KitchenSinkSpec import qualified Data.Text.IO as Text.IO import qualified Data.Text.Lazy.IO as Text.Lazy.IO +import qualified Data.Text.Lazy as Lazy (Text) import qualified Language.GraphQL.Encoder as Encoder import qualified Language.GraphQL.Parser as Parser import Paths_graphql (getDataFileName) -import Test.Hspec ( Spec - , describe - , it - ) -import Test.Hspec.Expectations ( expectationFailure - , shouldBe - ) -import Text.Megaparsec ( errorBundlePretty - , parse - ) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.Megaparsec (parseSatisfies) +import Text.Megaparsec (parse) import Text.RawString.QQ (r) spec :: Spec @@ -26,17 +20,12 @@ spec = describe "Kitchen Sink" $ do it "minifies the query" $ do dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql" - actual <- Text.IO.readFile dataFileName expected <- Text.Lazy.IO.readFile minFileName - either - (expectationFailure . errorBundlePretty) - (flip shouldBe expected . Encoder.document Encoder.minified) - $ parse Parser.document dataFileName actual + shouldNormalize Encoder.minified dataFileName expected it "pretty prints the query" $ do dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" - actual <- Text.IO.readFile dataFileName let expected = [r|query queryName($foo: ComplexType, $site: Site = MOBILE) { whoever123is: node(id: [123, 456]) { id @@ -70,7 +59,11 @@ fragment frag on Friend { } |] - either - (expectationFailure . errorBundlePretty) - (flip shouldBe expected . Encoder.document Encoder.pretty) - $ parse Parser.document dataFileName actual + shouldNormalize Encoder.pretty dataFileName expected + +shouldNormalize :: Encoder.Formatter -> FilePath -> Lazy.Text -> IO () +shouldNormalize formatter dataFileName expected = do + actual <- Text.IO.readFile dataFileName + parse Parser.document dataFileName actual `parseSatisfies` condition + where + condition = (expected ==) . Encoder.document formatter