Skip to content

Commit 753d63f

Browse files
cootcoot
committed
Added transformer instances for MonadInspectSTM and MonadTraceSTM
* ContT * ReaderT * Lazy.WriterT * Strict.WriterT * Lazy.StateT * Strict.StateT * ExceptT * Lazy.RWST * Strict.RWST
1 parent db0e67c commit 753d63f

File tree

3 files changed

+123
-0
lines changed

3 files changed

+123
-0
lines changed

‎io-classes/CHANGELOG.md

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,11 @@
77
* Added `threadLabel` to `MonadThread`
88
* Added `MonadLabelledMVar` class.
99

10+
### Non-breaking changes
11+
12+
* Added monad transformer instances for `MonadInspectSTM` & `MonadTraceSTM`
13+
type classes.
14+
1015
### 1.7.0.0
1116

1217
### Breaking changes

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

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,9 @@
55
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
66
{-# LANGUAGE KindSignatures #-}
77
{-# LANGUAGE MultiParamTypeClasses #-}
8+
{-# LANGUAGE ScopedTypeVariables #-}
89
{-# LANGUAGE StandaloneDeriving #-}
10+
{-# LANGUAGE TypeApplications #-}
911
{-# LANGUAGE TypeFamilies #-}
1012

1113
-- undecidable instances needed for 'ContTSTM' instances of
@@ -31,6 +33,7 @@ import Control.Monad.Class.MonadThrow qualified as MonadThrow
3133
import Data.Array.Base (MArray (..))
3234
import Data.Function (on)
3335
import Data.Kind (Type)
36+
import Data.Proxy (Proxy (..))
3437

3538

3639
-- | A newtype wrapper for an 'STM' monad for 'ContT'
@@ -161,6 +164,19 @@ instance MonadSTM m => MonadSTM (ContT r m) where
161164
isEmptyTChan = ContTSTM . isEmptyTChan
162165

163166

167+
instance MonadInspectSTM m => MonadInspectSTM (ContT r m) where
168+
type InspectMonad (ContT r m) = InspectMonad m
169+
inspectTVar _ = inspectTVar (Proxy @m)
170+
inspectTMVar _ = inspectTMVar (Proxy @m)
171+
172+
instance MonadTraceSTM m => MonadTraceSTM (ContT r m) where
173+
traceTVar _ = ContTSTM .: traceTVar (Proxy @m)
174+
traceTMVar _ = ContTSTM .: traceTMVar (Proxy @m)
175+
traceTQueue _ = ContTSTM .: traceTQueue (Proxy @m)
176+
traceTBQueue _ = ContTSTM .: traceTBQueue (Proxy @m)
177+
traceTSem _ = ContTSTM .: traceTSem (Proxy @m)
178+
179+
164180
-- | The underlying stm monad is also transformed.
165181
--
166182
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
239255
isEmptyTChan = lift . isEmptyTChan
240256

241257

258+
instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Lazy.WriterT w m) where
259+
type InspectMonad (Lazy.WriterT w m) = InspectMonad m
260+
inspectTVar _ = inspectTVar (Proxy @m)
261+
inspectTMVar _ = inspectTMVar (Proxy @m)
262+
263+
instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.WriterT w m) where
264+
traceTVar _ = lift .: traceTVar (Proxy @m)
265+
traceTMVar _ = lift .: traceTMVar (Proxy @m)
266+
traceTQueue _ = lift .: traceTQueue (Proxy @m)
267+
traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
268+
traceTSem _ = lift .: traceTSem (Proxy @m)
269+
270+
242271
-- | The underlying stm monad is also transformed.
243272
--
244273
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
317346
isEmptyTChan = lift . isEmptyTChan
318347

319348

349+
instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Strict.WriterT w m) where
350+
type InspectMonad (Strict.WriterT w m) = InspectMonad m
351+
inspectTVar _ = inspectTVar (Proxy @m)
352+
inspectTMVar _ = inspectTMVar (Proxy @m)
353+
354+
instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.WriterT w m) where
355+
traceTVar _ = lift .: traceTVar (Proxy @m)
356+
traceTMVar _ = lift .: traceTMVar (Proxy @m)
357+
traceTQueue _ = lift .: traceTQueue (Proxy @m)
358+
traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
359+
traceTSem _ = lift .: traceTSem (Proxy @m)
360+
361+
320362
-- | The underlying stm monad is also transformed.
321363
--
322364
instance MonadSTM m => MonadSTM (Lazy.StateT s m) where
@@ -395,6 +437,19 @@ instance MonadSTM m => MonadSTM (Lazy.StateT s m) where
395437
isEmptyTChan = lift . isEmptyTChan
396438

397439

440+
instance MonadInspectSTM m => MonadInspectSTM (Lazy.StateT s m) where
441+
type InspectMonad (Lazy.StateT s m) = InspectMonad m
442+
inspectTVar _ = inspectTVar (Proxy @m)
443+
inspectTMVar _ = inspectTMVar (Proxy @m)
444+
445+
instance MonadTraceSTM m => MonadTraceSTM (Lazy.StateT s m) where
446+
traceTVar _ = lift .: traceTVar (Proxy @m)
447+
traceTMVar _ = lift .: traceTMVar (Proxy @m)
448+
traceTQueue _ = lift .: traceTQueue (Proxy @m)
449+
traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
450+
traceTSem _ = lift .: traceTSem (Proxy @m)
451+
452+
398453
-- | The underlying stm monad is also transformed.
399454
--
400455
instance MonadSTM m => MonadSTM (Strict.StateT s m) where
@@ -473,6 +528,19 @@ instance MonadSTM m => MonadSTM (Strict.StateT s m) where
473528
isEmptyTChan = lift . isEmptyTChan
474529

475530

531+
instance MonadInspectSTM m => MonadInspectSTM (Strict.StateT s m) where
532+
type InspectMonad (Strict.StateT s m) = InspectMonad m
533+
inspectTVar _ = inspectTVar (Proxy @m)
534+
inspectTMVar _ = inspectTMVar (Proxy @m)
535+
536+
instance MonadTraceSTM m => MonadTraceSTM (Strict.StateT s m) where
537+
traceTVar _ = lift .: traceTVar (Proxy @m)
538+
traceTMVar _ = lift .: traceTMVar (Proxy @m)
539+
traceTQueue _ = lift .: traceTQueue (Proxy @m)
540+
traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
541+
traceTSem _ = lift .: traceTSem (Proxy @m)
542+
543+
476544
-- | The underlying stm monad is also transformed.
477545
--
478546
instance MonadSTM m => MonadSTM (ExceptT e m) where
@@ -551,6 +619,19 @@ instance MonadSTM m => MonadSTM (ExceptT e m) where
551619
isEmptyTChan = lift . isEmptyTChan
552620

553621

622+
instance MonadInspectSTM m => MonadInspectSTM (ExceptT e m) where
623+
type InspectMonad (ExceptT e m) = InspectMonad m
624+
inspectTVar _ = inspectTVar (Proxy @m)
625+
inspectTMVar _ = inspectTMVar (Proxy @m)
626+
627+
instance MonadTraceSTM m => MonadTraceSTM (ExceptT e m) where
628+
traceTVar _ = lift .: traceTVar (Proxy @m)
629+
traceTMVar _ = lift .: traceTMVar (Proxy @m)
630+
traceTQueue _ = lift .: traceTQueue (Proxy @m)
631+
traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
632+
traceTSem _ = lift .: traceTSem (Proxy @m)
633+
634+
554635
-- | The underlying stm monad is also transformed.
555636
--
556637
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
629710
isEmptyTChan = lift . isEmptyTChan
630711

631712

713+
instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Lazy.RWST r w s m) where
714+
type InspectMonad (Lazy.RWST r w s m) = InspectMonad m
715+
inspectTVar _ = inspectTVar (Proxy @m)
716+
inspectTMVar _ = inspectTMVar (Proxy @m)
717+
718+
instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Lazy.RWST r w s m) where
719+
traceTVar _ = lift .: traceTVar (Proxy @m)
720+
traceTMVar _ = lift .: traceTMVar (Proxy @m)
721+
traceTQueue _ = lift .: traceTQueue (Proxy @m)
722+
traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
723+
traceTSem _ = lift .: traceTSem (Proxy @m)
724+
725+
632726
-- | The underlying stm monad is also transformed.
633727
--
634728
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
707801
isEmptyTChan = lift . isEmptyTChan
708802

