Add missing writeTMVar to MonadSTM

input-output-hk · May 10, 2024 · 32a6893 · 32a6893
1 parent c75ca9a
commit 32a6893
Show file tree

Hide file tree

Showing 5 changed files with 21 additions and 0 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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