From acd10852abe0243aa83d047fc6a78ceb41d11771 Mon Sep 17 00:00:00 2001
From: "Michal J. Gajda" <mjgajda@migamake.com>
Date: Sun, 4 Jul 2021 23:30:08 +0200
Subject: [PATCH] More informative exception messages.

Avoids printing `Nothing` for many `serverSatisfiesMgr`.
If the predicate failure is reported as `Just Nothing`,
it shows full exception.
---
 src/Servant/QuickCheck/Internal/QuickCheck.hs | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/Servant/QuickCheck/Internal/QuickCheck.hs b/src/Servant/QuickCheck/Internal/QuickCheck.hs
index 2f3e0c0..02e6aec 100644
--- a/src/Servant/QuickCheck/Internal/QuickCheck.hs
+++ b/src/Servant/QuickCheck/Internal/QuickCheck.hs
@@ -3,7 +3,7 @@
 module Servant.QuickCheck.Internal.QuickCheck where
 
 import           Control.Concurrent       (tryReadMVar, newEmptyMVar, tryPutMVar)
-import           Control.Monad            (unless)
+import           Control.Monad            (unless, join)
 import qualified Data.ByteString.Lazy     as LBS
 import           Data.Proxy               (Proxy)
 import qualified Network.HTTP.Client      as C
@@ -27,6 +27,7 @@ import Servant.QuickCheck.Internal.ErrorTypes
 import Servant.QuickCheck.Internal.HasGenRequest
 import Servant.QuickCheck.Internal.Predicates
 
+import Debug.Trace(trace)
 
 -- | Start a servant application on an open port, run the provided function,
 -- then stop the application.
@@ -95,8 +96,10 @@ serversEqual api burl1 burl2 args req = do
       case mx of
         Just x ->
           expectationFailure $ "Failed:\n" ++ show x
+        Nothing | Just exc <- theException ->
+          expectationFailure $ "Failed with exception:\n" <> show exc
         Nothing ->
-          expectationFailure $ "We failed to record a reason for failure: " <> show r
+          expectationFailure $ "We failed to record a reason for failure: " <> show r <> "\nexception: " <> show theException
     GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
     NoExpectedFailure {} -> expectationFailure "No expected failure"
 #if MIN_VERSION_QuickCheck(2,12,0)
@@ -142,17 +145,21 @@ serverSatisfiesMgr api manager burl args preds = do
     v <- run $ finishPredicates preds (noCheckStatus req) manager
     _ <- run $ tryPutMVar deetsMVar v
     case v of
-      Just _ -> assert False
+      Just exc -> assert False
       _ -> return ()
   case r of
     Success {} -> return ()
     Failure {..} -> do
       mx <- tryReadMVar deetsMVar
-      case mx of
+      case join mx of
+        --Just Nothing ->
+        --  expectationFailure $ "Failed predicate with:\n" ++ show theException
         Just x ->
-          expectationFailure $ "Failed:\n" ++ show x
+          expectationFailure $ "Failed predicate:\n" ++ show x
+        Nothing | Just exc <- theException ->
+          expectationFailure $ "Failed with exception:\n" <> show exc
         Nothing ->
-          expectationFailure $ "We failed to record a reason for failure: " <> show r
+          expectationFailure $ "We failed to record a reason for failure:\n" <> show r
     GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
     NoExpectedFailure {} -> expectationFailure $ "No expected failure"
 #if MIN_VERSION_QuickCheck(2,12,0)