Работа с API `MonadBaseControl`

Question

В настоящее время я играю с библиотекой Bracan 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, он будет работать. Но для других монадов возникнет проблема. Рассмотрим 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, который будет сброшен, вызвав функцию , и в конце, на основе значения, верните или уничтожьте ресурс.