Added transformer instances for MonadInspectSTM and MonadTraceSTM

* ContT
* ReaderT
* WriterT
* StateT
* RWST

io-classes/CHANGELOG.md

@@ -7,6 +7,11 @@
 * Added `threadLabel` to `MonadThread`
 * Added `MonadLabelledMVar` class.
 
+### Non-breaking changes
+
+* Added monad transformer instances for `MonadInspectSTM` & `MonadTraceSTM`
+  type classes.
+
 ### 1.7.0.0
 
 ### Breaking changes

io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TypeFamilies               #-}
 
@@ -31,6 +32,7 @@ import Control.Monad.Class.MonadThrow qualified as MonadThrow
 import Data.Array.Base (MArray (..))
 import Data.Function (on)
 import Data.Kind (Type)
+import Data.Proxy (Proxy (..))
 
 
 -- | A newtype wrapper for an 'STM' monad for 'ContT'
@@ -161,6 +163,19 @@ instance MonadSTM m => MonadSTM (ContT r m) where
     isEmptyTChan      = ContTSTM .  isEmptyTChan
 
 
+instance MonadInspectSTM m => MonadInspectSTM (ContT r m) where
+  type InspectMonad (ContT r m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance MonadTraceSTM m => MonadTraceSTM (ContT r m) where
+  traceTVar    _ = ContTSTM .: traceTVar    Proxy
+  traceTMVar   _ = ContTSTM .: traceTMVar   Proxy
+  traceTQueue  _ = ContTSTM .: traceTQueue  Proxy
+  traceTBQueue _ = ContTSTM .: traceTBQueue Proxy
+  traceTSem    _ = ContTSTM .: traceTSem    Proxy
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.WriterT w m) where
@@ -239,6 +254,19 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.WriterT w m) where
     isEmptyTChan      = lift .  isEmptyTChan
 
 
+instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Lazy.WriterT w m) where
+  type InspectMonad (Lazy.WriterT w m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.WriterT w m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Strict.WriterT w m) where
@@ -317,6 +345,19 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Strict.WriterT w m) where
     isEmptyTChan      = lift .  isEmptyTChan
 
 
+instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Strict.WriterT w m) where
+  type InspectMonad (Strict.WriterT w m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.WriterT w m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance MonadSTM m => MonadSTM (Lazy.StateT s m) where
@@ -395,6 +436,19 @@ instance MonadSTM m => MonadSTM (Lazy.StateT s m) where
     isEmptyTChan      = lift .  isEmptyTChan
 
 
+instance MonadInspectSTM m => MonadInspectSTM (Lazy.StateT s m) where
+  type InspectMonad (Lazy.StateT s m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance MonadTraceSTM m => MonadTraceSTM (Lazy.StateT s m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance MonadSTM m => MonadSTM (Strict.StateT s m) where
@@ -473,6 +527,19 @@ instance MonadSTM m => MonadSTM (Strict.StateT s m) where
     isEmptyTChan      = lift .  isEmptyTChan
 
 
+instance MonadInspectSTM m => MonadInspectSTM (Strict.StateT s m) where
+  type InspectMonad (Strict.StateT s m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance MonadTraceSTM m => MonadTraceSTM (Strict.StateT s m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance MonadSTM m => MonadSTM (ExceptT e m) where
@@ -551,6 +618,19 @@ instance MonadSTM m => MonadSTM (ExceptT e m) where
     isEmptyTChan      = lift .  isEmptyTChan
 
 
+instance MonadInspectSTM m => MonadInspectSTM (ExceptT e m) where
+  type InspectMonad (ExceptT e m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance MonadTraceSTM m => MonadTraceSTM (ExceptT e m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.RWST r w s m) where
@@ -629,6 +709,19 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.RWST r w s m) where
     isEmptyTChan      = lift .  isEmptyTChan
 
 
+instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Lazy.RWST r w s m) where
+  type InspectMonad (Lazy.RWST r w s m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.RWST r w s m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Strict.RWST r w s m) where
@@ -707,5 +800,18 @@ instance (Monoid w, MonadSTM m) => MonadSTM (Strict.RWST r w s m) where
     isEmptyTChan      = lift .  isEmptyTChan
 
 
+instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Strict.RWST r w s m) where
+  type InspectMonad (Strict.RWST r w s m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.RWST r w s m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
+
+
 (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
 (f .: g) x y = f (g x y)

io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs

@@ -1247,6 +1247,17 @@ instance MonadSTM m => MonadSTM (ReaderT r m) where
     unGetTChan        = lift .: unGetTChan
     isEmptyTChan      = lift .  isEmptyTChan
 
+instance MonadInspectSTM m => MonadInspectSTM (ReaderT r m) where
+  type InspectMonad (ReaderT r m) = InspectMonad m
+  inspectTVar  _ = inspectTVar  (Proxy :: Proxy m)
+  inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
+
+instance MonadTraceSTM m => MonadTraceSTM (ReaderT r m) where
+  traceTVar    _ = lift .: traceTVar    Proxy
+  traceTMVar   _ = lift .: traceTMVar   Proxy
+  traceTQueue  _ = lift .: traceTQueue  Proxy
+  traceTBQueue _ = lift .: traceTBQueue Proxy
+  traceTSem    _ = lift .: traceTSem    Proxy
 
 (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
 (f .: g) x y = f (g x y)