Skip to content
This repository has been archived by the owner on Apr 22, 2024. It is now read-only.

Commit

Permalink
More informative exception messages.
Browse files Browse the repository at this point in the history
Avoids printing `Nothing` for many `serverSatisfiesMgr`.
If the predicate failure is reported as `Just Nothing`,
it shows full exception.
  • Loading branch information
mgajda committed Jul 4, 2021
1 parent 0535413 commit acd1085
Showing 1 changed file with 13 additions and 6 deletions.
19 changes: 13 additions & 6 deletions src/Servant/QuickCheck/Internal/QuickCheck.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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.
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit acd1085

Please sign in to comment.