From 32a689380dfe9135f76f5159351e3dd2febdc943 Mon Sep 17 00:00:00 2001 From: Nitin Prakash Date: Fri, 10 May 2024 12:03:00 +0530 Subject: [PATCH] Add missing writeTMVar to MonadSTM --- io-classes-mtl/src/Control/Monad/Class/MonadSTM/Trans.hs | 8 ++++++++ io-classes/src/Control/Concurrent/Class/MonadSTM/TMVar.hs | 1 + io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs | 7 +++++++ io-sim/src/Control/Monad/IOSim/Types.hs | 1 + .../src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs | 4 ++++ 5 files changed, 21 insertions(+) diff --git a/io-classes-mtl/src/Control/Monad/Class/MonadSTM/Trans.hs b/io-classes-mtl/src/Control/Monad/Class/MonadSTM/Trans.hs index 3ef9419f..a1c8fff4 100644 --- a/io-classes-mtl/src/Control/Monad/Class/MonadSTM/Trans.hs +++ b/io-classes-mtl/src/Control/Monad/Class/MonadSTM/Trans.hs @@ -106,6 +106,7 @@ instance MonadSTM m => MonadSTM (ContT r m) where readTMVar = ContTSTM . readTMVar tryReadTMVar = ContTSTM . tryReadTMVar swapTMVar = ContTSTM .: swapTMVar + writeTMVar = ContTSTM .: writeTMVar isEmptyTMVar = ContTSTM . isEmptyTMVar type TQueue (ContT r m) = TQueue m @@ -183,6 +184,7 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.WriterT w m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (Lazy.WriterT w m) = TQueue m @@ -260,6 +262,7 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Strict.WriterT w m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (Strict.WriterT w m) = TQueue m @@ -337,6 +340,7 @@ instance MonadSTM m => MonadSTM (Lazy.StateT s m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (Lazy.StateT s m) = TQueue m @@ -414,6 +418,7 @@ instance MonadSTM m => MonadSTM (Strict.StateT s m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (Strict.StateT s m) = TQueue m @@ -491,6 +496,7 @@ instance MonadSTM m => MonadSTM (ExceptT e m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (ExceptT e m) = TQueue m @@ -568,6 +574,7 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.RWST r w s m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (Lazy.RWST r w s m) = TQueue m @@ -645,6 +652,7 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Strict.RWST r w s m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (Strict.RWST r w s m) = TQueue m diff --git a/io-classes/src/Control/Concurrent/Class/MonadSTM/TMVar.hs b/io-classes/src/Control/Concurrent/Class/MonadSTM/TMVar.hs index 81f06e8b..389ec115 100644 --- a/io-classes/src/Control/Concurrent/Class/MonadSTM/TMVar.hs +++ b/io-classes/src/Control/Concurrent/Class/MonadSTM/TMVar.hs @@ -16,6 +16,7 @@ module Control.Concurrent.Class.MonadSTM.TMVar , readTMVar , tryReadTMVar , swapTMVar + , writeTMVar , isEmptyTMVar -- * MonadLabelledSTM , labelTMVar diff --git a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs index 258862df..679eb070 100644 --- a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs +++ b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs @@ -45,6 +45,7 @@ module Control.Monad.Class.MonadSTM.Internal , readTMVarDefault , tryReadTMVarDefault , swapTMVarDefault + , writeTMVarDefault , isEmptyTMVarDefault , labelTMVarDefault , traceTMVarDefault @@ -189,6 +190,7 @@ class (Monad m, Monad (STM m)) => MonadSTM m where readTMVar :: TMVar m a -> STM m a tryReadTMVar :: TMVar m a -> STM m (Maybe a) swapTMVar :: TMVar m a -> a -> STM m a + writeTMVar :: TMVar m a -> a -> STM m () isEmptyTMVar :: TMVar m a -> STM m Bool type TQueue m :: Type -> Type @@ -569,6 +571,7 @@ instance MonadSTM IO where readTMVar = STM.readTMVar tryReadTMVar = STM.tryReadTMVar swapTMVar = STM.swapTMVar + writeTMVar = STM.writeTMVar isEmptyTMVar = STM.isEmptyTMVar newTQueue = STM.newTQueue readTQueue = STM.readTQueue @@ -740,6 +743,9 @@ swapTMVarDefault (TMVar t) new = do Nothing -> retry Just old -> do writeTVar t (Just new); return old +writeTMVarDefault :: MonadSTM m => TMVarDefault m a -> a -> STM m () +writeTMVarDefault (TMVar t) new = writeTVar t (Just new) + isEmptyTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m Bool isEmptyTMVarDefault (TMVar t) = do m <- readTVar t @@ -1188,6 +1194,7 @@ instance MonadSTM m => MonadSTM (ReaderT r m) where readTMVar = lift . readTMVar tryReadTMVar = lift . tryReadTMVar swapTMVar = lift .: swapTMVar + writeTMVar = lift .: writeTMVar isEmptyTMVar = lift . isEmptyTMVar type TQueue (ReaderT r m) = TQueue m diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index 8d1855ed..01dea2ad 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -516,6 +516,7 @@ instance MonadSTM (IOSim s) where readTMVar = MonadSTM.readTMVarDefault tryReadTMVar = MonadSTM.tryReadTMVarDefault swapTMVar = MonadSTM.swapTMVarDefault + writeTMVar = MonadSTM.writeTMVarDefault isEmptyTMVar = MonadSTM.isEmptyTMVarDefault newTQueue = newTQueueDefault diff --git a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs index 56aec9f3..c2d9f217 100644 --- a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs +++ b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs @@ -23,6 +23,7 @@ module Control.Concurrent.Class.MonadSTM.Strict.TMVar , readTMVar , tryReadTMVar , swapTMVar + , writeTMVar , isEmptyTMVar -- * MonadLabelledSTM , labelTMVar @@ -101,5 +102,8 @@ tryReadTMVar (StrictTMVar tmvar) = Lazy.tryReadTMVar tmvar swapTMVar :: MonadSTM m => StrictTMVar m a -> a -> STM m a swapTMVar (StrictTMVar tmvar) !a = Lazy.swapTMVar tmvar a +writeTMVar :: MonadSTM m => StrictTMVar m a -> a -> STM m () +writeTMVar (StrictTMVar tmvar) !a = Lazy.writeTMVar tmvar a + isEmptyTMVar :: MonadSTM m => StrictTMVar m a -> STM m Bool isEmptyTMVar (StrictTMVar tmvar) = Lazy.isEmptyTMVar tmvar