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

Move newUnmanaged{IO,STM}Disposer to Disposer module

parent 6bd73fb0
No related branches found
No related tags found
No related merge requests found
...@@ -43,26 +43,10 @@ module Quasar.Resources ( ...@@ -43,26 +43,10 @@ module Quasar.Resources (
import Control.Monad.Catch import Control.Monad.Catch
import Quasar.Future import Quasar.Future
import Quasar.Async.Fork
import Quasar.Async.STMHelper
import Quasar.Exceptions import Quasar.Exceptions
import Quasar.MonadQuasar import Quasar.MonadQuasar
import Quasar.Prelude import Quasar.Prelude
import Quasar.Resources.Disposer 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 () registerResource :: (Resource a, MonadQuasar m, MonadSTM m) => a -> m ()
......
...@@ -7,6 +7,8 @@ module Quasar.Resources.Disposer ( ...@@ -7,6 +7,8 @@ module Quasar.Resources.Disposer (
disposeEventuallySTM, disposeEventuallySTM,
disposeEventuallySTM_, disposeEventuallySTM_,
newUnmanagedPrimitiveDisposer, newUnmanagedPrimitiveDisposer,
newUnmanagedIODisposer,
newUnmanagedSTMDisposer,
trivialDisposer, trivialDisposer,
-- * Resource manager -- * Resource manager
...@@ -23,6 +25,7 @@ import Data.HashMap.Strict (HashMap) ...@@ -23,6 +25,7 @@ import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HM import Data.HashMap.Strict qualified as HM
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet import Data.HashSet qualified as HashSet
import Quasar.Async.Fork
import Quasar.Async.STMHelper import Quasar.Async.STMHelper
import Quasar.Future import Quasar.Future
import Quasar.Exceptions import Quasar.Exceptions
...@@ -78,6 +81,20 @@ newUnmanagedPrimitiveDisposer fn worker exChan = toDisposer <$> do ...@@ -78,6 +81,20 @@ newUnmanagedPrimitiveDisposer fn worker exChan = toDisposer <$> do
key <- newUniqueSTM key <- newUniqueSTM
FnDisposer key worker exChan <$> newTOnce fn <*> newFinalizers 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 :: (MonadIO m, Resource r) => r -> m ()
dispose resource = liftIO $ await =<< atomically (disposeEventuallySTM resource) dispose resource = liftIO $ await =<< atomically (disposeEventuallySTM resource)
......
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