From 41313498c9d8ee3a7e3359491bc5d5a3ee8ccf89 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sat, 19 Mar 2022 18:10:12 +0100
Subject: [PATCH] Rename newQuasar to newResourceScope to match
withResourceScope
---
src/Quasar/MonadQuasar.hs | 27 ++++++++++++---------------
src/Quasar/Resources.hs | 4 ++--
2 files changed, 14 insertions(+), 17 deletions(-)
diff --git a/src/Quasar/MonadQuasar.hs b/src/Quasar/MonadQuasar.hs
index 29c4d93..21ef395 100644
--- a/src/Quasar/MonadQuasar.hs
+++ b/src/Quasar/MonadQuasar.hs
@@ -1,8 +1,8 @@
module Quasar.MonadQuasar (
-- * Quasar
Quasar,
- newQuasar,
- newQuasarSTM,
+ newResourceScope,
+ newResourceScopeSTM,
withResourceScope,
MonadQuasar(..),
@@ -67,28 +67,25 @@ quasarExceptionSink (Quasar _ exChan _) = exChan
quasarResourceManager :: Quasar -> ResourceManager
quasarResourceManager (Quasar _ _ rm) = rm
-newQuasarSTM :: TIOWorker -> ExceptionSink -> ResourceManager -> STM Quasar
-newQuasarSTM worker parentExChan parentRM = do
- rm <- newUnmanagedResourceManagerSTM worker parentExChan
- attachResource parentRM rm
+newResourceScopeSTM :: Quasar -> STM Quasar
+newResourceScopeSTM parent = do
+ rm <- newUnmanagedResourceManagerSTM worker parentExceptionSink
+ attachResource (quasarResourceManager parent) rm
pure $ Quasar worker (ExceptionSink (disposeOnException rm)) rm
where
+ worker = quasarIOWorker parent
+ parentExceptionSink = quasarExceptionSink parent
disposeOnException :: ResourceManager -> SomeException -> STM ()
disposeOnException rm ex = do
disposeEventuallySTM_ rm
- throwToExceptionSink parentExChan ex
+ throwToExceptionSink parentExceptionSink ex
-newQuasar :: MonadQuasar m => m Quasar
-newQuasar = do
- worker <- askIOWorker
- exChan <- askExceptionSink
- parentRM <- askResourceManager
- ensureSTM $ newQuasarSTM worker exChan parentRM
+newResourceScope :: MonadQuasar m => m Quasar
+newResourceScope = ensureSTM . newResourceScopeSTM =<< askQuasar
withResourceScope :: (MonadQuasar m, MonadIO m, MonadMask m) => m a -> m a
-withResourceScope fn = bracket newQuasar dispose (`localQuasar` fn)
-
+withResourceScope fn = bracket newResourceScope dispose (`localQuasar` fn)
class (MonadCatch m, MonadFix m) => MonadQuasar m where
diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs
index b5c8de4..035b193 100644
--- a/src/Quasar/Resources.hs
+++ b/src/Quasar/Resources.hs
@@ -117,7 +117,7 @@ disposeEventually_ res = ensureSTM $ disposeEventuallySTM_ res
captureResources :: MonadQuasar m => m a -> m (a, Disposer)
captureResources fn = do
- quasar <- newQuasar
+ quasar <- newResourceScope
localQuasar quasar do
result <- fn
pure (result, getDisposer (quasarResourceManager quasar))
@@ -129,5 +129,5 @@ captureResources_ fn = snd <$> captureResources fn
-- | Runs the computation in a new resource scope, which is disposed when an exception happenes. When the computation succeeds, resources are kept.
disposeOnError :: (MonadQuasar m, MonadIO m, MonadMask m) => m a -> m a
disposeOnError fn = mask \unmask -> do
- quasar <- newQuasar
+ quasar <- newResourceScope
unmask (localQuasar quasar fn) `onError` dispose quasar
--
GitLab