From 123555ea758cb971fdf993661c125a4e95eacc3a Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Fri, 11 Feb 2022 16:16:22 +0100
Subject: [PATCH] Add monadic resource registration functions

---
 src/Quasar/Resources.hs | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs
index 037ed48..b6c8e73 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
-- 
GitLab