From af65ceeae4518b754fb678674c0b3c542acd06ab Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 24 Apr 2022 17:41:48 +0200
Subject: [PATCH] Move newUnmanaged{IO,STM}Disposer to Disposer module
---
src/Quasar/Resources.hs | 16 ----------------
src/Quasar/Resources/Disposer.hs | 17 +++++++++++++++++
2 files changed, 17 insertions(+), 16 deletions(-)
diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs
index 6efc90d..d99d50d 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 56f8ba5..a29ae24 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)
--
GitLab