Introduce hspec-megaparsec

Fixes #13.

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