diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,10 @@
+## [0.2] - 2023-07-31
+
+- fix "Prod" type, add more functions
+- WithT: rename from TransformT, add more instances & functions
+- refRestore etc.: more general because no masking of async exceptions
+- remove some unnecessary classes and constraints
+
 ## [0.1] - 2022-09-12
 
 - initial release
diff --git a/monadology.cabal b/monadology.cabal
--- a/monadology.cabal
+++ b/monadology.cabal
@@ -1,20 +1,26 @@
 cabal-version: 2.2
 
--- This file has been generated from package.yaml by hpack version 0.34.4.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
 name:           monadology
-version:        0.1
+version:        0.2
+synopsis:       The best ideas in monad-related classes and types.
 description:    Monadology is intended as a collection of the best ideas in monad-related classes and types, with a focus on correctness and elegance, and theoretical understanding, rather than practical performance.
+category:       Monads
 homepage:       https://github.com/AshleyYakeley/monadology#readme
 bug-reports:    https://github.com/AshleyYakeley/monadology/issues
 author:         Ashley Yakeley
 maintainer:     <ashley@semantic.org>
-copyright:      (c) 2017-2022 Ashley Yakeley
+copyright:      (c) 2017-2023 Ashley Yakeley
 license:        BSD-2-Clause
 license-file:   LICENSE
 build-type:     Simple
+tested-with:
+    GHC == 9.2.8
+  , GHC == 9.4.5
+  , GHC == 9.6.2
 extra-source-files:
     changelog.md
 
@@ -56,7 +62,7 @@
       Control.Monad.Ology.Specific.ContT
       Control.Monad.Ology.Specific.ReaderStateT
       Control.Monad.Ology.Specific.StackT
-      Control.Monad.Ology.Specific.TransformT
+      Control.Monad.Ology.Specific.WithT
       Control.Monad.Ology.Specific.ResultT
       Control.Monad.Ology.Specific.StepT
       Control.Monad.Ology.Specific.CoroutineT
@@ -137,6 +143,7 @@
       Compose
       Coroutine
       Lifecycle
+      Data
   hs-source-dirs:
       test
   default-extensions:
@@ -191,5 +198,6 @@
     , monadology
     , tasty >=1.4
     , tasty-hunit >=0.10
+    , text >=2.0
     , transformers >=0.5
   default-language: Haskell2010
diff --git a/src/Control/Monad/Ology.hs b/src/Control/Monad/Ology.hs
--- a/src/Control/Monad/Ology.hs
+++ b/src/Control/Monad/Ology.hs
@@ -20,5 +20,5 @@
 import Control.Monad.Ology.Specific.StackT as I
 import Control.Monad.Ology.Specific.StateT as I
 import Control.Monad.Ology.Specific.StepT as I
-import Control.Monad.Ology.Specific.TransformT as I
+import Control.Monad.Ology.Specific.WithT as I
 import Control.Monad.Ology.Specific.WriterT as I
diff --git a/src/Control/Monad/Ology/Data/Param.hs b/src/Control/Monad/Ology/Data/Param.hs
--- a/src/Control/Monad/Ology/Data/Param.hs
+++ b/src/Control/Monad/Ology/Data/Param.hs
@@ -20,14 +20,22 @@
     rUnit = MkParam (pure ()) (\() -> id)
     pa <***> pb = MkParam (liftA2 (,) (paramAsk pa) (paramAsk pb)) (\(a, b) -> paramWith pa a . paramWith pb b)
 
+paramLocalM ::
+       forall m a. Monad m
+    => Param m a
+    -> (a -> m a)
+    -> m --> m
+paramLocalM param f mr = do
+    a <- paramAsk param
+    a' <- f a
+    paramWith param a' mr
+
 paramLocal ::
        forall m a. Monad m
     => Param m a
     -> (a -> a)
     -> m --> m
-paramLocal param f mr = do
-    a <- paramAsk param
-    paramWith param (f a) mr
+paramLocal param f mr = paramLocalM param (return . f) mr
 
 lensMapParam ::
        forall m a b. Monad m
diff --git a/src/Control/Monad/Ology/Data/Prod.hs b/src/Control/Monad/Ology/Data/Prod.hs
--- a/src/Control/Monad/Ology/Data/Prod.hs
+++ b/src/Control/Monad/Ology/Data/Prod.hs
@@ -1,5 +1,6 @@
 module Control.Monad.Ology.Data.Prod where
 
+import Control.Monad.Ology.Data.Param
 import Control.Monad.Ology.General
 import Control.Monad.Ology.Specific.WriterT
 import Import
@@ -7,7 +8,7 @@
 -- | A product of a monad (as in 'WriterT').
 data Prod m a = MkProd
     { prodTell :: a -> m ()
-    , prodListen :: forall r. m r -> m (r, a)
+    , prodCollect :: forall r. m r -> m (r, a)
     }
 
 instance Functor m => Invariant (Prod m) where
@@ -16,30 +17,72 @@
 instance Applicative m => Productable (Prod m) where
     rUnit = MkProd (\() -> pure ()) $ fmap $ \r -> (r, ())
     (<***>) :: forall a b. Prod m a -> Prod m b -> Prod m (a, b)
-    MkProd tellA listenA <***> MkProd tellB listenB = let
+    MkProd tellA collectA <***> MkProd tellB collectB = let
         tellAB :: (a, b) -> m ()
         tellAB (a, b) = tellA a *> tellB b
-        listenAB :: m r -> m (r, (a, b))
-        listenAB m = fmap (\((r, a), b) -> (r, (a, b))) $ listenB (listenA m)
-        in MkProd tellAB listenAB
+        collectAB :: m r -> m (r, (a, b))
+        collectAB m = fmap (\((r, a), b) -> (r, (a, b))) $ collectB (collectA m)
+        in MkProd tellAB collectAB
 
