Skip to content
Snippets Groups Projects
Commit 41313498 authored by Jens Nolte's avatar Jens Nolte
Browse files

Rename newQuasar to newResourceScope to match withResourceScope

parent 54d3bd77
No related branches found
No related tags found
No related merge requests found
module Quasar.MonadQuasar ( module Quasar.MonadQuasar (
-- * Quasar -- * Quasar
Quasar, Quasar,
newQuasar, newResourceScope,
newQuasarSTM, newResourceScopeSTM,
withResourceScope, withResourceScope,
MonadQuasar(..), MonadQuasar(..),
...@@ -67,28 +67,25 @@ quasarExceptionSink (Quasar _ exChan _) = exChan ...@@ -67,28 +67,25 @@ quasarExceptionSink (Quasar _ exChan _) = exChan
quasarResourceManager :: Quasar -> ResourceManager quasarResourceManager :: Quasar -> ResourceManager
quasarResourceManager (Quasar _ _ rm) = rm quasarResourceManager (Quasar _ _ rm) = rm
newQuasarSTM :: TIOWorker -> ExceptionSink -> ResourceManager -> STM Quasar newResourceScopeSTM :: Quasar -> STM Quasar
newQuasarSTM worker parentExChan parentRM = do newResourceScopeSTM parent = do
rm <- newUnmanagedResourceManagerSTM worker parentExChan rm <- newUnmanagedResourceManagerSTM worker parentExceptionSink
attachResource parentRM rm attachResource (quasarResourceManager parent) rm
pure $ Quasar worker (ExceptionSink (disposeOnException rm)) rm pure $ Quasar worker (ExceptionSink (disposeOnException rm)) rm
where where
worker = quasarIOWorker parent
parentExceptionSink = quasarExceptionSink parent
disposeOnException :: ResourceManager -> SomeException -> STM () disposeOnException :: ResourceManager -> SomeException -> STM ()
disposeOnException rm ex = do disposeOnException rm ex = do
disposeEventuallySTM_ rm disposeEventuallySTM_ rm
throwToExceptionSink parentExChan ex throwToExceptionSink parentExceptionSink ex
newQuasar :: MonadQuasar m => m Quasar newResourceScope :: MonadQuasar m => m Quasar
newQuasar = do newResourceScope = ensureSTM . newResourceScopeSTM =<< askQuasar
worker <- askIOWorker
exChan <- askExceptionSink
parentRM <- askResourceManager
ensureSTM $ newQuasarSTM worker exChan parentRM
withResourceScope :: (MonadQuasar m, MonadIO m, MonadMask m) => m a -> m a 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 class (MonadCatch m, MonadFix m) => MonadQuasar m where
......
...@@ -117,7 +117,7 @@ disposeEventually_ res = ensureSTM $ disposeEventuallySTM_ res ...@@ -117,7 +117,7 @@ disposeEventually_ res = ensureSTM $ disposeEventuallySTM_ res
captureResources :: MonadQuasar m => m a -> m (a, Disposer) captureResources :: MonadQuasar m => m a -> m (a, Disposer)
captureResources fn = do captureResources fn = do
quasar <- newQuasar quasar <- newResourceScope
localQuasar quasar do localQuasar quasar do
result <- fn result <- fn
pure (result, getDisposer (quasarResourceManager quasar)) pure (result, getDisposer (quasarResourceManager quasar))
...@@ -129,5 +129,5 @@ captureResources_ fn = snd <$> captureResources fn ...@@ -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. -- | 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 :: (MonadQuasar m, MonadIO m, MonadMask m) => m a -> m a
disposeOnError fn = mask \unmask -> do disposeOnError fn = mask \unmask -> do
quasar <- newQuasar quasar <- newResourceScope
unmask (localQuasar quasar fn) `onError` dispose quasar unmask (localQuasar quasar fn) `onError` dispose quasar
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment