haskell/servant-quickcheck
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #50 from parsonsmatt/matt/configurable-manager

Browse Source 
Allow clients to pass a manager in
This commit is contained in:
Julian Arni 2018-05-10 14:37:18 +02:00 committed by GitHub
commit 78f30bc997
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Servant/QuickCheck/Internal/QuickCheck.hs
View File

@ -110,11 +110,15 @@ serversEqual api burl1 burl2 args req = do
-- /Since 0.0.0.0/ -- /Since 0.0.0.0/
serverSatisfies :: (HasGenRequest a) => serverSatisfies :: (HasGenRequest a) =>
Proxy a -> BaseUrl -> Args -> Predicates -> Expectation Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
serverSatisfies api burl args preds = do serverSatisfies api = serverSatisfiesMgr api defManager
serverSatisfiesMgr :: (HasGenRequest a) =>
Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
serverSatisfiesMgr api manager burl args preds = do
let reqs = ($ burl) <$> runGenRequest api let reqs = ($ burl) <$> runGenRequest api
deetsMVar <- newMVar $ error "should not be called" deetsMVar <- newMVar $ error "should not be called"
r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do
v <- run $ finishPredicates preds (noCheckStatus req) defManager v <- run $ finishPredicates preds (noCheckStatus req) manager
run $ modifyMVar_ deetsMVar $ const $ return v run $ modifyMVar_ deetsMVar $ const $ return v
case v of case v of
Just _ -> assert False Just _ -> assert False
@ -127,13 +131,16 @@ serverSatisfies api burl args preds = do
NoExpectedFailure {} -> expectationFailure $ "No expected failure" NoExpectedFailure {} -> expectationFailure $ "No expected failure"
InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage" InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
serverDoesntSatisfy :: (HasGenRequest a) => serverDoesntSatisfy :: (HasGenRequest a) =>
Proxy a -> BaseUrl -> Args -> Predicates -> Expectation Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
serverDoesntSatisfy api burl args preds = do serverDoesntSatisfy api = serverDoesntSatisfyMgr api defManager
serverDoesntSatisfyMgr :: (HasGenRequest a) =>
Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
serverDoesntSatisfyMgr api manager burl args preds = do
let reqs = ($ burl) <$> runGenRequest api let reqs = ($ burl) <$> runGenRequest api
r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
v <- run $ finishPredicates preds (noCheckStatus req) defManager v <- run $ finishPredicates preds (noCheckStatus req) manager
assert $ not $ null v assert $ not $ null v
case r of case r of
Success {} -> return () Success {} -> return ()