时间戳

首页 > 解决方案 > 如何将 MonadUnliftIO 或 MonadBaseControl 与 Hedgehog 一起使用？

haskell - 如何将 MonadUnliftIO 或 MonadBaseControl 与 Hedgehog 一起使用？

问题描述

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

-- 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我不知道为什么要摆弄. 鉴于有一个实例，是否可以安全地定义一个实例？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

标签： haskellmonad-transformershaskell-hedgehog

解决方案

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

因为 TestT 和 PropertyT 都有 MonadTest 实例，所以通常不需要这个函数。然而，它可以用于直接在 TestT 中编写函数，从而以无法使用 forAll 生成额外输入为代价获得 MonadTransControl 实例。

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

推荐阅读