From 4c87d8471b36e320cb020cf9af161b177c1324dc Mon Sep 17 00:00:00 2001
From: Adam Gundry <adam@well-typed.com>
Date: Thu, 28 Apr 2022 08:34:22 +0100
Subject: [PATCH] Use displayException instead of show for showing exceptions

https://github.com/UnkindPartition/tasty/issues/327
---
 core/Test/Tasty/Core.hs         | 2 +-
 hunit/Test/Tasty/HUnit/Orig.hs  | 3 ++-
 hunit/Test/Tasty/HUnit/Steps.hs | 6 ++----
 3 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/core/Test/Tasty/Core.hs b/core/Test/Tasty/Core.hs
index 8fbb12de..66fdeb8a 100644
--- a/core/Test/Tasty/Core.hs
+++ b/core/Test/Tasty/Core.hs
@@ -113,7 +113,7 @@ resultSuccessful r =
 exceptionResult :: SomeException -> Result
 exceptionResult e = Result
   { resultOutcome = Failure $ TestThrewException e
-  , resultDescription = "Exception: " ++ show e
+  , resultDescription = "Exception: " ++ displayException e
   , resultShortDescription = "FAIL"
   , resultTime = 0
   , resultDetailsPrinter = noResultDetails
diff --git a/hunit/Test/Tasty/HUnit/Orig.hs b/hunit/Test/Tasty/HUnit/Orig.hs
index 6d5d35f2..0faa2e81 100644
--- a/hunit/Test/Tasty/HUnit/Orig.hs
+++ b/hunit/Test/Tasty/HUnit/Orig.hs
@@ -135,7 +135,8 @@ instance (AssertionPredicable t) => AssertionPredicable (IO t)
 -- | Exception thrown by 'assertFailure' etc.
 data HUnitFailure = HUnitFailure (Maybe SrcLoc) String
     deriving (Eq, Show, Typeable)
-instance E.Exception HUnitFailure
+instance E.Exception HUnitFailure where
+  displayException (HUnitFailure mbloc s) = prependLocation mbloc s
 
 prependLocation :: Maybe SrcLoc -> String -> String
 prependLocation mbloc s =
diff --git a/hunit/Test/Tasty/HUnit/Steps.hs b/hunit/Test/Tasty/HUnit/Steps.hs
index 4fa10d8b..af886cad 100644
--- a/hunit/Test/Tasty/HUnit/Steps.hs
+++ b/hunit/Test/Tasty/HUnit/Steps.hs
@@ -25,10 +25,8 @@ instance IsTest TestCaseSteps where
         tme <- getTime
         atomicModifyIORef ref (\l -> ((tme,msg):l, ()))
 
-    hunitResult <- (Right <$> assertionFn stepFn) `catches`
-      [ Handler (\(HUnitFailure mbloc errMsg) -> return $ Left (prependLocation mbloc errMsg))
-      , Handler (\(SomeException ex)          -> return $ Left (show ex))
-      ]
+    hunitResult <- (Right <$> assertionFn stepFn) `catch`
+        \(SomeException ex) -> return $ Left (displayException ex)
 
     endTime <- getTime