@@ -17,10 +17,12 @@ import System.IO (hPutStrLn, hFlush)
17import System.IO.Temp (withSystemTempFile)
17import System.IO.Temp (withSystemTempFile)
18import System.Mem (performGC)
18import System.Mem (performGC)
19import System.Process (callCommand)
19import System.Process (callCommand)
20−import Test.Hspec (Expectation, expectationFailure)
20+import Test.Hspec (Expectation, expectationFailure, shouldBe)
21import Test.QuickCheck (Args (..), Property, forAll, Result (..),
21import Test.QuickCheck (Args (..), Property, forAll, Result (..),
22 Testable, property, ioProperty,
22 Testable, property, ioProperty,
23 quickCheckWithResult, stdArgs)
23 quickCheckWithResult, stdArgs)
24+import System.IO.Unsafe (unsafePerformIO)
25+import Test.QuickCheck.Monadic
25import Servant.QuickCheck.Internal.HasGenRequest
27import Servant.QuickCheck.Internal.HasGenRequest
26import Servant.QuickCheck.Internal.Predicates
28import Servant.QuickCheck.Internal.Predicates
@@ -47,12 +49,21 @@ withServantServer api server t
47-- Evidently, if the behaviour of the server is expected to be
49-- Evidently, if the behaviour of the server is expected to be
48-- non-deterministic, this function may produce spurious failures
50-- non-deterministic, this function may produce spurious failures
49serversEqual :: HasGenRequest a =>
51serversEqual :: HasGenRequest a =>
50− Proxy a -> BaseUrl -> BaseUrl -> Manager -> Property
52+ Proxy a -> BaseUrl -> BaseUrl -> Args -> Expectation
51−serversEqual api burl1 burl2 mgr =
53+serversEqual api burl1 burl2 args = do
52 let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api
54 let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api
53− in forAll reqs $ \(req1, req2) -> ioProperty $ do
55+ r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
54− resp1 <- httpLbs req1 mgr
56+ resp1 <- run $ httpLbs req1 defManager
55− resp2 <- httpLbs req2 mgr
57+ resp2 <- run $ httpLbs req2 defManager
56− return $ resp1 == resp2
58+ assert $ resp1 == resp2
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"
67+defManager = unsafePerformIO $ newManager defaultManagerSettings
68+{-# NOINLINE defManager #-}