-prodListen_ :: Functor m => Prod m a -> m () -> m a
+prodCollect_ :: Functor m => Prod m a -> m () -> m a
+prodCollect_ p mu = fmap snd $ prodCollect p mu
+
+prodListen :: Monad m => Prod m a -> forall r. m r -> m (r, a)
+prodListen p mr = do
+    (r, a) <- prodCollect p mr
+    prodTell p a
+    return (r, a)
+
+prodListen_ :: Monad m => Prod m a -> m () -> m a
 prodListen_ p mu = fmap snd $ prodListen p mu
 
+prodPass :: Monad m => Prod m a -> m (r, a -> a) -> m r
+prodPass p mraa = do
+    ((r, f), a) <- prodCollect p mraa
+    prodTell p $ f a
+    return r
+
+prodCensor :: Monad m => Prod m a -> (a -> a) -> m --> m
+prodCensor p f mr = do
+    (r, a) <- prodCollect p mr
+    prodTell p $ f a
+    return r
+
+prodTellItem :: Applicative f => Prod m (f a) -> a -> m ()
+prodTellItem p a = prodTell p $ pure a
+
+prodCensorItems :: (Monad f, Monad m) => Prod m (f a) -> (a -> f a) -> m --> m
+prodCensorItems p afa = prodCensor p $ \fa -> fa >>= afa
+
+lensMapProd ::
+       forall m a b. (Monad m, Monoid a, Monoid b)
+    => Lens' a b
+    -> Prod m a
+    -> Prod m b
+lensMapProd l p = let
+    prodTell' :: b -> m ()
+    prodTell' b = prodTell p $ runIdentity $ l (\_ -> Identity b) mempty
+    prodCollect' :: forall r. m r -> m (r, b)
+    prodCollect' mr = do
+        (r, a) <- prodCollect p mr
+        prodTell p $ runIdentity $ l (\_ -> Identity mempty) a
+        return (r, getConst $ l Const a)
+    in MkProd prodTell' prodCollect'
+
 liftProd :: (MonadTransTunnel t, Monad m) => Prod m --> Prod (t m)
 liftProd (MkProd t l) =
     MkProd (\a -> lift $ t a) $ \tmr -> tunnel $ \unlift -> fmap (\(tun, a) -> fmap (\r -> (r, a)) tun) $ l $ unlift tmr
 
-writerProd :: Monad m => Prod (WriterT w m) w
-writerProd = MkProd {prodTell = tell, prodListen = listen}
+writerProd :: (Monad m, Monoid w) => Prod (WriterT w m) w
+writerProd = MkProd {prodTell = tell, prodCollect = collect}
 
 foldProd ::
        forall f m a. (Applicative f, Foldable f, Applicative m)
     => Prod m a
     -> Prod m (f a)
-foldProd (MkProd prodTell prodListen) = let
+foldProd (MkProd prodTell prodCollect) = let
     prodTell' :: f a -> m ()
     prodTell' aa = for_ aa prodTell
-    prodListen' :: forall r. m r -> m (r, f a)
-    prodListen' mr = fmap (\(r, a) -> (r, pure a)) $ prodListen mr
-    in MkProd prodTell' prodListen'
+    prodCollect' :: forall r. m r -> m (r, f a)
+    prodCollect' mr = fmap (\(r, a) -> (r, pure a)) $ prodCollect mr
+    in MkProd prodTell' prodCollect'
diff --git a/src/Control/Monad/Ology/Data/Ref.hs b/src/Control/Monad/Ology/Data/Ref.hs
--- a/src/Control/Monad/Ology/Data/Ref.hs
+++ b/src/Control/Monad/Ology/Data/Ref.hs
@@ -36,8 +36,8 @@
     refPut ref a'
 
 -- | Restore the original value of this reference after the operation.
-refRestore :: (MonadUnliftIO m, MonadException m) => Ref m a -> m --> m
-refRestore ref mr = bracket (refGet ref) (refPut ref) $ \_ -> mr
+refRestore :: MonadException m => Ref m a -> m --> m
+refRestore ref mr = bracketNoMask (refGet ref) (refPut ref) $ \_ -> mr
 
 lensMapRef ::
        forall m a b. Monad m
@@ -76,7 +76,7 @@
 
 -- | Use a reference as a parameter.
 refParam ::
-       forall m a. (MonadUnliftIO m, MonadException m)
+       forall m a. MonadException m
     => Ref m a
     -> Param m a
 refParam ref = let
@@ -90,13 +90,13 @@
 
 -- | Use a reference as a product.
 refProd ::
-       forall m a. (MonadUnliftIO m, MonadException m, Monoid a)
+       forall m a. (MonadException m, Monoid a)
     => Ref m a
     -> Prod m a
 refProd ref = let
     prodTell a = refModify ref $ (<>) a
-    prodListen :: forall r. m r -> m (r, a)
-    prodListen mr =
+    prodCollect :: forall r. m r -> m (r, a)
+    prodCollect mr =
         refRestore ref $ do
             refPut ref mempty
             r <- mr
diff --git a/src/Control/Monad/Ology/General/Coroutine.hs b/src/Control/Monad/Ology/General/Coroutine.hs
--- a/src/Control/Monad/Ology/General/Coroutine.hs
+++ b/src/Control/Monad/Ology/General/Coroutine.hs
@@ -33,7 +33,7 @@
                     putMVar outvar $ Left r
             takeMVar outvar
 
-instance (MonadTransUnlift t, MonadCoroutine m, MonadTunnelIOInner m, Monad (t m)) => MonadCoroutine (t m) where
+instance (MonadTransUnlift t, MonadCoroutine m, MonadTunnelIO m, Monad (t m)) => MonadCoroutine (t m) where
     coroutineSuspend call =
         MkStepT $
         liftWithUnlift $ \unlift ->
