diff --git a/src/Quasar/MonadQuasar.hs b/src/Quasar/MonadQuasar.hs index 29c4d9355abb20a8475c859e499b2473f3a75f8c..21ef395125345f1aee81bd814bb3ce7e8da6189a 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 b5c8de46d6479e8128fe89f25cfcd373002fd180..035b1938c70da9d2506c9311e861a58f28306142 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