使用 MonadBaseControl API

Question

我目前正在使用 Bryan O'Sullivan 的 resource-pool 库，并且对扩展 withResource 函数有疑问。 我想将withResource 函数的签名从(MonadBaseControl IO m) => Pool a -> (a -> m b) -> m b 更改为(MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b。
我想要实现的是，该操作应该返回(Bool, b) 元组，其中布尔值指示借用的资源是否应该 放回池中或销毁。

现在我当前的实现如下所示：

withResource :: forall m a b. (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b
{-# SPECIALIZE withResource :: Pool a -> (a -> IO (Bool,b)) -> IO b #-}
withResource pool act = fmap snd result
  where
    result :: m (Bool, b)
    result = control $ \runInIO -> mask $ \restore -> do
      resource <- takeResource pool
      ret <- restore (runInIO (act resource)) `onException`
             destroyResource pool resource

      void . runInIO $ do
        (keep, _) <- restoreM ret :: m (Bool, b)

        if keep
          then liftBaseWith . const $ putResource pool resource
          else liftBaseWith . const $ destroyResource pool resource

      return ret

而且我有一种感觉，这不是它应该看起来的样子...... 也许我没有正确使用MonadBaseControl API。 你们如何看待这个问题，我该如何改进它以使其更加地道？

Answer 1

我感觉这种方法存在根本问题。对于 StM M a 与 a 相等/同构的 monad，它将起作用。但是对于其他 monad 来说就会有问题。让我们考虑MaybeT IO。 a -> MaybeT IO (Bool, b) 类型的操作可能会失败，因此不会产生 Bool 值。以及

中的代码

  void . runInIO $ do
    (keep, _) <- restoreM ret :: m (Bool, b)
    ...

不会被执行，控制流将停止在restoreM。而对于ListT IO，情况会更糟，因为putResource 和destroyResource 将被执行多次。考虑这个示例程序，它是您的函数的简化版本：

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, RankNTypes, TupleSections #-}
import Control.Monad
import Control.Monad.Trans.Control
import Control.Monad.Trans.List

foo :: forall m b . (MonadBaseControl IO m) => m (Bool, b) -> m b
foo act = fmap snd result
  where
    result :: m (Bool, b)
    result = control $ \runInIO -> do
      ret <- runInIO act

      void . runInIO $ do
        (keep, _) <- restoreM ret :: m (Bool, b)

        if keep
          then liftBaseWith . const $ putStrLn "return"
          else liftBaseWith . const $ putStrLn "destroy"

      return ret

main :: IO ()
main = void . runListT $ foo f
  where
    f = msum $ map (return . (, ())) [ False, True, False, True ]

它会打印出来

destroy
return
destroy
return

对于空列表，不会打印任何内容，这意味着不会在您的函数中调用任何清理。

---

我不得不说我不确定如何以更好的方式实现您的目标。我会尝试向签名的方向探索

withResource :: forall m a b. (MonadBaseControl IO m)
             => Pool a -> (a -> IO () -> m b) -> m b

IO () 参数将是一个函数，在执行时会使当前资源无效并将其标记为销毁。 （或者，为了更方便，将IO () 替换为提升的m ()）。然后在内部，因为它是基于IO，我只需创建一个助手MVar，它可以通过调用来重置 函数，最后根据值返回或销毁资源。