diff --git a/stm-ltd/src/Control/Concurrent/STM/Class.hs b/stm-ltd/src/Control/Concurrent/STM/Class.hs index 11ee3a802f156b4c22b416d14b28e7857a6737e3..e829b20ef484508806e779a41b1e32774ac47e0f 100644 --- a/stm-ltd/src/Control/Concurrent/STM/Class.hs +++ b/stm-ltd/src/Control/Concurrent/STM/Class.hs @@ -15,6 +15,8 @@ module Control.Concurrent.STM.Class ( -- ** STM' STM', runSTM', + atomically', + -- *** Capabilities RetryMode(..), CanRetry, @@ -132,6 +134,7 @@ import Control.Concurrent.STM (STM) import Control.Concurrent.STM qualified as STM import Control.Concurrent.STM.Class.TH import Control.Monad.Catch +import Control.Monad.IO.Class import Control.Monad.Fix (MonadFix) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.RWS (RWST) @@ -235,6 +238,11 @@ runSTM' :: MonadSTM m => STM' r t a -> m a runSTM' (STM' f) = liftSTM f {-# INLINABLE runSTM' #-} +atomically' :: MonadIO m => STM' CanRetry CanThrow a -> m a +atomically' = liftIO . STM.atomically . runSTM' +{-# INLINABLE atomically' #-} + + noRetry :: MonadSTM' r t m => STM' NoRetry t a -> m a noRetry = unsafeLimitSTM . runSTM' {-# INLINABLE noRetry #-}