Be a bit more chatty

dhall-lang · Jun 5, 2024 · 80fd6df · 80fd6df
1 parent 89d70ce
commit 80fd6df
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 4 deletions.
diff --git 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
@@ -158,15 +158,21 @@ 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
             Left _ -> return ()
             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