709803

804+
instance (Monoid w, MonadInspectSTM m) => MonadInspectSTM (Strict.RWST r w s m) where
805+
type InspectMonad (Strict.RWST r w s m) = InspectMonad m
806+
inspectTVar _ = inspectTVar (Proxy @m)
807+
inspectTMVar _ = inspectTMVar (Proxy @m)
808+
809+
instance (Monoid w, MonadTraceSTM m) => MonadTraceSTM (Strict.RWST r w s m) where
810+
traceTVar _ = lift .: traceTVar (Proxy @m)
811+
traceTMVar _ = lift .: traceTMVar (Proxy @m)
812+
traceTQueue _ = lift .: traceTQueue (Proxy @m)
813+
traceTBQueue _ = lift .: traceTBQueue (Proxy @m)
814+
traceTSem _ = lift .: traceTSem (Proxy @m)
815+
816+
710817
(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
711818
(f .: g) x y = f (g x y)

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

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1247,6 +1247,17 @@ instance MonadSTM m => MonadSTM (ReaderT r m) where
12471247
unGetTChan = lift .: unGetTChan
12481248
isEmptyTChan = lift . isEmptyTChan
12491249

1250+
instance MonadInspectSTM m => MonadInspectSTM (ReaderT r m) where
1251+
type InspectMonad (ReaderT r m) = InspectMonad m
1252+
inspectTVar _ = inspectTVar (Proxy :: Proxy m)
1253+
inspectTMVar _ = inspectTMVar (Proxy :: Proxy m)
1254+
1255+
instance MonadTraceSTM m => MonadTraceSTM (ReaderT r m) where
1256+
traceTVar _ = lift .: traceTVar Proxy
1257+
traceTMVar _ = lift .: traceTMVar Proxy
1258+
traceTQueue _ = lift .: traceTQueue Proxy
1259+
traceTBQueue _ = lift .: traceTBQueue Proxy
1260+
traceTSem _ = lift .: traceTSem Proxy
12501261

12511262
(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
12521263
(f .: g) x y = f (g x y)

0 commit comments

Comments
 (0)