diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs index 1d82df4bcbce507b3b1eebbe482106d207dcca96..342de39b76dcb0da3f203279e3ef6d3a8f068f2c 100644 --- a/src/Quasar/Resources.hs +++ b/src/Quasar/Resources.hs @@ -39,13 +39,19 @@ import Quasar.Exceptions import Quasar.Monad import Quasar.Prelude import Quasar.Resources.Disposer +import Quasar.Utils.ShortIO newIODisposer :: IO () -> TIOWorker -> ExceptionChannel -> STM Disposer newIODisposer fn worker exChan = newPrimitiveDisposer (forkAsyncShortIO fn exChan) worker exChan newSTMDisposer :: STM () -> TIOWorker -> ExceptionChannel -> STM Disposer -newSTMDisposer fn = newIODisposer (atomically fn) +newSTMDisposer fn worker exChan = newPrimitiveDisposer disposeFn worker exChan + where + disposeFn :: ShortIO (Awaitable ()) + disposeFn = unsafeShortIO $ atomically $ + -- Spawn a thread only if the transaction retries + (pure <$> fn) `orElse` forkAsyncSTM (atomically fn) worker exChan registerResource :: (Resource a, MonadQuasar m) => a -> m ()