如何在 Hedgehog 中使用 MonadUnliftIO 或 MonadBaseControl？

Question

我有一个 "test wrapper" 可以为每个测试创建一个带有随机名称的数据库 table（这样它们就不会相互干扰），并确保 table 在测试结束时被丢弃：

-- 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

根据我在以下链接中阅读的内容...

...我尝试了以下变体，但失败了：

-- 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（我不知道为什么我在摆弄ResourceT），似乎可以，但是可能在其他地方引起问题，因为我的应用程序的实际代码依赖于 MonadUnliftIO。鉴于 TestT m 有一个 MonadBaseControl 实例，是否可以安全地为 UnliftIO 定义一个实例？

{-# 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

Answer 1

没有看到错误很难给出具体的建议，但我相信你需要使用 test。正如文档所写：

Because both TestT and PropertyT have MonadTest instances, this function is not often required. It can however be useful for writing functions directly in TestT and thus gaining a MonadTransControl instance at the expense of not being able to generate additional inputs using forAll.

我认为这是您在这里关心的。

如何在 Hedgehog 中使用 MonadUnliftIO 或 MonadBaseControl？

How to use MonadUnliftIO or MonadBaseControl with Hedgehog?

haskell

monad-transformers

haskell-hedgehog

编辑