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 (
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 ()
......
......@@ -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)
......
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