diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -6,5 +6,5 @@
 The simpler one uses the `LeftModule`, `RightModule`, and `BiModule` classes defined in `Control.Monad.Action`,
 and can be used with the `QualifiedDo` extension by qualifying the `do` blocks with either `Control.Monad.Action.Right` or `Control.Monad.Action.Left`.
 However, it uses incoherent instances.
-The second implementation, designed to avoid incoherent and overlapping instances, is defined in `Control.Monad.Action.Records`, and uses the `LeftAction`, `RightAtion`, and `BiAction` types.
+The second implementation, designed to avoid incoherent and overlapping instances, is defined in `Control.Monad.Action.Records`, and uses the `LeftAction`, `RightAction`, and `BiAction` types.
 It is meant to be used with `RecordWildCards` and `RebindableSyntax` and/or `OverloadedRecordDot`.
diff --git a/examples/Calculator.hs b/examples/Calculator.hs
new file mode 100644
--- /dev/null
+++ b/examples/Calculator.hs
@@ -0,0 +1,157 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- HLINT ignore "Redundant pure" -}
+
+module Main (main) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Action
+import Control.Monad.Action.Left qualified as L
+import Control.Monad.Action.Right qualified as R
+import Control.Monad.State hiding (get, put)
+import Control.Monad.State qualified as State
+import Data.Char
+import Data.Complex
+import Data.Functor
+import Data.List
+import System.IO
+import Text.Read hiding (get)
+
+newtype Parser a = Parser {getParser :: StateT String Maybe a}
+  deriving (Functor, Applicative, Alternative, Monad, MonadState String)
+
+runParser :: Parser a -> String -> Maybe a
+runParser = evalStateT . getParser
+
+instance {-# INCOHERENT #-} (Monad m, LeftModule m (StateT String Maybe)) => LeftModule m Parser where
+  ljoin = Parser . ljoin . fmap getParser
+
+instance {-# INCOHERENT #-} (Monad m, RightModule m (StateT String Maybe)) => RightModule m Parser where
+  rjoin = Parser . rjoin . getParser
+
+instance {-# INCOHERENT #-} (Functor f, LeftModule (StateT String Maybe) f) => LeftModule Parser f where
+  ljoin = ljoin . getParser
+
+instance {-# INCOHERENT #-} (Functor f, RightModule (StateT String Maybe) f) => RightModule Parser f where
+  rjoin = rjoin . fmap getParser
+
+get :: State s s
+get = State.get
+
+put :: s -> State s ()
+put = State.put
+
+satisfy :: (Char -> Bool) -> Parser Char
+satisfy p = L.do
+  s <- get
+  (c, s') <- uncons s
+  put s'
+  if p c then pure c else empty
+
+char :: Char -> Parser Char
+char = satisfy . (==)
+
+string :: String -> Parser String
+string = traverse char
+
+eof :: Parser ()
+eof = L.do
+  s <- get
+  unless (null s) empty
+
+num :: (Read a, Fractional a) => Parser a
+num = R.do
+  s <- some (satisfy (`elem` ('.' : ['0' .. '9'])))
+  readMaybe s
+
+chainl1 :: (Alternative f, Monad f) => f t -> f (t -> t -> t) -> f t
+chainl1 p o = p >>= rest
+  where
+    rest x =
+      ( o >>= \f ->
+          p >>= \y -> rest $ f x y
+      )
+        <|> pure x
+
+chainr1 :: (Alternative f, Monad f) => f t -> f (t -> t -> t) -> f t
+chainr1 p o =
+  p
+    >>= \x ->
+      ( fmap ($ x) o
+          <*> chainr1 p o
+      )
+        <|> pure x
+
+addOp :: (Num a) => Parser (a -> a -> a)
+addOp = char '+' $> (+) <|> char '-' $> (-)
+
+multOp :: (Fractional a) => Parser (a -> a -> a)
+multOp = char '*' $> (*) <|> char '/' $> (/)
+
+powerOp :: (Floating a) => Parser (a -> a -> a)
+powerOp = (string "^" <|> string "**") $> (**)
+
+func :: (Floating a) => Parser (a -> a)
+func =
+  string "exp" $> exp
+    <|> string "log" $> log
+    <|> string "sqrt" $> sqrt
+    <|> string "sin" $> sin
+    <|> string "cos" $> cos
+    <|> string "tan" $> tan
+    <|> string "asin" $> asin
+    <|> string "acos" $> acos
+    <|> string "atan" $> atan
+    <|> string "sinh" $> sinh
+    <|> string "cosh" $> cosh
+    <|> string "tanh" $> tanh
+    <|> string "asinh" $> asinh
+    <|> string "acosh" $> acosh
+    <|> string "atanh" $> atanh
+
+constant :: (RealFloat a) => Parser (Complex a)
+constant = string "pi" $> pi <|> string "e" $> exp 1 <|> char 'i' $> (0 :+ 1)
+
+skipSpaces :: Parser a -> Parser a
+skipSpaces p = many (satisfy isSpace) *> p <* many (satisfy isSpace)
+
+complexExpr :: (RealFloat a, Read a) => Parser (Complex a)
+complexExpr = chainl1 summand addOp
+  where
+    summand = chainl1 factor multOp
+    factor = do
+      sign <- skipSpaces $ fmap (maybe 1 (\case '-' -> -1; _ -> 1)) . optional $ satisfy (`elem` "+-")
+      p <- chainl1 implicitFactor $ many (satisfy isSpace) $> (*)
+      pure $ sign * p
+    implicitFactor = chainr1 operand powerOp
+    operand =
+      skipSpaces $
+        fmap (:+ 0) num
+          <|> func <*> factor
+          <|> constant
+          <|> (char '(' *> complexExpr <* char ')')
+
+toString :: (Num a, Eq a, Show a, Ord a) => Complex a -> String
+toString = \case
+  (0 :+ 0) -> "0"
+  (0 :+ 1) -> "i"
+  (0 :+ (-1)) -> "-i"
+  (0 :+ y) -> show' y ++ " i"
+  (x :+ 0) -> show' x
+  (x :+ 1) -> show' x ++ " + i"
+  (x :+ (-1)) -> show' x ++ " - i"
+  (x :+ y) -> show' x ++ (if y >= 0 then " + " else " - ") ++ show' (abs y) ++ " i"
+  where
+    show' x = if '.' `elem` show x then reverse . dropWhile (== '.') . dropWhile (== '0') . reverse $ show x else show x
+
+main :: IO ()
+main = forever $ do
+  putStr "> "
+  hFlush stdout
+  x <- getLine
+  let g = runParser (complexExpr @Double <* eof) x
+  maybe (hPutStrLn stderr "?") (putStrLn . toString) g
diff --git a/examples/CalculatorRecords.hs b/examples/CalculatorRecords.hs
new file mode 100644
--- /dev/null
+++ b/examples/CalculatorRecords.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE RebindableSyntax #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE NoGeneralisedNewtypeDeriving #-}
+
+module Main (main) where
+
+import Control.Applicative (Alternative (..), Applicative (pure, (*>), (<*)), optional)
+import Control.Monad (forever, unless)
+import Control.Monad.Action.Records
+import Control.Monad.State hiding (get, put)
+import Control.Monad.State qualified as State
+import Data.Char
+import Data.Complex
+import Data.Functor
+import Data.List
+import GHC.Records
+import System.IO
+import Text.Read hiding (get)
+import Prelude
+  ( Bool (..),
+    Double,
+    Eq (..),
+    Floating (..),
+    Fractional (..),
+    Maybe,
+    Monad,
+    Num (..),
+    Ord (..),
+    RealFloat,
+    Show (..),
+    String,
+    Traversable (..),
+    const,
+    id,
+    maybe,
+    ($),
+    (.),
+  )
+import Prelude qualified as P
+
+type Parser a = StateT String Maybe a
+
+ifThenElse :: Bool -> a -> a -> a
+ifThenElse = \case
+  True -> const
+  False -> const id
+
+runParser :: Parser a -> String -> Maybe a
+runParser = evalStateT
+
+get :: Parser String
+get = State.get
+
+put :: String -> Parser ()
+put = State.put
+
+satisfy :: (Char -> Bool) -> Parser Char
+satisfy p =
+  let LeftAction {..} = transformerStackAction.left
+   in do
+        s <- get
+        (c, s') <- uncons s
+        put s'
+        if p c then pure c else empty
+
+char :: Char -> Parser Char
+char = satisfy . (==)
+
+string :: String -> Parser String
+string = traverse char
+
+eof :: Parser ()
+eof =
+  let LeftAction {..} = submonadAction.left
+   in do
+        s <- get
+        unless (null s) empty
+
+num :: (Read a, Fractional a) => Parser a
+num =
+  let RightAction {..} = transformerStackAction.right
+   in do
+        s <- some (satisfy (`elem` ('.' : ['0' .. '9'])))
+        readMaybe s
+
+chainl1 :: (Alternative f, Monad f) => f t -> f (t -> t -> t) -> f t
+chainl1 p o = p P.>>= rest
+  where
+    rest x =
+      ( o P.>>= \f ->
+          p P.>>= \y -> rest $ f x y
+      )
+        <|> pure x
+
+chainr1 :: (Alternative f, Monad f) => f t -> f (t -> t -> t) -> f t
+chainr1 p o =
+  p
+    P.>>= \x ->
+      ( fmap ($ x) o
+          P.<*> chainr1 p o
+      )
+        <|> pure x
+
+addOp :: (Num a) => Parser (a -> a -> a)
+addOp = char '+' $> (+) <|> char '-' $> (-)
+
+multOp :: (Fractional a) => Parser (a -> a -> a)
+multOp = char '*' $> (*) <|> char '/' $> (/)
+
+powerOp :: (Floating a) => Parser (a -> a -> a)
+powerOp = (string "^" <|> string "**") $> (**)
+
+func :: (Floating a) => Parser (a -> a)
+func =
+  string "exp"
+    $> exp
+      <|> string "log"
+    $> log
+      <|> string "sqrt"
+    $> sqrt
+      <|> string "sin"
+    $> sin
+      <|> string "cos"
+    $> cos
+      <|> string "tan"
+    $> tan
+      <|> string "asin"
+    $> asin
+      <|> string "acos"
+    $> acos
+      <|> string "atan"
+    $> atan
+      <|> string "sinh"
+    $> sinh
+      <|> string "cosh"
+    $> cosh
+      <|> string "tanh"
+    $> tanh
+      <|> string "asinh"
+    $> asinh
+      <|> string "acosh"
+    $> acosh
+      <|> string "atanh"
+    $> atanh
+
+constant :: (RealFloat a) => Parser (Complex a)
+constant = string "pi" $> pi <|> string "e" $> exp 1 <|> char 'i' $> (0 :+ 1)
+
+skipSpaces :: Parser a -> Parser a
+skipSpaces p = many (satisfy isSpace) *> p <* many (satisfy isSpace)
+
+complexExpr :: (RealFloat a, Read a) => Parser (Complex a)
+complexExpr = chainl1 summand addOp
+  where
+    summand = chainl1 factor multOp
+    factor = P.do
+      sign <- skipSpaces $ fmap (maybe 1 (\case '-' -> -1; _ -> 1)) . optional $ satisfy (`elem` "+-")
+      p <- chainl1 implicitFactor $ many (satisfy isSpace) $> (*)
+      pure $ sign * p
+    implicitFactor = chainr1 operand powerOp
+    operand =
+      skipSpaces $
+        fmap (:+ 0) num
+          <|> func
+          P.<*> factor
+            <|> constant
+            <|> (char '(' *> complexExpr <* char ')')
+
+toString :: (Num a, Eq a, Show a, Ord a) => Complex a -> String
+toString = \case
+  (0 :+ 0) -> "0"
+  (0 :+ 1) -> "i"
+  (0 :+ (-1)) -> "-i"
+  (0 :+ y) -> show' y ++ " i"
+  (x :+ 0) -> show' x
+  (x :+ 1) -> show' x ++ " + i"
+  (x :+ (-1)) -> show' x ++ " - i"
+  (x :+ y) -> show' x ++ (if y >= 0 then " + " else " - ") ++ show' (abs y) ++ " i"
+  where
+    show' x = if '.' `elem` show x then reverse . dropWhile (== '.') . dropWhile (== '0') . reverse $ show x else show x
+
+main :: IO ()
+main = forever $ P.do
+  putStr "> "
+  hFlush stdout
+  x <- getLine
+  let g = runParser (complexExpr @Double <* eof) x
+  maybe (hPutStrLn stderr "?") (putStrLn . toString) g
diff --git a/monad-actions.cabal b/monad-actions.cabal
--- a/monad-actions.cabal
+++ b/monad-actions.cabal
@@ -8,7 +8,7 @@
 --       +-+------- breaking API changes
 --       | | +----- non-breaking API additions
 --       | | | +--- code changes with no API change
-version: 2.0.0.0
+version: 2.0.1.0
 synopsis: Actions of monads on functors
 description:
   This package defines classes for left and right actions of
@@ -46,19 +46,46 @@
 
   other-modules: Control.Monad.Action.TH
   build-depends:
-   base >= 4.20.2 && < 4.21,
+   base >= 4.20.2 && < 4.23,
    free >= 5.2 && < 5.3,
    kan-extensions >= 5.2.8 && < 5.3,
    mmorph >= 1.2.2 && < 1.3,
    mtl >= 2.3.1 && < 2.4,
-   template-haskell >= 2.22.0 && < 2.23,
+   template-haskell >= 2.22.0 && < 2.25,
    transformers >= 0.6.1 && < 0.7,
    constraints >= 0.14.4 && < 0.15,
 
+  hs-source-dirs: src
+  default-language: GHC2021
 
+flag examples
+  description: Build examples
+  default:     False
+  manual:      True
 
-  hs-source-dirs: src
+executable calculator
+  import: warnings
+  if !flag(examples)
+    buildable: False
   default-language: GHC2021
+  hs-source-dirs: examples
+  main-is: Calculator.hs
+  build-depends:
+        monad-actions,
+        base >= 4.20.2 && < 4.23,
+        mtl >= 2.3.1 && < 2.4,
+
+executable calculator-records
+  import: warnings
+  if !flag(examples)
+    buildable: False
+  default-language: GHC2021
+  hs-source-dirs: examples
+  main-is: CalculatorRecords.hs
+  build-depends:
+        monad-actions,
+        base >= 4.20.2 && < 4.23,
+        mtl >= 2.3.1 && < 2.4,
 
 test-suite monad-actions-test
   import: warnings
diff --git a/src/Control/Monad/Action.hs b/src/Control/Monad/Action.hs
--- a/src/Control/Monad/Action.hs
+++ b/src/Control/Monad/Action.hs
@@ -1,28 +1,39 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_HADDOCK show-extensions #-}
 
--- | Given a monad \(M\) on a category \(\mathcal{D}\) with unit \(\eta\) and
---     multiplication \(\mu\) and a functor \(F\) from \(\mathcal{C}\) to \(\mathcal{D}\),
---     a left (or outer) monad action of \(M\) on \(F\) is a natural transformation
---     \(\nu: M \circ F \to F\) such that the following two laws hold:
+-- |
+-- Module      : Control.Monad.Action
+-- Description : monad actions
+-- Copyright   : © noiioiu
+-- License     : LGPL-2
+-- Maintainer  : noiioiu@cocaine.ninja
+-- Stability   : experimental
 --
---     * \(\nu \cdot (\eta \circ F) = \mathrm{id}_F\)
---     * \(\nu \cdot (\mu \circ F) = \nu \cdot (M \circ \nu)\)
+-- Given a monad \(M\) on a category \(\mathcal{D}\) with unit \(\eta\) and
+-- multiplication \(\mu\) and a functor \(F\) from \(\mathcal{C}\) to \(\mathcal{D}\),
+-- a left (or outer) monad action of \(M\) on \(F\) is a natural transformation
+-- \(\nu: M \circ F \to F\) such that the following two laws hold:
 --
---     We also say that \(F\) is a left module over \(M\).  In the case
---     \(\mathcal{C} = \mathcal{D}\), a left monad module is a left monoid module
---     object in the category of endofunctors on \(\mathcal{C}\).  We may also
---     call \(\nu\) the scalar multiplication of the module by the monad, by analogy
---     with ring modules, which are monoid module objects in the category of abelian groups
---     with tensor product as the monoidal product (rings are just monoid objects in this
---     category).
+-- * \(\nu \cdot (\eta \circ F) = \mathrm{id}_F\)
+-- * \(\nu \cdot (\mu \circ F) = \nu \cdot (M \circ \nu)\)
 --
---     Right (or inner) monad actions are defined similarly.
+-- We also say that \(F\) is a left module over \(M\).  In the case
+-- \(\mathcal{C} = \mathcal{D}\), a left monad module is a left monoid module
+-- object in the category of endofunctors on \(\mathcal{C}\).  We may also
+-- call \(\nu\) the scalar multiplication of the module by the monad, by analogy
+-- with ring modules, which are monoid module objects in the category of abelian groups
+-- with tensor product as the monoidal product (rings are just monoid objects in this
+-- category).
 --
---     See [this blog post](https://stringdiagram.com/2023/04/23/monad-actions/) by Dan Marsden
---     or the paper /Modules over monads and their algebras/ by Piróg, Wu, and Gibbons.
+-- Right (or inner) monad actions are defined similarly.
+--
+-- See [this blog post](https://stringdiagram.com/2023/04/23/monad-actions/) by Dan Marsden
+-- or the paper /Modules over monads and their algebras/ by Piróg, Wu, and Gibbons.
 module Control.Monad.Action
   ( LeftModule (..),
     RightModule (..),
@@ -31,23 +42,30 @@
 where
 
 import Control.Monad (join)
+import Control.Monad.Accum (MonadAccum (..))
+import Control.Monad.Action.TH (mkMTLActions, (#))
 import Control.Monad.Codensity (Codensity (..))
 import Control.Monad.Error.Class (MonadError (..), liftEither)
-import Control.Monad.IO.Class
+import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Identity (Identity (..))
+import Control.Monad.RWS.Class (MonadRWS)
 import Control.Monad.Reader.Class (MonadReader (..))
-import Control.Monad.State (State, runState)
+import Control.Monad.State ()
 import Control.Monad.State.Class (MonadState (..))
+import Control.Monad.State.Strict ()
+import Control.Monad.Trans.Accum (Accum, runAccum)
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
 import Control.Monad.Trans.Maybe (MaybeT (..))
-import Control.Monad.Trans.Reader (Reader, runReader)
-import Control.Monad.Trans.Writer (Writer, runWriter)
-import Control.Monad.TransformerStack
+import Control.Monad.Trans.Reader ()
+import Control.Monad.Trans.Writer ()
+import Control.Monad.TransformerStack (IsRWS (..), IsReader (..), IsState (..), IsWriter (..), MonadTransStack (..), rws)
+import Control.Monad.Writer.CPS ()
 import Control.Monad.Writer.Class (MonadWriter (..))
+import Control.Monad.Writer.Strict ()
 import Data.Functor.Compose (Compose (..))
 import Data.List.NonEmpty qualified as NE (NonEmpty, toList)
 import Data.Maybe (catMaybes, mapMaybe)
-import Data.Tuple (swap)
+import Language.Haskell.TH (Exp (..), Type (..))
 
 -- | Instances must satisfy the following laws:
 --
@@ -211,65 +229,26 @@
 instance {-# INCOHERENT #-} (MonadError e m) => BiModule (Either e) (Either e) m
 
 -- | For every @'MonadReader'@ instance defined in "Control.Monad.Reader.Class", @'reader'@ is a monad homomorphism.
-instance {-# INCOHERENT #-} (MonadReader r m) => LeftModule ((->) r) m where
-  ljoin = join . reader
-  a `lbind` f = reader a >>= f
-
-instance {-# INCOHERENT #-} (MonadReader r m) => RightModule ((->) r) m where
-  rjoin = (>>= reader)
-  a `rbind` f = a >>= reader . f
-
-instance {-# INCOHERENT #-} (MonadReader r m) => BiModule ((->) r) ((->) r) m
-
-instance {-# INCOHERENT #-} (MonadReader r m) => LeftModule (Reader r) m where
-  ljoin = join . reader . runReader
-  a `lbind` f = reader (runReader a) >>= f
-
-instance {-# INCOHERENT #-} (MonadReader r m) => RightModule (Reader r) m where
-  rjoin = (>>= reader . runReader)
-  a `rbind` f = a >>= reader . runReader . f
-
-instance {-# INCOHERENT #-} (MonadReader r m) => BiModule (Reader r) (Reader r) m
-
-instance {-# INCOHERENT #-} (MonadReader r m) => BiModule ((->) r) (Reader r) m
-
-instance {-# INCOHERENT #-} (MonadReader r m) => BiModule (Reader r) ((->) r) m
-
--- | For every @'MonadWriter'@ instance defined in "Control.Monad.Writer.Class", @'writer'@ is a monad homomorphism.
-instance {-# INCOHERENT #-} (MonadWriter w m) => LeftModule ((,) w) m where
-  ljoin = join . writer . swap
-  a `lbind` f = writer (swap a) >>= f
-
-instance {-# INCOHERENT #-} (MonadWriter w m) => RightModule ((,) w) m where
-  rjoin = (>>= writer . swap)
-  a `rbind` f = a >>= writer . swap . f
-
-instance {-# INCOHERENT #-} (MonadWriter w m) => BiModule ((,) w) ((,) w) m
-
-instance {-# INCOHERENT #-} (MonadWriter w m) => LeftModule (Writer w) m where
-  ljoin = join . writer . runWriter
-  a `lbind` f = writer (runWriter a) >>= f
-
-instance {-# INCOHERENT #-} (MonadWriter w m) => RightModule (Writer w) m where
-  rjoin = (>>= writer . runWriter)
-  a `rbind` f = a >>= writer . runWriter . f
+$(mkMTLActions ''IsReader (VarE 'runReader) (VarE 'reader) (\case AppT _ r -> ConT ''MonadReader # r; _ -> TupleT 0))
 
-instance {-# INCOHERENT #-} (MonadWriter w m) => BiModule (Writer w) (Writer w) m
+-- | For every @'MonadWriter'@ instance defined in "Control.Monad.Writer.Class", @'writer' '.' 'runWriter'@ is a monad homomorphism.
+$(mkMTLActions ''IsWriter (VarE 'runWriter) (VarE 'writer) (\case AppT _ w -> ConT ''MonadWriter # w; _ -> TupleT 0))
 
-instance {-# INCOHERENT #-} (MonadWriter w m) => BiModule ((,) w) (Writer w) m
+-- | For every @'MonadState'@ instance defined in "Control.Monad.State.Class", @'state' '.' 'runState'@ is a monad homomorphism.
+$(mkMTLActions ''IsState (VarE 'runState) (VarE 'state) (\case AppT _ s -> ConT ''MonadState # s; _ -> TupleT 0))
 
-instance {-# INCOHERENT #-} (MonadWriter w m) => BiModule (Writer w) ((,) w) m
+$(mkMTLActions ''IsRWS (VarE 'runRWS) (VarE 'rws) (\case AppT (AppT (AppT _ r) w) s -> ConT ''MonadRWS # r # w # s; _ -> TupleT 0))
 
--- | For every @'MonadState'@ instance defined in "Control.Monad.State.Class", @'state'@ is a monad homomorphism.
-instance {-# INCOHERENT #-} (MonadState s m) => LeftModule (State s) m where
-  ljoin = join . state . runState
-  a `lbind` f = state (runState a) >>= f
+-- | For every lawful @'MonadAccum'@ instance, @'accum' '.' 'runAccum'@ is a monad homomorphism.
+instance {-# INCOHERENT #-} (MonadAccum w m) => LeftModule (Accum w) m where
+  ljoin = join . accum . runAccum
+  a `lbind` f = accum (runAccum a) >>= f
 
-instance {-# INCOHERENT #-} (MonadState s m) => RightModule (State s) m where
-  rjoin = (>>= (state . runState))
-  a `rbind` f = a >>= state . runState . f
+instance {-# INCOHERENT #-} (MonadAccum w m) => RightModule (Accum w) m where
+  rjoin = (>>= (accum . runAccum))
+  a `rbind` f = a >>= accum . runAccum . f
 
-instance {-# INCOHERENT #-} (MonadState s m) => BiModule (State s) (State s) m
+instance {-# INCOHERENT #-} (MonadAccum w m) => BiModule (Accum w) (Accum w) m
 
 -- | Proof that @f@ is always a left module over @t'Codensity' f@:
 --
diff --git a/src/Control/Monad/Action/Left.hs b/src/Control/Monad/Action/Left.hs
--- a/src/Control/Monad/Action/Left.hs
+++ b/src/Control/Monad/Action/Left.hs
@@ -1,5 +1,13 @@
--- | Operators for left monad actions.
---   This module should be imported qualified, and can be used with the @QualifiedDo@ extension.
+-- |
+-- Module      : Control.Monad.Action.Left
+-- Description : operators for left monad actions
+-- Copyright   : © noiioiu
+-- License     : LGPL-2
+-- Maintainer  : noiioiu@cocaine.ninja
+-- Stability   : experimental
+--
+-- Operators for left monad actions.
+-- This module should be imported qualified, and can be used with the @QualifiedDo@ extension.
 module Control.Monad.Action.Left
   ( (>>=),
     (>>),
@@ -18,6 +26,7 @@
 
 import Control.Monad.Action
 import Control.Monad.Fix qualified as F
+import GHC.Stack (HasCallStack)
 import Prelude hiding (fail, fmap, pure, return, (<*>), (=<<), (>>), (>>=))
 import Prelude qualified as P
 
@@ -64,7 +73,7 @@
 pure = P.pure
 
 -- | Re-export from "Prelude".
-fail :: (MonadFail m) => String -> m a
+fail :: (HasCallStack, MonadFail m) => String -> m a
 fail = P.fail
 
 -- | Re-export from "Control.Monad.Fix".
diff --git a/src/Control/Monad/Action/Records.hs b/src/Control/Monad/Action/Records.hs
--- a/src/Control/Monad/Action/Records.hs
+++ b/src/Control/Monad/Action/Records.hs
@@ -4,27 +4,50 @@
 {-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoFieldSelectors #-}
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoGeneralisedNewtypeDeriving #-}
+{-# OPTIONS_HADDOCK show-extensions #-}
 
--- | This module should be used with @OverloadedRecordDot@ and/or @RebindableSyntax@ (and @RecordWildCards@).
+{- HLINT ignore "Use >>=" -}
+{- HLINT ignore "Use =<<" -}
+{- HLINT ignore "Use <=<" -}
+{- HLINT ignore "Use >=>" -}
+
+-- |
+-- Module      : Control.Monad.Action.Records
+-- Description : monad actions, implemented using records
+-- Copyright   : © noiioiu
+-- License     : LGPL-2
+-- Maintainer  : noiioiu@cocaine.ninja
+-- Stability   : experimental
+--
+-- This module should be used with @OverloadedRecordDot@ and/or @RebindableSyntax@ (and @RecordWildCards@).
 module Control.Monad.Action.Records where
 
-import Control.Monad qualified as M (Monad (..), join, (=<<))
+import Control.Monad qualified as M (join, (=<<))
+import Control.Monad.Accum (MonadAccum (..))
 import Control.Monad.Codensity (Codensity (..))
 import Control.Monad.Error.Class (MonadError, liftEither)
 import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad.RWS (MonadRWS, RWS, RWST (..), runRWS)
+import Control.Monad.RWS (MonadRWS, RWS, RWST (..))
+import Control.Monad.RWS.CPS qualified as RWSCPS (RWS)
+import Control.Monad.RWS.Strict qualified as RWSStrict (RWS)
 import Control.Monad.Reader (MonadReader (..), Reader, ReaderT (..), runReader)
-import Control.Monad.State (MonadState (..), State, StateT (..), runState)
+import Control.Monad.State (MonadState (..), State, StateT (..))
+import Control.Monad.State.Strict qualified as StateStrict (State)
+import Control.Monad.Trans.Accum (Accum, runAccum)
 import Control.Monad.Trans.Writer (WriterT (..))
-import Control.Monad.TransformerStack
-import Control.Monad.Writer (MonadWriter (..), Writer, runWriter)
+import Control.Monad.TransformerStack (IsRWS (..), IsState (..), IsWriter (..), MonadTransStack (..), rws)
+import Control.Monad.Writer (MonadWriter (..), Writer)
+import Control.Monad.Writer.CPS qualified as WriterCPS (Writer)
+import Control.Monad.Writer.Strict qualified as WriterStrict (Writer)
 import Data.Bifunctor (second)
 import Data.Constraint (Dict (..))
 import Data.Functor.Compose (Compose (..))
 import Data.Kind (Constraint, Type)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (maybeToList)
+import Data.Tuple (swap)
 import Prelude hiding ((<*>), (=<<), (>>), (>>=))
 import Prelude qualified as P
 
@@ -200,25 +223,43 @@
 instance (MonadIO m) => IO :<: m where
   inject = liftIO
 
-instance (MonadState s m) => (State s) :<: m where
+instance (MonadState s m) => State s :<: m where
   inject = state . runState
 
-instance (MonadReader r m) => (Reader r) :<: m where
+instance (MonadState s m) => StateStrict.State s :<: m where
+  inject = state . runState
+
+instance (MonadReader r m) => (->) r :<: m where
+  inject = reader
+
+instance (MonadReader r m) => Reader r :<: m where
   inject = reader . runReader
 
-instance (MonadWriter w m) => (Writer w) :<: m where
+instance (MonadWriter w m) => (,) w :<: m where
+  inject = writer . swap
+
+instance (MonadWriter w m) => Writer w :<: m where
   inject = writer . runWriter
 
-instance (MonadRWS r w s m) => (RWS r w s) :<: m where
-  inject t =
-    ask P.>>= \r ->
-      get P.>>= \s ->
-        let (a, s', w) = runRWS t r s
-         in put s'
-              M.>> tell w
-              M.>> pure a
+instance (MonadWriter w m) => WriterCPS.Writer w :<: m where
+  inject = writer . runWriter
 
-instance (MonadError e m) => (Either e) :<: m where
+instance (MonadWriter w m) => WriterStrict.Writer w :<: m where
+  inject = writer . runWriter
+
+instance (MonadAccum w m) => Accum w :<: m where
+  inject = accum . runAccum
+
+instance (MonadRWS r w s m) => RWS r w s :<: m where
+  inject = rws . runRWS
+
+instance (MonadRWS r w s m) => RWSCPS.RWS r w s :<: m where
+  inject = rws . runRWS
+
+instance (MonadRWS r w s m) => RWSStrict.RWS r w s :<: m where
+  inject = rws . runRWS
+
+instance (MonadError e m) => Either e :<: m where
   inject = liftEither
 
 class CodensityAction m f where
@@ -226,6 +267,7 @@
   codensityBind :: forall a b. m a -> (a -> f b) -> f b
   codensityApply :: forall a b. m (a -> b) -> f a -> f b
 
+-- | Left action of the codensity monad of any functor @f@ on @f@.
 codensityAction :: LeftAction CodensityAction
 codensityAction =
   let join :: forall m f a. (CodensityAction m f) => m (f a) -> f a
diff --git a/src/Control/Monad/Action/Right.hs b/src/Control/Monad/Action/Right.hs
--- a/src/Control/Monad/Action/Right.hs
+++ b/src/Control/Monad/Action/Right.hs
@@ -1,7 +1,15 @@
 {-# LANGUAGE MonoLocalBinds #-}
 
--- | Operators for right monad actions.
---   This module should be imported qualified, and can be used with the @QualifiedDo@ extension.
+-- |
+-- Module      : Control.Monad.Action.Right
+-- Description : operators for right monad actions
+-- Copyright   : © noiioiu
+-- License     : LGPL-2
+-- Maintainer  : noiioiu@cocaine.ninja
+-- Stability   : experimental
+--
+-- Operators for right monad actions.
+-- This module should be imported qualified, and can be used with the @QualifiedDo@ extension.
 module Control.Monad.Action.Right
   ( (>>=),
     (>>),
@@ -20,6 +28,7 @@
 
 import Control.Monad.Action
 import Control.Monad.Fix qualified as F
+import GHC.Stack (HasCallStack)
 import Prelude hiding (fail, fmap, pure, return, (<*>), (=<<), (>>), (>>=))
 import Prelude qualified as P
 
@@ -66,7 +75,7 @@
 pure = P.pure
 
 -- | Re-export from "Prelude".
-fail :: (MonadFail m) => String -> m a
+fail :: (HasCallStack, MonadFail m) => String -> m a
 fail = P.fail
 
 -- | Re-export from "Control.Monad.Fix".
diff --git a/src/Control/Monad/Action/TH.hs b/src/Control/Monad/Action/TH.hs
--- a/src/Control/Monad/Action/TH.hs
+++ b/src/Control/Monad/Action/TH.hs
@@ -2,8 +2,9 @@
 {-# LANGUAGE TemplateHaskellQuotes #-}
 {-# LANGUAGE TypeData #-}
 
-module Control.Monad.Action.TH (mkLiftBy) where
+module Control.Monad.Action.TH (mkLiftBy, mkMTLActions, (#)) where
 
+import Control.Monad (join)
 import Control.Monad.Trans
 import Data.Kind qualified as K
 import Language.Haskell.TH
@@ -16,6 +17,69 @@
 (|->|) :: Type -> Type -> Type
 a |->| b = ArrowT # a # b
 
+mkMTLActions :: Name -> Exp -> Exp -> (Type -> Type) -> Q [Dec]
+mkMTLActions className run inj classToMTLClass =
+  reify className
+    >>= \case
+      ClassI _ instances -> do
+        f <- newName "f"
+        a <- newName "a"
+        g <- newName "g"
+        let leftmoduleDecs =
+              instances >>= \case
+                InstanceD _ ct (AppT cls m) _ ->
+                  pure $
+                    InstanceD
+                      (Just Incoherent)
+                      ((classToMTLClass cls # VarT f) : ct)
+                      (ConT (mkName "LeftModule") # m # VarT f)
+                      [ ValD
+                          (VarP $ mkName "ljoin")
+                          (NormalB . UInfixE (VarE 'join) (VarE '(.)) $ UInfixE inj (VarE '(.)) run)
+                          [],
+                        FunD
+                          (mkName "lbind")
+                          [ Clause
+                              [VarP a, VarP g]
+                              (NormalB $ UInfixE (AppE inj (AppE run (VarE a))) (VarE '(>>=)) (VarE g))
+                              []
+                          ]
+                      ]
+                _ -> []
+        let rightmoduleDecs =
+              instances >>= \case
+                InstanceD _ ct (AppT cls m) _ ->
+                  pure $
+                    InstanceD
+                      (Just Incoherent)
+                      ((classToMTLClass cls # VarT f) : ct)
+                      (ConT (mkName "RightModule") # m # VarT f)
+                      [ ValD
+                          (VarP $ mkName "rjoin")
+                          (NormalB . InfixE Nothing (VarE '(>>=)) . Just . UInfixE inj (VarE '(.)) $ run)
+                          [],
+                        FunD
+                          (mkName "rbind")
+                          [ Clause
+                              [VarP a, VarP g]
+                              (NormalB $ UInfixE (VarE a) (VarE '(>>=)) $ UInfixE inj (VarE '(.)) $ UInfixE run (VarE '(.)) (VarE g))
+                              []
+                          ]
+                      ]
+                _ -> []
+        let bimoduleDecs =
+              do
+                InstanceD _ ct (AppT cls m) _ <- instances
+                InstanceD _ ct' (AppT cls' n) _ <- instances
+                pure $
+                  InstanceD
+                    (Just Incoherent)
+                    ((classToMTLClass cls # VarT f) : (classToMTLClass cls' # VarT f) : ct ++ ct')
+                    (ConT (mkName "BiModule") # m # n # VarT f)
+                    []
+        pure $ leftmoduleDecs ++ rightmoduleDecs ++ bimoduleDecs
+      _ -> pure []
+
 mkLiftBy :: Q [Dec]
 mkLiftBy =
   reify ''MonadTrans
@@ -40,8 +104,8 @@
                 ClosedTypeFamilyD
                   ( TypeFamilyHead
                       famName
-                      [ KindedTV m BndrReq (StarT |->| StarT),
-                        KindedTV n BndrReq (StarT |->| StarT)
+                      [ KindedTV m BndrReq (ConT ''K.Type |->| ConT ''K.Type),
+                        KindedTV n BndrReq (ConT ''K.Type |->| ConT ''K.Type)
                       ]
                       (KindSig . ConT $ mkName "Nat")
                       Nothing
diff --git a/src/Control/Monad/TransformerStack.hs b/src/Control/Monad/TransformerStack.hs
--- a/src/Control/Monad/TransformerStack.hs
+++ b/src/Control/Monad/TransformerStack.hs
@@ -1,14 +1,41 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TypeData #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE NoGeneralisedNewtypeDeriving #-}
+{-# OPTIONS_HADDOCK show-extensions #-}
 
-module Control.Monad.TransformerStack (MonadTransStack (..)) where
+-- |
+-- Module      : Control.Monad.TransformerStack
+-- Description : stacks of monad transformers
+-- Copyright   : © noiioiu
+-- License     : LGPL-2
+-- Maintainer  : noiioiu@cocaine.ninja
+-- Stability   : experimental
+module Control.Monad.TransformerStack
+  ( MonadTransStack (..),
+    IsState (..),
+    IsWriter (..),
+    IsRWS (..),
+    IsReader (..),
+    rws,
+  )
+where
 
+import Control.Monad.Accum ()
 import Control.Monad.Action.TH
 import Control.Monad.Co ()
+import Control.Monad.RWS.CPS qualified as CPSRWS (RWS, runRWS)
+import Control.Monad.RWS.Class (MonadRWS, MonadReader (..), MonadWriter (..))
+import Control.Monad.RWS.Lazy qualified as LazyRWS (RWS, runRWS)
+import Control.Monad.RWS.Strict qualified as StrictRWS (RWS, runRWS)
+import Control.Monad.Reader qualified as Reader
+import Control.Monad.State.Class (MonadState (..))
+import Control.Monad.State.Lazy qualified as LazyState (State, runState)
+import Control.Monad.State.Strict qualified as StrictState (State, runState)
 import Control.Monad.Trans ()
 import Control.Monad.Trans.Accum ()
 import Control.Monad.Trans.Compose ()
@@ -28,6 +55,11 @@
 import Control.Monad.Trans.Writer.CPS ()
 import Control.Monad.Trans.Writer.Lazy ()
 import Control.Monad.Trans.Writer.Strict ()
+import Control.Monad.Writer.CPS qualified as CPSWriter (Writer, runWriter)
+import Control.Monad.Writer.Class ()
+import Control.Monad.Writer.Lazy qualified as LazyWriter (Writer, runWriter)
+import Control.Monad.Writer.Strict qualified as StrictWriter (Writer, runWriter)
+import Data.Tuple (swap)
 
 $mkLiftBy
 
@@ -75,7 +107,7 @@
 --   >         ├───  =          ├───  =  ──────
 --   > ────────┘        ────────┘
 --
---   In other words,
+--   Or in Haskell notation:
 --
 --   @   'Control.Monad.Action.ljoin' '.' 'pure'
 --   = 'Control.Monad.join' '.' 'liftStack' '.' 'pure'
@@ -90,7 +122,7 @@
 --   > ────────┘         ────────┘              ├───┘
 --   >                                     ─────┘
 --
---   In other words,
+--   Or in Haskell notation:
 --
 --   @  'Control.Monad.Action.ljoin' '.' 'Control.Monad.join'
 --   = 'Control.Monad.join' '.' 'liftStack' '.' 'Control.Monad.join'
@@ -114,7 +146,7 @@
 --   >         ├───  =          ├───  =  ──────
 --   >   ├┈┈►──┘          ├─────┘
 --
---   In other words,
+--   Or in Haskell notation:
 --
 --   @   'Control.Monad.Action.rjoin' '.' 'fmap' 'pure'
 --   = 'Control.Monad.join' '.' 'fmap' 'liftStack' , 'pure'
@@ -131,7 +163,7 @@
 --   >    ├┈┈►─┘              ├───┘         ┈┈┈┈┈┈┈►─┘
 --   > ┈┈┈┘              ┈┈►──┘
 --
---   In other words,
+--   Or in Haskell notation:
 --
 --   @  'Control.Monad.Action.rjoin' '.' 'fmap' 'Control.Monad.join'
 --   = 'Control.Monad.join' '.' 'fmap' 'liftStack' '.' 'fmap' 'Control.Monad.join'
@@ -150,7 +182,7 @@
 --   > ┈►───────┘         ┈┈┈┈┈┈►─┘              ├───┘
 --   >                                       ┈┈►─┘
 --
---   In other words,
+--   Or in Haskell notation:
 --
 --   @  'Control.Monad.Action.bijoin'
 --   = 'Control.Monad.join' '.' 'Control.Monad.join' '.' 'liftStack' '.' 'fmap' ('fmap' 'liftStack')
@@ -167,3 +199,61 @@
 
 instance (LiftBy (Steps m n) m n) => MonadTransStack m n where
   liftStack = liftBy @(Steps m n)
+
+-- | @'IsReader' r m@ means that @m@ is an implementation of the reader monad, or, in other words, @'reader'@ is a monad isomorphism whose inverse is @'runReader'@.
+class (MonadReader r m) => IsReader r m where
+  runReader :: forall a. m a -> r -> a
+
+instance IsReader r ((->) r) where
+  runReader = id
+
+instance IsReader r (Reader.Reader r) where
+  runReader = Reader.runReader
+
+-- | @'IsState' s m@ means that @m@ is an implementation of the state monad, or, in other words, @'state'@ is a monad isomorphism whose inverse is @'runState'@.
+class (MonadState s m) => IsState s m where
+  runState :: forall a. m a -> s -> (a, s)
+
+instance IsState s (LazyState.State s) where
+  runState = LazyState.runState
+
+instance IsState s (StrictState.State s) where
+  runState = StrictState.runState
+
+-- | @'IsWriter' w m@ means that @m@ is an implementation of the writer monad, or, in other words, @'writer'@ is a monad isomorphism whose inverse is @'runWriter'@.
+class (MonadWriter w m) => IsWriter w m where
+  runWriter :: forall a. m a -> (a, w)
+
+instance (Monoid w) => IsWriter w ((,) w) where
+  runWriter = swap
+
+instance (Monoid w) => IsWriter w (LazyWriter.Writer w) where
+  runWriter = LazyWriter.runWriter
+
+instance (Monoid w) => IsWriter w (StrictWriter.Writer w) where
+  runWriter = StrictWriter.runWriter
+
+instance (Monoid w) => IsWriter w (CPSWriter.Writer w) where
+  runWriter = CPSWriter.runWriter
+
+-- | @'IsRWS' r w s m@ means that @m@ is an implementation of the rws monad, or, in other words, @'rws'@ is a monad isomorphism whose inverse is @'runRWS'@.
+class (MonadRWS r w s m) => IsRWS r w s m where
+  runRWS :: forall a. m a -> r -> s -> (a, s, w)
+
+instance (Monoid w) => IsRWS r w s (LazyRWS.RWS r w s) where
+  runRWS = LazyRWS.runRWS
+
+instance (Monoid w) => IsRWS r w s (StrictRWS.RWS r w s) where
+  runRWS = StrictRWS.runRWS
+
+instance (Monoid w) => IsRWS r w s (CPSRWS.RWS r w s) where
+  runRWS = CPSRWS.runRWS
+
+rws :: (MonadRWS r w s m) => (r -> s -> (a, s, w)) -> m a
+rws f =
+  ask >>= \r ->
+    get >>= \s ->
+      let (a, s', w) = f r s
+       in put s'
+            >> tell w
+            >> pure a
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -21,8 +21,10 @@
 import Control.Monad.Trans.Compose
 import Control.Monad.Trans.Free (FreeF (..), FreeT (..))
 import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Writer.CPS qualified as CPSWriter
 import Control.Monad.TransformerStack
 import Control.Monad.Writer
+import Control.Monad.Writer.Strict qualified as StrictWriter
 import Data.Functor.Classes (Eq1)
 import Data.Functor.Compose
 import Data.Monoid
@@ -240,9 +242,18 @@
 instance (Arbitrary (m (a, w))) => Arbitrary (WriterT w m a) where
   arbitrary = WriterT <$> arbitrary
 
+instance (Arbitrary (m (a, w))) => Arbitrary (StrictWriter.WriterT w m a) where
+  arbitrary = StrictWriter.WriterT <$> arbitrary
+
+instance (Arbitrary (m (a, w)), Monoid w, Monad m, Arbitrary a, Arbitrary w) => Arbitrary (CPSWriter.WriterT w m a) where
+  arbitrary = writer <$> arbitrary
+
 instance (EqProp (m (a, w))) => EqProp (WriterT w m a) where
   a =-= b = runWriterT a =-= runWriterT b
 
+instance (Show (m (a, w)), Monoid w) => Show (CPSWriter.WriterT w m a) where
+  show a = show $ CPSWriter.runWriterT a
+
 ldotest :: StateT Char [] Int
 ldotest = L.do
   x <- [1, 2, 3, 4, 5]
@@ -316,6 +327,9 @@
                   leftmodule @((,) (Sum Int)) @(MaybeT (WriterT (Sum Int) Maybe)) @Int,
                   rightmodule @((,) (Sum Int)) @(MaybeT (WriterT (Sum Int) Maybe)) @Int,
                   bimodule @((,) (Sum Int)) @((,) (Sum Int)) @(MaybeT (WriterT (Sum Int) Maybe)) @Int,
+                  bimodule @(Writer (Sum Int)) @(Writer (Sum Int)) @(MaybeT (WriterT (Sum Int) Maybe)) @Int,
+                  bimodule @(Writer (Sum Int)) @(StrictWriter.Writer (Sum Int)) @(MaybeT (WriterT (Sum Int) Maybe)) @Int,
+                  bimodule @(CPSWriter.Writer (Sum Int)) @(Writer (Sum Int)) @(MaybeT (WriterT (Sum Int) Maybe)) @Int,
                   rightmodulestate @(WriterT (Product Int) (Either Double)) @Int @Char
                   -- , rightmodulereader @(WriterT (Product Int) (Either Double)) @Int @Char
                   -- , rightmodulereader @(Either Bool) @Char @Int