@@ -43,7 +43,7 @@
 -- 'System.IO.withFile',
 -- 'System.IO.withBinaryFile',
 -- etc.
-type With (m :: Type -> Type) (t :: Type) = forall (r :: Type). (t -> m r) -> m r
+type With (m :: k -> Type) (t :: Type) = forall (r :: k). (t -> m r) -> m r
 
 unpickWith ::
        forall m a. MonadCoroutine m
@@ -54,3 +54,13 @@
     case etp of
         Left a -> return (a, return ())
         Right (MkTurn a f) -> return (a, fmap (\_ -> ()) $ runCoroutine $ f a)
+
+pickWith ::
+       forall m a. Monad m
+    => m (a, m ())
+    -> With m a
+pickWith mac amr = do
+    (a, closer) <- mac
+    r <- amr a
+    closer
+    return r
diff --git a/src/Control/Monad/Ology/General/Exception.hs b/src/Control/Monad/Ology/General/Exception.hs
--- a/src/Control/Monad/Ology/General/Exception.hs
+++ b/src/Control/Monad/Ology/General/Exception.hs
@@ -49,3 +49,29 @@
     -> m ()
     -> m --> m
 bracket_ before after thing = bracket before (const after) (const thing)
+
+-- | Like 'bracket", but doesn\'t mask asynchronous exceptions.
+bracketNoMask ::
+       forall m a b. MonadException m
+    => m a
+    -> (a -> m ())
+    -> (a -> m b)
+    -> m b
+bracketNoMask before after thing = do
+    a <- before
+    b <- onException (thing a) (after a)
+    after a
+    return b
+
+-- | Like 'bracketNoMask", but doesn\'t catch any exceptions.
+bracketFake ::
+       forall m a b. Monad m
+    => m a
+    -> (a -> m ())
+    -> (a -> m b)
+    -> m b
+bracketFake before after thing = do
+    a <- before
+    b <- thing a
+    after a
+    return b
diff --git a/src/Control/Monad/Ology/General/Trans/Tunnel.hs b/src/Control/Monad/Ology/General/Trans/Tunnel.hs
--- a/src/Control/Monad/Ology/General/Trans/Tunnel.hs
+++ b/src/Control/Monad/Ology/General/Trans/Tunnel.hs
@@ -43,13 +43,12 @@
 
 -- | Commute two transformers in a transformer stack.
 commuteT ::
-       forall ta tb m. (MonadTransTunnel ta, MonadTransTunnel tb, Monad (Tunnel ta), MonadInner (Tunnel tb), Monad m)
+       forall ta tb m. (MonadTransTunnel ta, MonadTransTunnel tb, Monad m)
     => ta (tb m) --> tb (ta m)
 commuteT = commuteTWith commuteInner
 
 commuteTBack ::
-       forall ta tb m.
-       (MonadTransTunnel ta, MonadTransTunnel tb, MonadInner (Tunnel ta), MonadInner (Tunnel tb), Monad m)
+       forall ta tb m. (MonadTransTunnel ta, MonadTransTunnel tb, Monad m)
     => ta (tb m) -/-> tb (ta m)
 commuteTBack call = commuteT $ call commuteT
 
@@ -65,18 +64,10 @@
     type TunnelIO IO = Identity
     tunnelIO call = fmap runIdentity $ call $ \ma -> fmap Identity $ ma
 
-instance (MonadTransTunnel t, MonadInner (Tunnel t), MonadTunnelIO m, MonadIO (t m)) => MonadTunnelIO (t m) where
+instance (MonadTransTunnel t, MonadTunnelIO m, MonadIO (t m)) => MonadTunnelIO (t m) where
     type TunnelIO (t m) = ComposeInner (Tunnel t) (TunnelIO m)
     tunnelIO call =
         tunnel $ \unlift -> tunnelIO $ \unliftIO -> fmap unComposeInner $ call $ fmap MkComposeInner . unliftIO . unlift
 
-instance (MonadTransTunnel t, MonadInner (Tunnel t), TransConstraint MonadIO t) => TransConstraint MonadTunnelIO t where
-    hasTransConstraint = withTransConstraintDict @MonadIO Dict
-
--- | for use in 'WUnlift', etc.
-class (MonadTunnelIO m, MonadInner (TunnelIO m)) => MonadTunnelIOInner m
-
-instance (MonadTunnelIO m, MonadInner (TunnelIO m)) => MonadTunnelIOInner m
-
-instance (MonadTransTunnel t, MonadInner (Tunnel t), TransConstraint MonadIO t) => TransConstraint MonadTunnelIOInner t where
+instance (MonadTransTunnel t, TransConstraint MonadIO t) => TransConstraint MonadTunnelIO t where
     hasTransConstraint = withTransConstraintDict @MonadIO Dict
diff --git a/src/Control/Monad/Ology/General/Trans/Unlift.hs b/src/Control/Monad/Ology/General/Trans/Unlift.hs
--- a/src/Control/Monad/Ology/General/Trans/Unlift.hs
+++ b/src/Control/Monad/Ology/General/Trans/Unlift.hs
@@ -20,12 +20,12 @@
     -- | Lift with an unlifting function that accounts for the transformer's effects (using MVars where necessary).
     liftWithUnlift ::
            forall m r. MonadIO m
-        => (Unlift MonadTunnelIOInner t -> m r)
+        => (Unlift MonadTunnelIO t -> m r)
         -> t m r
     -- | Return an unlifting function that discards the transformer's effects (such as state change or output).
     getDiscardingUnlift ::
            forall m. Monad m
-        => t m (WUnlift MonadTunnelIOInner t)
+        => t m (WUnlift MonadTunnelIO t)
     getDiscardingUnlift = tunnel $ \unlift -> pure $ pure $ MkWUnlift $ \tma -> fmap mToValue $ unlift tma
 
 toDiscardingUnlift ::
