From 80fd6df8f6636a1f1e733684617b330e6f902a38 Mon Sep 17 00:00:00 2001
From: Mann mit Hut <github+mmhat@with-h.at>
Date: Wed, 5 Jun 2024 11:42:14 +0200
Subject: [PATCH] Be a bit more chatty

---
 dhall/src/Dhall/Parser/Combinators.hs |  4 ++++
 dhall/tests/Dhall/Test/Parser.hs      | 17 +++++++++++++----
 2 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/dhall/src/Dhall/Parser/Combinators.hs b/dhall/src/Dhall/Parser/Combinators.hs
index c8a035cfb..d0a72e826 100644
--- a/dhall/src/Dhall/Parser/Combinators.hs
+++ b/dhall/src/Dhall/Parser/Combinators.hs
@@ -169,6 +169,10 @@ instance Text.Megaparsec.MonadParsec Void Text Parser where
 
     updateParserState f = Parser (Text.Megaparsec.updateParserState f)
 
+#if MIN_VERSION_megaparsec(9,4,0)
+    mkParsec f = Parser (Text.Megaparsec.mkParsec f)
+#endif
+
 instance Semigroup a => Semigroup (Parser a) where
     (<>) = liftA2 (<>)
 
diff --git a/dhall/tests/Dhall/Test/Parser.hs b/dhall/tests/Dhall/Test/Parser.hs
index 0c3df5ad9..3859194da 100644
--- a/dhall/tests/Dhall/Test/Parser.hs
+++ b/dhall/tests/Dhall/Test/Parser.hs
@@ -158,7 +158,7 @@ shouldNotParse path = do
 
     let pathString = Text.unpack path
 
-    Test.Util.testCase path expectedFailures (do
+    Test.Util.testCase path expectedFailures $ do
         bytes <- ByteString.readFile pathString
 
         case Text.Encoding.decodeUtf8' bytes of
@@ -166,7 +166,13 @@ shouldNotParse path = do
             Right text ->
                 case Parser.exprFromText mempty text of
                     Left  _ -> return ()
-                    Right _ -> Tasty.HUnit.assertFailure "Unexpected successful parse" )
+                    Right expression -> do
+                        let strippedExpression :: Expr Void Import
+                            strippedExpression = Core.denote expression
+
+                        let message = "Unexpected successful parse: " ++
+                                      show strippedExpression
+                        Tasty.HUnit.assertFailure message
 
 shouldDecode :: Text -> TestTree
 shouldDecode pathText = do
@@ -212,9 +218,12 @@ shouldNotDecode pathText = do
 
     let pathString = Text.unpack pathText
 
-    Test.Util.testCase pathText expectedFailures (do
+    Test.Util.testCase pathText expectedFailures $ do
         bytes <- ByteString.Lazy.readFile (pathString <> ".dhallb")
 
         case Binary.decodeExpression bytes :: Either Binary.DecodingFailure (Expr Void Import) of
             Left _ -> return ()
-            Right _ -> Tasty.HUnit.assertFailure "Unexpected successful decode" )
+            Right expression -> do
+                let message = "Unexpected successful decode: " ++
+                              show expression
+                Tasty.HUnit.assertFailure message