我有一个“测试包装器”，它为每个测试创建一个带有随机名称的数据库表（这样它们就不会相互干扰），并确保在测试结束时删除该表：
-- NOTE: The constraint on `m` may be incorrect because I haven't
-- been able to make this compile, and this is exactly what I'm
-- struggling with
withRandomTable :: (MonadIO m) => Pool Connection -> (TableName -> m a) -> m a
根据我在以下链接上阅读的内容...
- https://github.com/hedgehogqa/haskell-hedgehog/issues/284
- https://github.com/hedgehogqa/haskell-hedgehog/issues/248
- https://www.stackage.org/haddock/lts-12.1/hedgehog-0.6/Hedgehog.html#v:test
...我尝试了以下变体，但失败了：
-- Attempt 1
myTest pool = property $ withRandomTable pool $ \tname -> do ...
-- Attempt 2
myTest pool = property $ do
randomData <- forAll $ ...
test $ withRandomTable pool $ \tname -> do ...
-- Attempts using `withRandomTableLifted`
withRandomTableLifted jobPool action = liftWith (\run -> withRandomTable jobPool (run . action)) >>= restoreT . return
-- Attempt 3
myTest pool = property . hoist runResourceT $ withRandomTableLifted pool $ \tname -> do ...
-- Attempt 4
myTest pool = property runResourceT $ do
randomData <- forAll $ ...
test . runResourceT $ withRandomTableLifted pool $ \tname -> do ...
-- Attempt 5
myTest pool = property runResourceT $ do
randomData <- forAll $ ...
test . hoist runResourceT $ withRandomTableLifted pool $ \tname -> do ...
现在，我只是在尝试随机变化，希望能找到任何解决这个类型级拼图游戏的方法！帮助将不胜感激。
编辑
这是我第一次尝试的完整片段，我正在使用UnliftIO，但它不起作用，因为TestT m没有MonadUnliftIO (TestT IO)实例。
{-# LANGUAGE FlexibleContexts #-}
module Try where
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import UnliftIO.Exception
import Control.Monad
import Data.Pool as Pool
import Debug.Trace
import Control.Monad.IO.Unlift (liftIO)
import qualified System.Random as R
import Data.String (fromString)
withRandomTable pool action = do
tname <- liftIO ((("jobs_" <>) . fromString) <$> (replicateM 10 (R.randomRIO ('a', 'z'))))
finally
(Pool.withResource pool $ \conn -> (liftIO $ traceM "I will create the random table here") >> (action tname))
(Pool.withResource pool $ \conn -> liftIO $ traceM "I will drop the random table here")
myTest pool = property $ do
randomData <- forAll $ Gen.list (Range.linear 1 100) (Gen.element [1, 2, 3])
test $ withRandomTable pool $ \tname -> do
traceM $ "hooray... I got the random table name " <> tname
True === True
-- /Users/saurabhnanda/projects/haskell-pg-queue/test/Try.hs:23:10: error:
-- • No instance for (Control.Monad.IO.Unlift.MonadUnliftIO
-- (TestT IO))
-- arising from a use of ‘withRandomTable’
-- • In the expression: withRandomTable pool
-- In the second argument of ‘($)’, namely
-- ‘withRandomTable pool
-- $ \ tname
-- -> do traceM $ "hooray... I got the random table name " <> tname’
-- In a stmt of a 'do' block:
-- test
-- $ withRandomTable pool
-- $ \ tname
- -> do traceM $ "hooray... I got the random table name " <> tname
-- |
-- 23 | test $ withRandomTable pool $ \tname -> do
-- | ^^^^^^^^^^^^^^^^^^^^
接下来，如果我使用（lifted-base我不知道为什么要摆弄. 鉴于有一个实例，是否可以安全地定义一个实例？ResourceTMonadUnliftIOTestT mMonadBaseControlUnliftIO
{-# LANGUAGE FlexibleContexts #-}
module Try where
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Control.Exception.Lifted
import Control.Monad
import Data.Pool as Pool
import Debug.Trace
import Control.Monad.IO.Unlift (liftIO)
import qualified System.Random as R
import Data.String (fromString)
withRandomTable pool action = do
tname <- liftIO ((("jobs_" <>) . fromString) <$> (replicateM 10 (R.randomRIO ('a', 'z'))))
finally
(Pool.withResource pool $ \conn -> (liftIO $ traceM "I will create the random table here") >> (action tname))
(Pool.withResource pool $ \conn -> liftIO $ traceM "I will drop the random table here")
myTest pool = property $ do
randomData <- forAll $ Gen.list (Range.linear 1 100) (Gen.element [1, 2, 3])
test $ withRandomTable pool $ \tname -> do
traceM $ "hooray... I got the random table name " <> tname
True === True