使用 `MonadBaseControl` API

Working with the `MonadBaseControl` API

我目前正在使用 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
我想要实现的是,动作应该 return (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 吧。 你们对此有何看法?我该如何改进它以使其更加地道?

我感觉这种方法存在根本问题。对于 StM M a 是 equal/isomorphic 到 a 的单子,它将起作用。但是对于其他的单子会有问题。让我们考虑一下 MaybeT IOa -> MaybeT IO (Bool, b) 类型的操作可能会失败,因此不会产生 Bool 值。

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

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

{-# 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 ,它会通过调用重置 函数,最后,根据值,return 或销毁资源。