使用`MonadBaseControl` API

Question

我目前正在玩Bryan O'Sullivan的资源池库,并且有关于扩展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将起作用。但对于其他单子就会有问题。让我们考虑一下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 ()为 lift m ()）。然后在内部，因为它是IO基于 - 的，我只需创建一个帮助器MVar，通过调用该函数来重置该帮助器，最后根据值返回或销毁资源。