@@ -37,7 +37,7 @@
     du tmr
 
 wLiftWithUnlift ::
-       forall t m. (MonadTransUnlift t, MonadTunnelIOInner m)
+       forall t m. (MonadTransUnlift t, MonadTunnelIO m)
     => WBackraised m (t m)
 wLiftWithUnlift = MkWBackraised $ \call -> liftWithUnlift $ \unlift -> call unlift
 
@@ -75,7 +75,7 @@
             return $ call $ extract . unComposeOuter
 
 monoHoist ::
-       forall (t :: TransKind) ma mb a b. (MonadTransUnlift t, MonadTunnelIOInner ma, MonadIO mb)
+       forall (t :: TransKind) ma mb a b. (MonadTransUnlift t, MonadTunnelIO ma, MonadIO mb)
     => (ma a -> mb b)
     -> (t ma a -> t mb b)
 monoHoist f tma = liftWithUnlift $ \unlift -> f $ unlift tma
diff --git a/src/Control/Monad/Ology/Specific/ComposeT.hs b/src/Control/Monad/Ology/Specific/ComposeT.hs
--- a/src/Control/Monad/Ology/Specific/ComposeT.hs
+++ b/src/Control/Monad/Ology/Specific/ComposeT.hs
@@ -35,7 +35,7 @@
         Dict -> MkComposeT $ lift ima
 
 liftOuterComposeTWithUnlift ::
-       forall outerT innerT m r. (MonadTransTunnel outerT, MonadTransUnlift innerT, MonadTunnelIOInner m)
+       forall outerT innerT m r. (MonadTransTunnel outerT, MonadTransUnlift innerT, MonadTunnelIO m)
     => ((forall a. ComposeT outerT innerT m a -> outerT m a) -> outerT m r)
     -> ComposeT outerT innerT m r
 liftOuterComposeTWithUnlift call =
@@ -45,11 +45,11 @@
             tunnel $ \tun -> liftWithUnlift $ \unlift -> tun $ call $ \(MkComposeT ttma) -> hoist unlift ttma
 
 liftInnerComposeTWithUnlift ::
-       forall outerT innerT m r. (MonadTransUnlift outerT, MonadTransUnlift innerT, MonadTunnelIOInner m)
+       forall outerT innerT m r. (MonadTransUnlift outerT, MonadTransUnlift innerT, MonadTunnelIO m)
     => ((forall a. ComposeT outerT innerT m a -> innerT m a) -> innerT m r)
     -> ComposeT outerT innerT m r
 liftInnerComposeTWithUnlift call =
-    case hasTransConstraint @MonadTunnelIOInner @innerT @m of
+    case hasTransConstraint @MonadTunnelIO @innerT @m of
         Dict -> MkComposeT $ liftWithUnlift $ \unlift -> call $ \(MkComposeT ttma) -> unlift ttma
 
 composeTUnlift ::
@@ -189,7 +189,7 @@
 instance (MonadTransUnlift outerT, MonadTransUnlift innerT) => MonadTransUnlift (ComposeT outerT innerT) where
     liftWithUnlift ::
            forall m r. MonadIO m
-        => (Unlift MonadTunnelIOInner (ComposeT outerT innerT) -> m r)
+        => (Unlift MonadTunnelIO (ComposeT outerT innerT) -> m r)
         -> ComposeT outerT innerT m r
     liftWithUnlift call =
         case hasTransConstraint @MonadIO @innerT @m of
@@ -197,11 +197,10 @@
                 MkComposeT $
                 liftWithUnlift $ \unlift1 ->
                     liftWithUnlift $ \unlift2 ->
-                        call $ \(MkComposeT t1t2ma) ->
-                            unlift2 $ withTransConstraintTM @MonadTunnelIOInner $ unlift1 t1t2ma
+                        call $ \(MkComposeT t1t2ma) -> unlift2 $ withTransConstraintTM @MonadTunnelIO $ unlift1 t1t2ma
     getDiscardingUnlift ::
            forall m. Monad m
-        => ComposeT outerT innerT m (WUnlift MonadTunnelIOInner (ComposeT outerT innerT))
+        => ComposeT outerT innerT m (WUnlift MonadTunnelIO (ComposeT outerT innerT))
     getDiscardingUnlift =
         case hasTransConstraint @Monad @innerT @m of
             Dict ->
diff --git a/src/Control/Monad/Ology/Specific/ReaderT.hs b/src/Control/Monad/Ology/Specific/ReaderT.hs
--- a/src/Control/Monad/Ology/Specific/ReaderT.hs
+++ b/src/Control/Monad/Ology/Specific/ReaderT.hs
@@ -79,7 +79,7 @@
 
 readerTUnliftToT ::
        forall t m. (MonadTransUnlift t, MonadTunnelIO m)
-    => ReaderT (WUnlift MonadTunnelIOInner t) m --> t m
+    => ReaderT (WUnlift MonadTunnelIO t) m --> t m
 readerTUnliftToT rma = liftWithUnlift $ \tr -> runReaderT rma $ MkWUnlift tr
 
 tToReaderTUnlift :: MonadTunnelIO m => t m --> ReaderT (WUnlift Monad t) m
diff --git a/src/Control/Monad/Ology/Specific/StackT.hs b/src/Control/Monad/Ology/Specific/StackT.hs
--- a/src/Control/Monad/Ology/Specific/StackT.hs
+++ b/src/Control/Monad/Ology/Specific/StackT.hs
@@ -332,7 +332,6 @@
        , IsStack (TransConstraint MonadIO) tt
        , IsStack (TransConstraint MonadFix) tt
        , IsStack (TransConstraint MonadTunnelIO) tt
-       , IsStack (TransConstraint MonadTunnelIOInner) tt
        , IsStack (TransConstraint MonadUnliftIO) tt
        , MonadTransStackTunnel tt
        , IsStack (WithTunnelConstraint MonadExtract) tt
