diff --git a/src/Quasar/PreludeExtras.hs b/src/Quasar/PreludeExtras.hs index b91d7174b05f04efdfc89581dd288d4f2fd45944..c229dd6038070662c4658586d8a33881206e956b 100644 --- a/src/Quasar/PreludeExtras.hs +++ b/src/Quasar/PreludeExtras.hs @@ -8,6 +8,7 @@ import Prelude import Control.Applicative (liftA2) import Control.Concurrent (threadDelay) +import Control.Concurrent.STM import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.State.Lazy as State import Data.Char qualified as Char @@ -16,6 +17,8 @@ import Data.HashSet qualified as HS import Data.Hashable qualified as Hashable import Data.List qualified as List import Data.Maybe qualified as Maybe +import Data.Unique (Unique, newUnique) +import GHC.Conc (unsafeIOToSTM) import GHC.Stack.Types qualified import Quasar.Utils.ExtraT @@ -129,3 +132,6 @@ unlessM :: Monad m => m Bool -> m () -> m () unlessM condM acc = do cond <- condM unless cond acc + +newUniqueSTM :: STM Unique +newUniqueSTM = unsafeIOToSTM newUnique diff --git a/src/Quasar/ResourceManager.hs b/src/Quasar/ResourceManager.hs index 4445a8d68d4846c517e4f330c2cd5cdbb283838f..e04d66f61734778fc54ee00c644a705e810f157c 100644 --- a/src/Quasar/ResourceManager.hs +++ b/src/Quasar/ResourceManager.hs @@ -49,7 +49,6 @@ import Data.HashMap.Strict qualified as HM import Data.List.NonEmpty (NonEmpty(..), (<|), nonEmpty) import Data.Sequence (Seq(..), (|>)) import Data.Sequence qualified as Seq -import GHC.Conc (unsafeIOToSTM) import Quasar.Async.Unmanaged import Quasar.Awaitable import Quasar.Disposable @@ -330,7 +329,7 @@ instance IsResourceManager DefaultResourceManager where attachDisposable self disposable = liftIO $ atomically $ attachDisposableSTM self disposable attachDisposableSTM DefaultResourceManager{stateVar, disposablesVar} disposable = do - key <- unsafeIOToSTM newUnique + key <- newUniqueSTM state <- readTVar stateVar case state of ResourceManagerNormal -> do @@ -462,7 +461,7 @@ defaultResourceManagerDisposeResult DefaultResourceManager{resourceManagerKey, r -- to implement the root resource manager. newUnmanagedDefaultResourceManagerInternal :: ResourceManager -> STM DefaultResourceManager newUnmanagedDefaultResourceManagerInternal parentResourceManager = do - resourceManagerKey <- unsafeIOToSTM newUnique + resourceManagerKey <- newUniqueSTM stateVar <- newTVar ResourceManagerNormal disposablesVar <- newTMVar HM.empty lockVar <- newTVar 0