@@ -5,6 +5,7 @@
55{-# OPTIONS_GHC -Wno-missing-signatures -Wno-partial-type-signatures #-}
66module Test where
77
8+import Control.Monad.Trans.Control
89import Test.Tasty as Tasty
910import qualified OddJobs.Migrations as Migrations
1011import qualified OddJobs.Job as Job
@@ -36,7 +37,6 @@ import Test.Tasty.Hedgehog
3637import qualified System.Random as R
3738import Data.String (fromString)
3839import qualified Data.IntMap.Strict as Map
39−import Control.Monad.Trans.Control (liftWith, restoreT)
4040import Control.Monad.Morph (hoist)
4141import Data.List as DL
4242import OddJobs.Web as Web
@@ -64,31 +64,16 @@ main = do
6464 , connectDatabase = "jobs_test"
6565 }
6666
67−#if MIN_VERSION_resource_pool(0,3,0)
68− createAppPool = Pool.newPool $ Pool.PoolConfig
67+ createAppPool = Pool.newPool $ Pool.defaultPoolConfig
6968 (PGS.connect connInfo) -- create a new resource
7069 PGS.close -- destroy resource
7170 (fromRational 10) -- number of seconds unused resources are kept around
7271 45
73− createJobPool = Pool.newPool $ Pool.PoolConfig
72+ createJobPool = Pool.newPool $ Pool.defaultPoolConfig
7473 (PGS.connect connInfo) -- create a new resource
7574 PGS.close -- destroy resource
7675 (fromRational 10) -- number of seconds unused resources are kept around
7776 45
78−#else
79− createAppPool = Pool.createPool
80− (PGS.connect connInfo) -- create a new resource
81− PGS.close -- destroy resource
82− 1 -- stripes
83− (fromRational 10) -- number of seconds unused resources are kept around
84− 45
85− createJobPool = Pool.createPool
86− (PGS.connect connInfo) -- create a new resource
87− PGS.close -- destroy resource
88− 1 -- stripes
89− (fromRational 10) -- number of seconds unused resources are kept around
90− 45
91−#endif
9277
9378tests appPool jobPool = testGroup "All tests"
9479 [
@@ -241,14 +226,17 @@ ensureJobId conn tname jid = Job.findJobByIdIO conn tname jid >>= \case
241226 Nothing -> error $ "Not expecting job to be deleted. JobId=" <> show jid
242227 Just j -> pure j
243228
244−withRandomTable :: _ => Pool Connection -> (Job.TableName -> m a) -> m a
229+withRandomTable :: (MonadBaseControl
230+ IO m, MonadUnliftIO m) => Pool Connection -> (Job.TableName -> m a) -> m a
245231withRandomTable jobPool action = do
232+ runInIO <- askRunInIO
246233 (tname :: Job.TableName) <- liftIO (fromString . ("jobs_" <>) <$> replicateM 10 (R.randomRIO ('a', 'z')))
247234 finally
248− (Pool.withResource jobPool (\conn -> liftIO $ Migrations.createJobTable conn tname) >> action tname)
249− (Pool.withResource jobPool $ \conn -> liftIO $ void $ PGS.execute conn "drop table if exists ?" (Only tname))
235+ (liftIO $ Pool.withResource jobPool (\conn -> liftIO $ Migrations.createJobTable conn tname) >> runInIO (action tname))
236+ (liftIO $ Pool.withResource jobPool $ \conn -> liftIO $ void $ PGS.execute conn "drop table if exists ?" (Only tname))
250237
251−withRandomResourceTables :: _ => Int -> Pool Connection -> Job.TableName -> (Job.ResourceCfg -> m a) -> m a
238+withRandomResourceTables :: (MonadBaseControl
239+ IO m, MonadUnliftIO m) => Int -> Pool Connection -> Job.TableName -> (Job.ResourceCfg -> m a) -> m a
252240withRandomResourceTables defaultLimit jobPool tname action = do
253241 resCfgResourceTable <- liftIO $ fromString . ("resources_" <>) <$> replicateM 10 (R.randomRIO ('a', 'z'))
254242 resCfgUsageTable <- liftIO $ fromString . ("usage_" <>) <$> replicateM 10 (R.randomRIO ('a', 'z'))
@@ -260,9 +248,9 @@ withRandomResourceTables defaultLimit jobPool tname action = do
260248
261249 finally
262250 (do
263− Pool.withResource jobPool $ \conn -> liftIO $ Migrations.createResourceTables conn tname resCfg
251+ liftIO $ Pool.withResource jobPool $ \conn -> liftIO $ Migrations.createResourceTables conn tname resCfg
264252 action resCfg)
265− (Pool.withResource jobPool $ \conn -> liftIO $ void $ PGS.execute conn
253+ (liftIO $ Pool.withResource jobPool $ \conn -> liftIO $ void $ PGS.execute conn
266254 "drop function if exists ?; drop table if exists ?; drop table if exists ?"
267255 (resCfgCheckResourceFunction, resCfgUsageTable, resCfgResourceTable))
268256