@@ -350,42 +349,32 @@
                         Dict ->
                             case concatIsDict @_ @(Compose Dict (TransConstraint MonadTunnelIO)) @tt1 @tt2 of
                                 Dict ->
-                                    case concatIsDict @_ @(Compose Dict (TransConstraint MonadTunnelIOInner)) @tt1 @tt2 of
+                                    case concatIsDict @_ @(Compose Dict (TransConstraint MonadUnliftIO)) @tt1 @tt2 of
                                         Dict ->
-                                            case concatIsDict
-                                                     @_
-                                                     @(Compose Dict (TransConstraint MonadUnliftIO))
-                                                     @tt1
-                                                     @tt2 of
+                                            case concatMonadTransStackTunnelDict @tt1 @tt2 of
                                                 Dict ->
-                                                    case concatMonadTransStackTunnelDict @tt1 @tt2 of
+                                                    case concatIsDict @_ @(Compose Dict MonadTransTunnel) @tt1 @tt2 of
                                                         Dict ->
                                                             case concatIsDict
                                                                      @_
-                                                                     @(Compose Dict MonadTransTunnel)
+                                                                     @(Compose Dict MonadTransUnlift)
                                                                      @tt1
                                                                      @tt2 of
                                                                 Dict ->
                                                                     case concatIsDict
                                                                              @_
-                                                                             @(Compose Dict MonadTransUnlift)
+                                                                             @(Compose Dict (WithTunnelConstraint MonadExtract))
                                                                              @tt1
                                                                              @tt2 of
-                                                                        Dict ->
-                                                                            case concatIsDict
-                                                                                     @_
-                                                                                     @(Compose Dict (WithTunnelConstraint MonadExtract))
-                                                                                     @tt1
-                                                                                     @tt2 of
-                                                                                Dict -> Dict
+                                                                        Dict -> Dict
 
 stackLiftWithUnlift ::
-       forall tt m. (MonadTransStackUnlift tt, MonadTunnelIOInner m)
+       forall tt m. (MonadTransStackUnlift tt, MonadTunnelIO m)
     => m -/-> ApplyStack tt m
 stackLiftWithUnlift = unWBackraised $ coerce $ wLiftWithUnlift @(StackT tt) @m
 
 newtype LiftWithUnlift t = MkLiftWithUnlift
