Working with the `MonadBaseControl` API

Question

I am currently playing with the Bryan O'Sullivan's resource-pool library and have a question regarding extending the withResource function. I want to change the signature of the withResource function from (MonadBaseControl IO m) => Pool a -> (a -> m b) -> m b to (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b.
What I want to achieve is, that the action should return (Bool, b) tuple, where the boolean value indicates if the borrowed resource should be put back into the pool or destroyed.

Now my current implementation looks like this:

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

And I have a feeling, that this is not how it is supposed to look like... Maybe I am not using the MonadBaseControl API right. What do you guys think of this and how can I improve it to be more idiomatic?

Answer 1

I have a feeling that there is a fundamental problem with this approach. For monads for which StM M a is equal/isomorphic to a it will work. But for other monads there will be a problem. Let's consider MaybeT IO. An action of type a -> MaybeT IO (Bool, b) can fail, so there will be no Bool value produced. And the code in

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

won't be executed, the control flow will stop at restoreM. And for ListT IO it'll be even worse, as putResource and destroyResource will be executed multiple times. Consider this sample program, which is a simplified version of your function:

{-# 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 ]

It'll print

destroy
return
destroy
return

And for an empty list, nothing gets printed, which means no cleanup would be called in your function.

---

I have to say I'm not sure how to achieve your goal in a better way. I'd try to explore in the direction of signature

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

where the IO () argument would be a function, that when executed, invalidates the current resource and marks it to be destroyed. (Or, for better convenience, replace IO () with lifted m ()). Then internally, as it's IO-based, I'd just create a helper MVar that'd be reset by calling the function, and at the end, based on the value, either return or destroy the resource.