Question

我有一个“测试包装器”，它为每个测试创建一个带有随机名称的数据库表（以免它们互相干扰），并确保在测试结束时删除该表： / p>

-- 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。如文档所述：

由于TestT和PropertyT都具有MonadTest实例，因此通常不需要此功能。但是，对于直接在TestT中编写函数并因此获得MonadTransControl实例（以无法使用forAll生成其他输入为代价）而言，这可能很有用。

我认为您在这里是什么。

如何在刺猬中使用MonadUnliftIO或MonadBaseControl？

编辑

1 个答案: