diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs index 037ed48416eb4ac8096cf822792f80ea473ad797..b6c8e73bd62940f1a44af98783e5f55b887a69ff 100644 --- a/src/Quasar/Resources.hs +++ b/src/Quasar/Resources.hs @@ -6,8 +6,15 @@ module Quasar.Resources ( disposeEventuallySTM_, isDisposed, + -- * Monadic resource management + registerResource, + registerDisposeAction, + registerDisposeTransaction, + -- * Disposer Disposer, + newIODisposer, + newSTMDisposer, -- * Resource manager ResourceManager, @@ -19,8 +26,33 @@ module Quasar.Resources ( import Control.Concurrent.STM import Quasar.Async.STMHelper import Quasar.Exceptions +import Quasar.Monad import Quasar.Prelude import Quasar.Resources.Disposer +newIODisposer :: TIOWorker -> ExceptionChannel -> IO () -> STM Disposer +newIODisposer = undefined + +newSTMDisposer :: TIOWorker -> ExceptionChannel -> STM () -> STM Disposer +newSTMDisposer = undefined + + +registerResource :: (Resource a, MonadQuasar m) => a -> m () +registerResource resource = do + rm <- askResourceManager + runSTM $ attachResource rm resource + +registerDisposeAction :: MonadQuasar m => IO () -> m () +registerDisposeAction fn = do + worker <- askIOWorker + exChan <- askExceptionChannel + rm <- askResourceManager + runSTM $ attachResource rm =<< newIODisposer worker exChan fn +registerDisposeTransaction :: MonadQuasar m => STM () -> m () +registerDisposeTransaction fn = do + worker <- askIOWorker + exChan <- askExceptionChannel + rm <- askResourceManager + runSTM $ attachResource rm =<< newSTMDisposer worker exChan fn