Added transformer instances for MonadInspectSTM and MonadTraceSTM

* ContT
* ReaderT
* Lazy.WriterT
* Strict.WriterT
* Lazy.StateT
* Strict.StateT
* ExceptT
* Lazy.RWST
* Strict.RWST

Author: coot

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,7 +5,9 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
 
 -- undecidable instances needed for 'ContTSTM' instances of
@@ -31,6 +33,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 +164,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance MonadTraceSTM m => MonadTraceSTM (ContT r m) where
+  traceTVar    _ = ContTSTM .: traceTVar    (Proxy @m)
+  traceTMVar   _ = ContTSTM .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = ContTSTM .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = ContTSTM .: traceTBQueue (Proxy @m)
+  traceTSem    _ = ContTSTM .: traceTSem    (Proxy @m)
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.WriterT w m) where
@@ -239,6 +255,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.WriterT w m) where
+  traceTVar    _ = lift .: traceTVar    (Proxy @m)
+  traceTMVar   _ = lift .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = lift .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
+  traceTSem    _ = lift .: traceTSem    (Proxy @m)
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Strict.WriterT w m) where
@@ -317,6 +346,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.WriterT w m) where
+  traceTVar    _ = lift .: traceTVar    (Proxy @m)
+  traceTMVar   _ = lift .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = lift .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
+  traceTSem    _ = lift .: traceTSem    (Proxy @m)
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance MonadSTM m => MonadSTM (Lazy.StateT s m) where
@@ -395,6 +437,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance MonadTraceSTM m => MonadTraceSTM (Lazy.StateT s m) where
+  traceTVar    _ = lift .: traceTVar    (Proxy @m)
+  traceTMVar   _ = lift .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = lift .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
+  traceTSem    _ = lift .: traceTSem    (Proxy @m)
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance MonadSTM m => MonadSTM (Strict.StateT s m) where
@@ -473,6 +528,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance MonadTraceSTM m => MonadTraceSTM (Strict.StateT s m) where
+  traceTVar    _ = lift .: traceTVar    (Proxy @m)
+  traceTMVar   _ = lift .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = lift .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
+  traceTSem    _ = lift .: traceTSem    (Proxy @m)
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance MonadSTM m => MonadSTM (ExceptT e m) where
@@ -551,6 +619,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance MonadTraceSTM m => MonadTraceSTM (ExceptT e m) where
+  traceTVar    _ = lift .: traceTVar    (Proxy @m)
+  traceTMVar   _ = lift .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = lift .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
+  traceTSem    _ = lift .: traceTSem    (Proxy @m)
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Lazy.RWST r w s m) where
@@ -629,6 +710,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.RWST r w s m) where
+  traceTVar    _ = lift .: traceTVar    (Proxy @m)
+  traceTMVar   _ = lift .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = lift .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
+  traceTSem    _ = lift .: traceTSem    (Proxy @m)
+
+
 -- | The underlying stm monad is also transformed.
 --
 instance (Monoid w, MonadSTM m) => MonadSTM (Strict.RWST r w s m) where
@@ -707,5 +801,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 @m)
+  inspectTMVar _ = inspectTMVar (Proxy @m)
+
+instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.RWST r w s m) where
+  traceTVar    _ = lift .: traceTVar    (Proxy @m)
+  traceTMVar   _ = lift .: traceTMVar   (Proxy @m)
+  traceTQueue  _ = lift .: traceTQueue  (Proxy @m)
+  traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
+  traceTSem    _ = lift .: traceTSem    (Proxy @m)
+
+
 (.:) :: (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)