-    { unLiftWithUnlift :: forall m r. MonadIO m => (Unlift MonadTunnelIOInner t -> m r) -> t m r
+    { unLiftWithUnlift :: forall m r. MonadIO m => (Unlift MonadTunnelIO t -> m r) -> t m r
     }
 
 witFunctorOneTunnelIOStackDict ::
@@ -399,23 +388,23 @@
 
 stackJoinUnlift ::
        ListType (Compose Dict MonadTransUnlift) tt
-    -> Unlift MonadTunnelIOInner t
-    -> Unlift MonadTunnelIOInner (StackT tt)
-    -> Unlift MonadTunnelIOInner (StackT (t ': tt))
+    -> Unlift MonadTunnelIO t
+    -> Unlift MonadTunnelIO (StackT tt)
+    -> Unlift MonadTunnelIO (StackT (t ': tt))
 stackJoinUnlift w tmm stmm (stma :: StackT (t ': tt) m a) =
-    case witTransStackDict @MonadTunnelIOInner @tt @m $ mapListType (\(Compose Dict) -> Compose Dict) w of
+    case witTransStackDict @MonadTunnelIO @tt @m $ mapListType (\(Compose Dict) -> Compose Dict) w of
         Dict ->
             case witFunctorOneTunnelIOStackDict @tt @m w of
                 Dict -> stmm $ MkStackT $ tmm $ unStackT stma
 
 newtype GetDiscardingUnlift t = MkGetDiscardingUnlift
-    { unGetDiscardingUnlift :: forall m. Monad m => t m (WUnlift MonadTunnelIOInner t)
+    { unGetDiscardingUnlift :: forall m. Monad m => t m (WUnlift MonadTunnelIO t)
     }
 
 instance MonadTransStackUnlift tt => MonadTransUnlift (StackT tt) where
     liftWithUnlift ::
            forall m r. MonadIO m
-        => (Unlift MonadTunnelIOInner (StackT tt) -> m r)
+        => (Unlift MonadTunnelIO (StackT tt) -> m r)
         -> StackT tt m r
     liftWithUnlift = let
         build :: forall tt'. ListType (Compose Dict MonadTransUnlift) tt' -> LiftWithUnlift (StackT tt')
@@ -425,7 +414,7 @@
                 MkLiftWithUnlift liftWithUnlift' -> let
                     liftWithUnlift'' ::
                            forall m' r'. MonadIO m'
-                        => (Unlift MonadTunnelIOInner (StackT tt') -> m' r')
+                        => (Unlift MonadTunnelIO (StackT tt') -> m' r')
                         -> StackT tt' m' r'
                     liftWithUnlift'' call =
                         MkStackT $
@@ -437,7 +426,7 @@
         in unLiftWithUnlift $ build $ representative @_ @(ListType (Compose Dict MonadTransUnlift)) @tt
     getDiscardingUnlift ::
            forall m. Monad m
-        => StackT tt m (WUnlift MonadTunnelIOInner (StackT tt))
+        => StackT tt m (WUnlift MonadTunnelIO (StackT tt))
     getDiscardingUnlift = let
         build :: forall tt'. ListType (Compose Dict MonadTransUnlift) tt' -> GetDiscardingUnlift (StackT tt')
         build NilListType = MkGetDiscardingUnlift $ MkStackT $ return $ MkWUnlift unStackT
@@ -446,7 +435,7 @@
                 MkGetDiscardingUnlift getDiscardingUnlift' -> let
                     getDiscardingUnlift'' ::
                            forall m'. Monad m'
-                        => StackT tt' m' (WUnlift MonadTunnelIOInner (StackT tt'))
+                        => StackT tt' m' (WUnlift MonadTunnelIO (StackT tt'))
                     getDiscardingUnlift'' =
                         MkStackT $
                         case witTransStackDict @Monad @tt0 @m' $ mapListType (\(Compose Dict) -> Compose Dict) w of
diff --git a/src/Control/Monad/Ology/Specific/StateT.hs b/src/Control/Monad/Ology/Specific/StateT.hs
--- a/src/Control/Monad/Ology/Specific/StateT.hs
+++ b/src/Control/Monad/Ology/Specific/StateT.hs
@@ -64,14 +64,14 @@
     liftWithUnlift call = liftWithMVarStateT $ \var -> call $ mVarRunStateT var
 
 -- | Run the 'StateT' on an 'MVar', taking the initial state and putting the final state.
-mVarRunStateT :: MVar s -> Unlift MonadTunnelIOInner (StateT s)
+mVarRunStateT :: MVar s -> Unlift MonadTunnelIO (StateT s)
 mVarRunStateT var (StateT smr) =
     tunnelIO $ \unlift ->
         modifyMVar var $ \olds ->
             fmap (\fas -> (fromMaybe olds $ mToMaybe $ fmap snd fas, fmap fst fas)) $ unlift $ smr olds
 
 -- | Take the 'MVar' before and put it back after.
-mVarRunLocked :: MonadTunnelIOInner m => MVar s -> m --> m
+mVarRunLocked :: MonadTunnelIO m => MVar s -> m --> m
 mVarRunLocked var ma = mVarRunStateT var $ lift ma
 
 discardingStateTUnlift :: s -> Unlift MonadIO (StateT s)
diff --git a/src/Control/Monad/Ology/Specific/TransformT.hs b/src/Control/Monad/Ology/Specific/TransformT.hs
deleted file mode 100644
--- a/src/Control/Monad/Ology/Specific/TransformT.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-module Control.Monad.Ology.Specific.TransformT where
-
-import Control.Monad.Ology.Data
-import Control.Monad.Ology.General
-import Import
-
-type TransformT :: forall k. (k -> Type) -> Type -> Type
-newtype TransformT f a = MkTransformT
-    { unTransformT :: forall r. (a -> f r) -> f r
-    }
-
-instance Functor (TransformT f) where
-    fmap ab (MkTransformT aff) = MkTransformT $ \bf -> aff $ bf . ab
-
-instance TransConstraint Functor TransformT where
-    hasTransConstraint = Dict
-
-instance Applicative (TransformT f) where
-    pure a = MkTransformT $ \af -> af a
-    MkTransformT f <*> MkTransformT x = MkTransformT $ \bf -> f $ \ab -> x (bf . ab)
-
-instance TransConstraint Applicative TransformT where
-    hasTransConstraint = Dict
-
-instance Monad (TransformT f) where
-    return = pure
-    MkTransformT m >>= f = MkTransformT $ \bf -> m (\a -> unTransformT (f a) bf)
-
-instance TransConstraint Monad TransformT where
-    hasTransConstraint = Dict
-
-instance MonadTrans TransformT where
-    lift m = MkTransformT $ \af -> m >>= af
-
-instance MonadIO m => MonadIO (TransformT m) where
-    liftIO = lift . liftIO
-
-instance TransConstraint MonadIO TransformT where
-    hasTransConstraint = Dict
-
-instance Semigroup a => Semigroup (TransformT f a) where
-    (<>) = liftA2 (<>)
-
-instance Monoid a => Monoid (TransformT f a) where
-    mempty = pure mempty
-
-instance MonadFix m => MonadFix (TransformT m) where
-    mfix ama =
-        MkTransformT $ \amr -> do
-            rec
-                (~(olda, r')) <-
-                    unTransformT (ama olda) $ \newa -> do
-                        r <- amr newa
-                        return (newa, r)
-            return r'
-
-mapTransformT :: (f --> f) -> TransformT f ()
-mapTransformT ff = MkTransformT $ \uf -> ff $ uf ()
-
-postTransformT :: Monad m => m () -> TransformT m ()
-postTransformT mu =
-    mapTransformT $ \mr -> do
-        r <- mr
-        mu
-        return r
-
-transformTMap :: TransformT f () -> f --> f
-transformTMap (MkTransformT uff) f = uff $ \() -> f
-
-execMapTransformT :: Monad f => f (TransformT f a) -> TransformT f a
-execMapTransformT ffa =
-    MkTransformT $ \af -> do
-        MkTransformT aff <- ffa
-        aff af
-
-transformParamRef ::
-       forall m. Monad m
-    => Param m --> Ref (TransformT m)
-transformParamRef (param :: _ a) = let
-    refGet :: TransformT m a
-    refGet =
-        MkTransformT $ \afr -> do
-            a <- paramAsk param
-            afr a
-    refPut :: a -> TransformT m ()
-    refPut a = MkTransformT $ \ufr -> paramWith param a $ ufr ()
-    in MkRef {..}
-
-liftTransformT ::
-       forall t m. (MonadTransUnlift t, MonadTunnelIOInner m)
-    => TransformT m --> TransformT (t m)
-liftTransformT (MkTransformT aff) = MkTransformT $ \atf -> liftWithUnlift $ \unlift -> aff $ unlift . atf
diff --git a/src/Control/Monad/Ology/Specific/WithT.hs b/src/Control/Monad/Ology/Specific/WithT.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Ology/Specific/WithT.hs
@@ -0,0 +1,118 @@
+module Control.Monad.Ology.Specific.WithT where
+
+import Control.Monad.Ology.Data
+import Control.Monad.Ology.General
+import Import
+
+type WithT :: forall k. (k -> Type) -> Type -> Type
+newtype WithT m a = MkWithT
+    { unWithT :: With m a
+    }
+
+instance Functor (WithT m) where
+    fmap ab (MkWithT aff) = MkWithT $ \bf -> aff $ bf . ab
+
+instance TransConstraint Functor WithT where
+    hasTransConstraint = Dict
+
+instance Applicative (WithT m) where
+    pure a = MkWithT $ \af -> af a
+    MkWithT f <*> MkWithT x = MkWithT $ \bf -> f $ \ab -> x (bf . ab)
+
+instance TransConstraint Applicative WithT where
+    hasTransConstraint = Dict
+
+instance Monad (WithT m) where
+    return = pure
+    MkWithT m >>= f = MkWithT $ \bf -> m (\a -> unWithT (f a) bf)
+
+instance TransConstraint Monad WithT where
+    hasTransConstraint = Dict
+
+instance MonadTrans WithT where
+    lift m = MkWithT $ \af -> m >>= af
+
+instance MonadIO m => MonadIO (WithT m) where
+    liftIO = lift . liftIO
+
+instance TransConstraint MonadIO WithT where
+    hasTransConstraint = Dict
+
+instance Semigroup a => Semigroup (WithT m a) where
+    (<>) = liftA2 (<>)
+
+instance Monoid a => Monoid (WithT m a) where
+    mempty = pure mempty
+
+instance MonadFix m => MonadFix (WithT m) where
+    mfix ama =
+        MkWithT $ \amr -> do
+            rec
+                (~(olda, r')) <-
+                    unWithT (ama olda) $ \newa -> do
+                        r <- amr newa
+                        return (newa, r)
+            return r'
+
+instance MonadException m => MonadException (WithT m) where
+    type Exc (WithT m) = Exc m
+    throwExc e = MkWithT $ \_ -> throwExc e
+    catchExc (MkWithT afrfr) cc = MkWithT $ \afr -> catchExc (afrfr afr) $ \e -> unWithT (cc e) afr
+
+instance MonadThrow e m => MonadThrow e (WithT m) where
+    throw e = MkWithT $ \_ -> throw e
+
+instance MonadCatch e m => MonadCatch e (WithT m) where
+    catch (MkWithT afrfr) cc = MkWithT $ \afr -> catch (afrfr afr) $ \e -> unWithT (cc e) afr
+
+unpickWithT ::
+       forall m a. MonadCoroutine m
+    => WithT m a
+    -> m (a, m ())
+unpickWithT (MkWithT w) = unpickWith w
+
+pickWithT ::
+       forall m a. Monad m
+    => m (a, m ())
+    -> WithT m a
+pickWithT mm = MkWithT $ pickWith mm
+
+instance {-# OVERLAPPING #-} (MonadHoistIO m, MonadCoroutine m) => MonadHoistIO (WithT m) where
+    hoistIO f wma = pickWithT $ fmap (fmap $ hoistIO f) $ hoistIO f $ unpickWithT wma
+
+mapWithT :: (m --> m) -> WithT m ()
+mapWithT ff = MkWithT $ \uf -> ff $ uf ()
+
+postWithT :: Monad m => m () -> WithT m ()
+postWithT mu =
+    mapWithT $ \mr -> do
+        r <- mr
+        mu
+        return r
+
+withTMap :: WithT m () -> m --> m
+withTMap (MkWithT uff) f = uff $ \() -> f
+
+execMapWithT :: Monad m => m (WithT m a) -> WithT m a
+execMapWithT ffa =
+    MkWithT $ \af -> do
+        MkWithT aff <- ffa
+        aff af
+
+withParamRef ::
+       forall m. Monad m
+    => Param m --> Ref (WithT m)
+withParamRef (param :: _ a) = let
+    refGet :: WithT m a
+    refGet =
+        MkWithT $ \afr -> do
+            a <- paramAsk param
+            afr a
+    refPut :: a -> WithT m ()
+    refPut a = MkWithT $ \ufr -> paramWith param a $ ufr ()
+    in MkRef {..}
+
+liftWithT ::
+       forall t m. (MonadTransUnlift t, MonadTunnelIO m)
+    => WithT m --> WithT (t m)
+liftWithT (MkWithT aff) = MkWithT $ \atf -> liftWithUnlift $ \unlift -> aff $ unlift . atf
diff --git a/src/Control/Monad/Ology/Specific/WriterT.hs b/src/Control/Monad/Ology/Specific/WriterT.hs
--- a/src/Control/Monad/Ology/Specific/WriterT.hs
+++ b/src/Control/Monad/Ology/Specific/WriterT.hs
@@ -2,11 +2,18 @@
 
 module Control.Monad.Ology.Specific.WriterT
     ( module Control.Monad.Trans.Writer
+    , module Control.Monad.Ology.Specific.WriterT
     ) where
 
 import Control.Monad.Ology.General
 import Control.Monad.Trans.Writer hiding (liftCallCC, liftCatch)
 import Import
+
+collect :: (Monad m, Monoid w) => WriterT w m a -> WriterT w m (a, w)
+collect wmr = censor (\_ -> mempty) $ listen wmr
+
+evalWriterT :: Monad m => WriterT w m a -> m a
+evalWriterT wma = fmap fst $ runWriterT wma
 
 instance Monoid w => TransConstraint Functor (WriterT w) where
     hasTransConstraint = Dict
diff --git a/test/Data.hs b/test/Data.hs
new file mode 100644
--- /dev/null
+++ b/test/Data.hs
@@ -0,0 +1,90 @@
+module Data
+    ( testData
+    ) where
+
+import Control.Monad.Ology
+import Data.Text
+import Prelude
+import Test.Tasty
+import Test.Tasty.HUnit
+
+lensFst :: Lens' (a, b) a
+lensFst afa (a, b) = fmap (\a' -> (a', b)) $ afa a
+
+lensSnd :: Lens' (a, b) b
+lensSnd bfb (a, b) = fmap (\b' -> (a, b')) $ bfb b
+
+type WM = WriterT ([Int], Text) IO
+
+wmProd :: Prod WM ([Int], Text)
+wmProd = writerProd
+
+intsProd :: Prod WM [Int]
+intsProd = lensMapProd lensFst wmProd
+
+textProd :: Prod WM Text
+textProd = lensMapProd lensSnd wmProd
+
+testProdTell :: TestTree
+testProdTell =
+    testCase "tell" $ do
+        found <-
+            execWriterT $ do
+                prodTell intsProd [34]
+                prodTell textProd "abc"
+                prodTell wmProd ([1, 2], "PQ")
+                prodTell intsProd [17]
+                prodTell textProd "def"
+        assertEqual "" ([34, 1, 2, 17], "abcPQdef") found
+
+testProdListen :: TestTree
+testProdListen =
+    testCase "listen" $ do
+        ((fi, ft), found) <-
+            runWriterT $ do
+                prodTell wmProd ([0], "XYZ")
+                fi <-
+                    prodListen_ intsProd $ do
+                        prodTell intsProd [34]
+                        prodTell textProd "abc"
+                        prodTell wmProd ([1, 2], "PQ")
+                prodTell intsProd [17]
+                ft <-
+                    prodListen_ textProd $ do
+                        prodTell intsProd [8]
+                        prodTell textProd "ijk"
+                        prodTell wmProd ([9, 10], "MN")
+                prodTell textProd "def"
+                return (fi, ft)
+        assertEqual "output" ([0, 34, 1, 2, 17, 8, 9, 10], "XYZabcPQijkMNdef") found
+        assertEqual "fi" [34, 1, 2] fi
+        assertEqual "ft" "ijkMN" ft
+
+testProdCollect :: TestTree
+testProdCollect =
+    testCase "collect" $ do
+        ((fi, ft), found) <-
+            runWriterT $ do
+                prodTell wmProd ([0], "XYZ")
+                fi <-
+                    prodCollect_ intsProd $ do
+                        prodTell intsProd [34]
+                        prodTell textProd "abc"
+                        prodTell wmProd ([1, 2], "PQ")
+                prodTell intsProd [17]
+                ft <-
+                    prodCollect_ textProd $ do
+                        prodTell intsProd [8]
+                        prodTell textProd "ijk"
+                        prodTell wmProd ([9, 10], "MN")
+                prodTell textProd "def"
+                return (fi, ft)
+        assertEqual "output" ([0, 17, 8, 9, 10], "XYZabcPQdef") found
+        assertEqual "fi" [34, 1, 2] fi
+        assertEqual "ft" "ijkMN" ft
+
+testProd :: TestTree
+testProd = testGroup "prod" [testProdTell, testProdListen, testProdCollect]
+
+testData :: TestTree
+testData = testGroup "data" [testProd]
diff --git a/test/Exception.hs b/test/Exception.hs
--- a/test/Exception.hs
+++ b/test/Exception.hs
@@ -8,6 +8,7 @@
 import Prelude
 import Test.Tasty
 import Test.Tasty.HUnit
+import Useful
 
 testACatch ::
        forall m e. (Eq e, Show e, MonadCatch e m)
@@ -54,6 +55,51 @@
         SuccessResult a -> return a
         FailureResult _ -> fail "Left"
 
+data Info = forall m e. (MonadCatch e m, MonadIO m, Eq e, Show e) =>
+                            MkInfo
+    { iName :: String
+    , iRun :: m --> IO
+    , iExc :: Int -> e
+    }
+
+newtype TestExc =
+    MkTestExc Int
+    deriving (Eq, Show)
+
+instance Exception TestExc
+
+ioInfo :: Info
+ioInfo = MkInfo {iName = "IO", iRun = \ioa -> ioa, iExc = MkTestExc}
+
+iRunWithT :: WithT IO --> IO
+iRunWithT tia = unWithT tia return
+
+transformInfo :: Info
+transformInfo = MkInfo {iName = "WithT IO", iRun = iRunWithT, iExc = MkTestExc}
+
+testCatch :: Info -> TestTree
+testCatch MkInfo {..} =
+    testCase iName $
+    compareTest "ABCE" $ \post -> do
+        post "A"
+        found <-
+            iRun $
+            try $ do
+                liftIO $ post "B"
+                reu <-
+                    try $ do
+                        liftIO $ post "C"
+                        () <- throw $ iExc 52
+                        liftIO $ post "D"
+                liftIO $ assertEqual "exc1" (FailureResult $ iExc 52) reu
+                liftIO $ post "E"
+                () <- throw $ iExc 74
+                liftIO $ post "F"
+        assertEqual "exc2" (FailureResult $ iExc 74) found
+
+testCatches :: TestTree
+testCatches = testGroup "catch" [testCatch ioInfo, testCatch transformInfo]
+
 testException :: TestTree
 testException =
     testGroup
@@ -63,4 +109,5 @@
         , testGroup "ResultT () IO" $ pure $ testABracket @(ResultT () IO) runResultT' $ throwR ()
         , testGroup "ComposeInner Maybe IO" $
           pure $ testABracket @(ComposeInner Maybe IO) runComposeInner $ liftInner Nothing
+        , testCatches
         ]
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,13 +4,14 @@
 
 import Compose
 import Coroutine
+import Data
 import Exception
 import Lifecycle
 import Prelude
 import Test.Tasty
 
 tests :: TestTree
-tests = testGroup "monadology" [testCoroutine, testLifecycle, testComposeInner, testException]
+tests = testGroup "monadology" [testCoroutine, testLifecycle, testComposeInner, testException, testData]
 
 main :: IO ()
 main = defaultMain tests