diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs index 6efc90d8fb314c442da7d2c4415ad53db884db27..d99d50dfad00010e88cc05dcca2a1ee7df13b511 100644 --- a/src/Quasar/Resources.hs +++ b/src/Quasar/Resources.hs @@ -43,26 +43,10 @@ module Quasar.Resources ( import Control.Monad.Catch import Quasar.Future -import Quasar.Async.Fork -import Quasar.Async.STMHelper import Quasar.Exceptions import Quasar.MonadQuasar import Quasar.Prelude import Quasar.Resources.Disposer -import Quasar.Utils.ShortIO - - -newUnmanagedIODisposer :: IO () -> TIOWorker -> ExceptionSink -> STM Disposer --- TODO change TIOWorker behavior for spawning threads, so no `unsafeShortIO` is necessary -newUnmanagedIODisposer fn worker exChan = newUnmanagedPrimitiveDisposer (unsafeShortIO $ forkFuture fn exChan) worker exChan - -newUnmanagedSTMDisposer :: STM () -> TIOWorker -> ExceptionSink -> STM Disposer -newUnmanagedSTMDisposer fn worker exChan = newUnmanagedPrimitiveDisposer disposeFn worker exChan - where - disposeFn :: ShortIO (Future ()) - disposeFn = unsafeShortIO $ atomically $ - -- Spawn a thread only if the transaction retries - (pure <$> fn) `orElse` forkAsyncSTM (atomically fn) worker exChan registerResource :: (Resource a, MonadQuasar m, MonadSTM m) => a -> m () diff --git a/src/Quasar/Resources/Disposer.hs b/src/Quasar/Resources/Disposer.hs index 56f8ba59dfe85c677e4d4ed78cae8709a74d1adb..a29ae246fc57d4c935037ba11dfaf8436b0e8a89 100644 --- a/src/Quasar/Resources/Disposer.hs +++ b/src/Quasar/Resources/Disposer.hs @@ -7,6 +7,8 @@ module Quasar.Resources.Disposer ( disposeEventuallySTM, disposeEventuallySTM_, newUnmanagedPrimitiveDisposer, + newUnmanagedIODisposer, + newUnmanagedSTMDisposer, trivialDisposer, -- * Resource manager @@ -23,6 +25,7 @@ import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HM import Data.HashSet (HashSet) import Data.HashSet qualified as HashSet +import Quasar.Async.Fork import Quasar.Async.STMHelper import Quasar.Future import Quasar.Exceptions @@ -78,6 +81,20 @@ newUnmanagedPrimitiveDisposer fn worker exChan = toDisposer <$> do key <- newUniqueSTM FnDisposer key worker exChan <$> newTOnce fn <*> newFinalizers +newUnmanagedIODisposer :: IO () -> TIOWorker -> ExceptionSink -> STM Disposer +-- TODO change TIOWorker behavior for spawning threads, so no `unsafeShortIO` is necessary +newUnmanagedIODisposer fn worker exChan = newUnmanagedPrimitiveDisposer (unsafeShortIO $ forkFuture fn exChan) worker exChan + +newUnmanagedSTMDisposer :: STM () -> TIOWorker -> ExceptionSink -> STM Disposer +newUnmanagedSTMDisposer fn worker exChan = newUnmanagedPrimitiveDisposer disposeFn worker exChan + where + disposeFn :: ShortIO (Future ()) + disposeFn = unsafeShortIO $ atomically $ + -- Spawn a thread only if the transaction retries + (pure <$> fn) `orElse` forkAsyncSTM (atomically fn) worker exChan + + + dispose :: (MonadIO m, Resource r) => r -> m () dispose resource = liftIO $ await =<< atomically (disposeEventuallySTM resource)