diff --git a/io-classes/CHANGELOG.md b/io-classes/CHANGELOG.md index 8016cc98..68f71634 100644 --- a/io-classes/CHANGELOG.md +++ b/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 diff --git a/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs b/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs index 5af9b75b..6d3a2db0 100644 --- a/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs +++ b/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) diff --git a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs index b7ed593c..1faf7e9f 100644 --- a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs +++ b/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)