@@ -17,10 +17,12 @@ import System.IO (hPutStrLn, hFlush)
1717import System.IO.Temp (withSystemTempFile)
1818import System.Mem (performGC)
1919import System.Process (callCommand)
20−import Test.Hspec (Expectation, expectationFailure)
20+import Test.Hspec (Expectation, expectationFailure, shouldBe)
2121import Test.QuickCheck (Args (..), Property, forAll, Result (..),
2222 Testable, property, ioProperty,
2323 quickCheckWithResult, stdArgs)
24+import System.IO.Unsafe (unsafePerformIO)
25+import Test.QuickCheck.Monadic
2426
2527import Servant.QuickCheck.Internal.HasGenRequest
2628import Servant.QuickCheck.Internal.Predicates
@@ -47,12 +49,21 @@ withServantServer api server t
4749-- Evidently, if the behaviour of the server is expected to be
4850-- non-deterministic, this function may produce spurious failures
4951serversEqual :: HasGenRequest a =>
50− Proxy a -> BaseUrl -> BaseUrl -> Manager -> Property
51−serversEqual api burl1 burl2 mgr =
52+ Proxy a -> BaseUrl -> BaseUrl -> Args -> Expectation
53+serversEqual api burl1 burl2 args = do
5254 let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api
53− in forAll reqs $ \(req1, req2) -> ioProperty $ do
54− resp1 <- httpLbs req1 mgr
55− resp2 <- httpLbs req2 mgr
56− return $ resp1 == resp2
55+ r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
56+ resp1 <- run $ httpLbs req1 defManager
57+ resp2 <- run $ httpLbs req2 defManager
58+ assert $ resp1 == resp2
59+ case r of
60+ Success {} -> return ()
61+ GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
62+ Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
63+ NoExpectedFailure {} -> expectationFailure $ "No expected failure"
64+ InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
5765
66+defManager :: Manager
67+defManager = unsafePerformIO $ newManager defaultManagerSettings
68+{-# NOINLINE defManager #-}
5869