diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,15 @@
+0.4.0.0
+-------
+
+* Poly-kinded tags.
+* Remove `Control.Ether.Tagged`.
+* Replace `Control.Ether.Wrapped` with `Control.Monad.Trans.Ether.Dispatch`.
+* Unified tagged transformer type in `Control.Monad.Trans.Ether.Tagged`.
+* `MonadThrow`, `MonadCatch`, `MonadMask` instances.
+* Drop `newtype-generics`.
+* Instance search is now more strict.
+
+
 0.3.1.1
 -------
 
diff --git a/ether.cabal b/ether.cabal
--- a/ether.cabal
+++ b/ether.cabal
@@ -1,5 +1,5 @@
 name:                ether
-version:             0.3.1.1
+version:             0.4.0.0
 synopsis:            Monad transformers and classes
 description:
     Ether is a Haskell library that extends @mtl@ and @transformers@ with
@@ -24,9 +24,7 @@
 
 library
 
-  exposed-modules:     Control.Ether.Tagged
-                       Control.Ether.Wrapped
-                       Control.Ether.Abbr
+  exposed-modules:     Control.Ether.Abbr
                        Control.Ether.Implicit.Abbr
                        Control.Ether.TH
                        Control.Monad.Trans.Ether.Reader
@@ -35,6 +33,8 @@
                        Control.Monad.Trans.Ether.State.Lazy
                        Control.Monad.Trans.Ether.State.Strict
                        Control.Monad.Trans.Ether.Except
+                       Control.Monad.Trans.Ether.Dispatch
+                       Control.Monad.Trans.Ether.Tagged
                        Control.Monad.Ether
                        Control.Monad.Ether.Reader
                        Control.Monad.Ether.Reader.Class
@@ -63,25 +63,24 @@
                ,       mmorph >=1.0.4
                ,       monad-control >=1.0.0.4
                ,       transformers-base >=0.4.4
+               ,       exceptions >=0.8
                ,       template-haskell >=2.9
-               ,       newtype-generics >=0.4.1
 
   default-language:    Haskell2010
-  other-extensions:    DeriveGeneric
-                       MultiParamTypeClasses
-                       TypeFamilies
-                       FlexibleInstances
-                       UndecidableInstances
+  other-extensions:    CPP
+                       ConstraintKinds
                        DataKinds
-                       GeneralizedNewtypeDeriving
+                       DefaultSignatures
+                       DeriveGeneric
+                       FlexibleInstances
                        FunctionalDependencies
-                       ConstraintKinds
+                       GeneralizedNewtypeDeriving
+                       MultiParamTypeClasses
                        ScopedTypeVariables
                        TemplateHaskell
-                       PolyKinds
+                       TypeFamilies
                        TypeOperators
-                       DefaultSignatures
-                       CPP
+                       UndecidableInstances
 
   hs-source-dirs:      src
   ghc-options:         -Wall
@@ -98,7 +97,28 @@
                ,       ether
 
   main-is:             Regression.hs
+  other-modules:       Regression.T1
+                       Regression.T2
+                       Regression.T3
+                       Regression.T4
+                       Regression.T5
+                       Regression.T6
+                       Regression.T7
+                       Regression.T8
+                       Regression.T9
+
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   default-language:    Haskell2010
-  ghc-options:         -Wall
+  default-extensions:  ConstraintKinds
+                       DataKinds
+                       EmptyDataDecls
+                       FlexibleContexts
+                       GeneralizedNewtypeDeriving
+                       LambdaCase
+                       PolyKinds
+                       ScopedTypeVariables
+                       TemplateHaskell
+                       TypeFamilies
+                       TypeOperators
+  ghc-options:         -Wall -fno-warn-missing-signatures
diff --git a/src/Control/Ether/TH.hs b/src/Control/Ether/TH.hs
--- a/src/Control/Ether/TH.hs
+++ b/src/Control/Ether/TH.hs
@@ -26,7 +26,7 @@
 -- Creates a tag and a value-level proxy for it.
 --
 -- @'ethereal' \"Foo\" \"foo\"@ generates the following code:
--- 
+--
 -- > data Foo
 -- > foo :: Proxy Foo
 -- > foo = Proxy
diff --git a/src/Control/Ether/Tagged.hs b/src/Control/Ether/Tagged.hs
deleted file mode 100644
--- a/src/Control/Ether/Tagged.hs
+++ /dev/null
@@ -1,159 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE DefaultSignatures #-}
-
--- | Type-level machinery for tag manipulation.
-
-module Control.Ether.Tagged
-    ( Taggable(..)
-    , Tagged(..)
-    , Tags
-    , Inners
-    , UniqueTag
-    , UniqueTags
-    , ensureUniqueTags
-    ) where
-
-import Data.Proxy (Proxy)
-import Data.Functor.Identity (Identity)
-import Data.Monoid (First, Last)
-import qualified Control.Monad.ST.Strict as Strict (ST)
-import qualified Control.Monad.ST.Lazy   as Lazy   (ST)
-import GHC.Conc (STM)
-import GHC.Exts (Constraint)
-import qualified Control.Newtype as NT
-import Control.Ether.Util (type (++), MaybeToList)
-
-import qualified Control.Monad.Trans.Cont          as Trans
-import qualified Control.Monad.Trans.Except        as Trans
-import qualified Control.Monad.Trans.Identity      as Trans
-import qualified Control.Monad.Trans.List          as Trans
-import qualified Control.Monad.Trans.Maybe         as Trans
-import qualified Control.Monad.Trans.Reader        as Trans
-import qualified Control.Monad.Trans.State.Lazy    as Trans.Lazy
-import qualified Control.Monad.Trans.State.Strict  as Trans.Strict
-import qualified Control.Monad.Trans.Writer.Lazy   as Trans.Lazy
-import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict
-
--- |
--- The main purpose of the 'UniqueTag' class is to provide clear error
--- messages when the tag uniqueness property is violated. You should never
--- write instances for it unless you know what you're doing.
-class UniqueTag a
-
-type family IsUnique (x :: k) (as :: [k]) :: Constraint where
-    IsUnique x (x ': as) = (UniqueTag x, IsUnique x as)
-    IsUnique x (a ': as) = IsUnique x as
-    IsUnique x '[] = ()
-
-type family Unique (as :: [k]) :: Constraint where
-    Unique '[] = ()
-    Unique (a ': as) = (IsUnique a as, Unique as)
-
--- |
--- The 'UniqueTags` constraint placed on a type variable representing a
--- monad transformer stack ensures that every tag in the stack appears
--- only once.
-type family UniqueTags (m :: * -> *) :: Constraint where
-    UniqueTags m = Unique (Tags m)
-
--- |
--- Type-restricted version of 'id' that adds a 'UniqueTags' constraint to
--- the provided monadic value.
-ensureUniqueTags :: UniqueTags m => m a -> m a
-ensureUniqueTags = id
-
-type family ListMapTag (as :: [* -> *]) :: [*] where
-    ListMapTag '[] = '[]
-    ListMapTag (a ': as) = MaybeToList (Tag a) ++ ListMapTag as
-
--- | The 'Taggable' class defines the type families to manage tags in monad
--- transformer stacks. Its kind is restricted to @* -> *@ to prevent incorrect
--- instances.
-class Taggable (m :: * -> *) where
-
-    -- | The 'Tag' type family equals @Nothing@ for most types, but for tagged
-    -- monad transformers it equals @Just tag@.
-    type Tag m :: Maybe *
-    type instance Tag m = 'Nothing
-
-    -- | The 'Inner' type family equals @Nothing@ for most types, but for
-    -- monad transformers with inner monad @m@ it equals @Just m@.
-    type Inner m :: Maybe (* -> *)
-    type instance Inner m = 'Nothing
-
-type family Inners' m where
-    Inners' 'Nothing = '[]
-    Inners' ('Just n) = n ': Inners n
-
--- | The 'Inners' type function recursively applies 'Inner' and returns the
--- results in a type-level list.
-type Inners m = Inners' (Inner m)
-
-instance Taggable IO
-instance Taggable Identity
-
-instance Taggable Maybe
-instance Taggable Last
-instance Taggable First
-instance Taggable ((->) r)
-instance Taggable STM
-instance Taggable (Either e)
-instance Taggable Proxy
-instance Taggable (Strict.ST s)
-instance Taggable (Lazy.ST s)
-
-instance Taggable (Trans.ContT r m) where
-    type Inner (Trans.ContT r m) = 'Just m
-
-instance Taggable (Trans.ExceptT e m) where
-    type Inner (Trans.ExceptT e m) = 'Just m
-
-instance Taggable (Trans.IdentityT m) where
-    type Inner (Trans.IdentityT m) = 'Just m
-
-instance Taggable (Trans.ListT m) where
-    type Inner (Trans.ListT m) = 'Just m
-
-instance Taggable (Trans.MaybeT m) where
-    type Inner (Trans.MaybeT m) = 'Just m
-
-instance Taggable (Trans.ReaderT r m) where
-    type Inner (Trans.ReaderT r m) = 'Just m
-
-instance Taggable (Trans.Lazy.StateT s m) where
-    type Inner (Trans.Lazy.StateT s m) = 'Just m
-
-instance Taggable (Trans.Strict.StateT s m) where
-    type Inner (Trans.Strict.StateT s m) = 'Just m
-
-instance Taggable (Trans.Lazy.WriterT w m) where
-    type Inner (Trans.Lazy.WriterT w m) = 'Just m
-
-instance Taggable (Trans.Strict.WriterT w m) where
-    type Inner (Trans.Strict.WriterT w m) = 'Just m
-
--- | The 'Tags' type function returns a type-level list of all tags in
--- a monad transformer stack. Requires 'Taggable' instances.
-type Tags (m :: * -> *) = MaybeToList (Tag m) ++ ListMapTag (Inners m)
-
--- | The 'Tagged' type class establishes a relationship between a tagged
--- monad transformer and its untagged counterpart.
-class (Taggable m, Tag m ~ 'Just tag) => Tagged m tag | m -> tag where
-
-    type Untagged m :: * -> *
-
-    tagged :: proxy tag -> Untagged m a -> m a
-    default tagged :: NT.Newtype (m a) => proxy tag -> NT.O (m a) -> m a
-    tagged _ = NT.pack
-
-    untagged :: proxy tag -> m a -> Untagged m a
-    default untagged :: NT.Newtype (m a) => proxy tag -> m a -> NT.O (m a)
-    untagged _ = NT.unpack
diff --git a/src/Control/Ether/Util.hs b/src/Control/Ether/Util.hs
--- a/src/Control/Ether/Util.hs
+++ b/src/Control/Ether/Util.hs
@@ -1,36 +1,33 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
 module Control.Ether.Util
-    ( type (++)
-    , MaybeToList
-    , fmap
-    ) where
+  ( fmap
+  , MonadApplicative
+  ) where
 
 import Prelude hiding (fmap)
 
 #if __GLASGOW_HASKELL__ < 710
+import qualified Control.Applicative
 import qualified Control.Monad
 #else
 import qualified Prelude
 #endif
 
-type family (as :: [*]) ++ (bs :: [*]) :: [*] where
-    '[] ++ bs = bs
-    (a ': as) ++ bs = a ': (as ++ bs)
-
-type family MaybeToList (mt :: Maybe k) :: [k] where
-    MaybeToList 'Nothing = '[]
-    MaybeToList ('Just t) = '[t]
-
 #if __GLASGOW_HASKELL__ < 710
 fmap :: Monad f => (a -> b) -> f a -> f b
-fmap = Control.Monad.liftM 
+fmap = Control.Monad.liftM
 #else
 fmap :: Functor f => (a -> b) -> f a -> f b
-fmap = Prelude.fmap 
+fmap = Prelude.fmap
 #endif
 
 {-# INLINE fmap #-}
+
+#if __GLASGOW_HASKELL__ < 710
+type MonadApplicative m =
+  ( Control.Applicative.Applicative m
+  , Control.Monad.Monad m )
+#else
+type MonadApplicative = Monad
+#endif
diff --git a/src/Control/Ether/Wrapped.hs b/src/Control/Ether/Wrapped.hs
deleted file mode 100644
--- a/src/Control/Ether/Wrapped.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-{- |
-Annotating monads with tags to turn untagged constraints into tagged ones.
-
-> import qualified Control.Monad.State as T
-> import Control.Ether.TH (ethereal)
-> import Control.Monad.Ether.State (MonadState)
-> import Control.Ether.Wrapped (ethered)
->
-> ethereal "Foo" "foo"
->
-> f :: T.MonadState Int m => m String
-> f = fmap show T.get
-> 
-> g :: MonadState Foo Int m => m String
-> g = ethered foo f
--}
-
-module Control.Ether.Wrapped
-    ( WrappedEther(..)
-    , ethered
-    ) where
-
-import Data.Proxy (Proxy(Proxy))
-import Control.Applicative
-import Control.Monad (MonadPlus)
-import Control.Monad.Fix (MonadFix)
-import Control.Monad.IO.Class (MonadIO)
-import GHC.Generics (Generic)
-import qualified Control.Newtype as NT
-
-import Control.Monad.Ether.Reader.Class
-import Control.Monad.Ether.State.Class
-import Control.Monad.Ether.Except.Class
-import Control.Monad.Ether.Writer.Class
-
-import qualified Control.Monad.Reader as Class
-import qualified Control.Monad.State  as Class
-import qualified Control.Monad.Except as Class
-import qualified Control.Monad.Writer as Class
-
--- | Wrap a monad to attach a tag to it.
-newtype WrappedEther tag m a = WrapEther { unwrapEther :: m a }
-    deriving ( Generic
-             , Functor, Applicative, Alternative, Monad, MonadPlus
-             , MonadFix, MonadIO )
-
-instance NT.Newtype (WrappedEther tag m a)
-
--- | Annotate a polymorphic monadic computation with a tag.
-ethered :: proxy tag -> WrappedEther tag m a -> m a
-ethered _proxy = unwrapEther
-
-instance MonadReader tag r m => Class.MonadReader r (WrappedEther tag m) where
-    ask = WrapEther $ ask (Proxy :: Proxy tag)
-    local f = WrapEther . local (Proxy :: Proxy tag) f . unwrapEther
-
-instance MonadReader tag r m => MonadReader tag r (WrappedEther tag' m) where
-    ask t = WrapEther $ ask t
-    local t f = WrapEther . local t f . unwrapEther
-
-instance MonadState tag s m => Class.MonadState s (WrappedEther tag m) where
-    get = WrapEther $ get (Proxy :: Proxy tag)
-    put = WrapEther . put (Proxy :: Proxy tag)
-
-instance MonadState tag s m => MonadState tag s (WrappedEther tag' m) where
-    get t = WrapEther $ get t
-    put t = WrapEther . put t
-
-instance MonadExcept tag e m => Class.MonadError e (WrappedEther tag m) where
-    throwError = WrapEther . throw (Proxy :: Proxy tag)
-    catchError m h = WrapEther $ catch (Proxy :: Proxy tag) (unwrapEther m) (unwrapEther . h)
-
-instance MonadExcept tag e m => MonadExcept tag e (WrappedEther tag' m) where
-    throw t = WrapEther . throw t
-    catch t m h = WrapEther $ catch t (unwrapEther m) (unwrapEther . h)
-
-instance MonadWriter tag w m => Class.MonadWriter w (WrappedEther tag m) where
-    tell = WrapEther . tell (Proxy :: Proxy tag)
-    listen = WrapEther . listen (Proxy :: Proxy tag) . unwrapEther
-    pass = WrapEther . pass (Proxy :: Proxy tag) . unwrapEther
-
-instance MonadWriter tag w m => MonadWriter tag w (WrappedEther tag' m) where
-    tell t = WrapEther . tell t
-    listen t = WrapEther . listen t . unwrapEther
-    pass t = WrapEther . pass t . unwrapEther
diff --git a/src/Control/Monad/Ether.hs b/src/Control/Monad/Ether.hs
--- a/src/Control/Monad/Ether.hs
+++ b/src/Control/Monad/Ether.hs
@@ -2,22 +2,13 @@
 -- | This module provides convenience exports of all
 -- tagged monad classes from Ether.
 
-module Control.Monad.Ether
-    ( module Control.Monad
-    , module Control.Monad.Fix
-    , module Control.Monad.Ether.Reader
-    , module Control.Monad.Ether.Writer
-    , module Control.Monad.Ether.State
-    , module Control.Monad.Ether.Except
-    , module Control.Ether.Wrapped
-    , ethereal
-    ) where
+module Control.Monad.Ether (module X) where
 
-import Control.Monad
-import Control.Monad.Fix
-import Control.Monad.Ether.Reader
-import Control.Monad.Ether.Writer
-import Control.Monad.Ether.State
-import Control.Monad.Ether.Except
-import Control.Ether.Wrapped
-import Control.Ether.TH (ethereal)
+import Control.Monad as X
+import Control.Monad.Fix as X
+import Control.Monad.Ether.Reader as X
+import Control.Monad.Ether.Writer as X
+import Control.Monad.Ether.State as X
+import Control.Monad.Ether.Except as X
+import Control.Monad.Trans.Ether.Dispatch as X
+import Control.Ether.TH as X (ethereal)
diff --git a/src/Control/Monad/Ether/Except/Class.hs b/src/Control/Monad/Ether/Except/Class.hs
--- a/src/Control/Monad/Ether/Except/Class.hs
+++ b/src/Control/Monad/Ether/Except/Class.hs
@@ -1,14 +1,16 @@
+{-# LANGUAGE CPP #-}
+
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE OverlappingInstances #-}
 {-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
+#endif
 
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
-
-#if __GLASGOW_HASKELL__ < 710
-{-# LANGUAGE OverlappingInstances #-}
-#endif
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
 
 -- | See "Control.Monad.Except".
 
@@ -16,7 +18,6 @@
     ( MonadExcept(..)
     ) where
 
-import Control.Monad.Trans.Ether.Except hiding (throw, catch)
 import qualified Control.Monad.Trans.Ether.Except as E
 import qualified Control.Monad.Trans.Lift.Catch as Lift
 
@@ -31,7 +32,7 @@
     -- normal execution.
     catch :: proxy tag -> m a -> (e -> m a) -> m a
 
-instance Monad m => MonadExcept tag e (ExceptT tag e m) where
+instance (Monad m, e ~ e') => MonadExcept tag e (E.ExceptT tag e' m) where
     throw = E.throw
     catch = E.catch
 
diff --git a/src/Control/Monad/Ether/Implicit.hs b/src/Control/Monad/Ether/Implicit.hs
--- a/src/Control/Monad/Ether/Implicit.hs
+++ b/src/Control/Monad/Ether/Implicit.hs
@@ -2,18 +2,13 @@
 -- | This module provides convenience exports of all
 -- implicitly tagged monad classes from Ether.
 
-module Control.Monad.Ether.Implicit
-    ( module Control.Monad
-    , module Control.Monad.Fix
-    , module Control.Monad.Ether.Implicit.Reader
-    , module Control.Monad.Ether.Implicit.Writer
-    , module Control.Monad.Ether.Implicit.State
-    , module Control.Monad.Ether.Implicit.Except
-    ) where
+module Control.Monad.Ether.Implicit (module X) where
 
-import Control.Monad
-import Control.Monad.Fix
-import Control.Monad.Ether.Implicit.Reader
-import Control.Monad.Ether.Implicit.Writer
-import Control.Monad.Ether.Implicit.State
-import Control.Monad.Ether.Implicit.Except
+import Control.Monad as X
+import Control.Monad.Fix as X
+import Control.Monad.Ether.Implicit.Reader as X
+import Control.Monad.Ether.Implicit.Writer as X
+import Control.Monad.Ether.Implicit.State as X
+import Control.Monad.Ether.Implicit.Except as X
+import Control.Monad.Trans.Ether.Dispatch as X
+import Control.Ether.TH as X (ethereal)
diff --git a/src/Control/Monad/Ether/Implicit/Except.hs b/src/Control/Monad/Ether/Implicit/Except.hs
--- a/src/Control/Monad/Ether/Implicit/Except.hs
+++ b/src/Control/Monad/Ether/Implicit/Except.hs
@@ -55,8 +55,8 @@
 
 -- | See 'Control.Monad.Ether.Except.handle'.
 handle :: (e -> a) -> Except e a -> a
-handle = Explicit.handle (Proxy :: Proxy e)
+handle = Explicit.handle Proxy
 
 -- | See 'Control.Monad.Ether.Except.handleT'.
 handleT :: Functor m => (e -> a) -> ExceptT e m a -> m a
-handleT = Explicit.handleT (Proxy :: Proxy e)
+handleT = Explicit.handleT Proxy
diff --git a/src/Control/Monad/Ether/Implicit/Reader.hs b/src/Control/Monad/Ether/Implicit/Reader.hs
--- a/src/Control/Monad/Ether/Implicit/Reader.hs
+++ b/src/Control/Monad/Ether/Implicit/Reader.hs
@@ -45,17 +45,17 @@
 type MonadReader r = Explicit.MonadReader r r
 
 -- | See 'Control.Monad.Ether.Reader.local'.
-local :: forall m r a . MonadReader r m => (r -> r) -> m a -> m a
+local :: forall r m a . MonadReader r m => (r -> r) -> m a -> m a
 local = Explicit.local (Proxy :: Proxy r)
 
 -- | See 'Control.Monad.Ether.Reader.ask'.
-ask :: forall m r . MonadReader r m => m r
+ask :: forall r m . MonadReader r m => m r
 ask = Explicit.ask (Proxy :: Proxy r)
 
 -- | See 'Control.Monad.Ether.Reader.reader'.
-reader :: forall m r a . MonadReader r m => (r -> a) -> m a
+reader :: forall r m a . MonadReader r m => (r -> a) -> m a
 reader = Explicit.reader (Proxy :: Proxy r)
 
 -- | See 'Control.Monad.Ether.Reader.asks'.
-asks :: forall m r a . MonadReader r m => (r -> a) -> m a
+asks :: forall r m a . MonadReader r m => (r -> a) -> m a
 asks = Explicit.asks (Proxy :: Proxy r)
diff --git a/src/Control/Monad/Ether/Implicit/State/Lazy.hs b/src/Control/Monad/Ether/Implicit/State/Lazy.hs
--- a/src/Control/Monad/Ether/Implicit/State/Lazy.hs
+++ b/src/Control/Monad/Ether/Implicit/State/Lazy.hs
@@ -66,21 +66,21 @@
 type MonadState s = Explicit.MonadState s s
 
 -- | See 'Control.Monad.Ether.State.Lazy.get'.
-get :: forall m s . MonadState s m => m s
+get :: forall s m . MonadState s m => m s
 get = Explicit.get (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Lazy.gets'.
-gets :: forall m s a . MonadState s m => (s -> a) -> m a
+gets :: forall s m a . MonadState s m => (s -> a) -> m a
 gets = Explicit.gets (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Lazy.put'.
-put :: forall m s . MonadState s m => s -> m ()
+put :: forall s m . MonadState s m => s -> m ()
 put = Explicit.put (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Lazy.state'.
-state :: forall m s a . MonadState s m => (s -> (a, s)) -> m a
+state :: forall s m a . MonadState s m => (s -> (a, s)) -> m a
 state = Explicit.state (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Lazy.modify'.
-modify :: forall m s . MonadState s m => (s -> s) -> m ()
+modify :: forall s m . MonadState s m => (s -> s) -> m ()
 modify = Explicit.modify (Proxy :: Proxy s)
diff --git a/src/Control/Monad/Ether/Implicit/State/Strict.hs b/src/Control/Monad/Ether/Implicit/State/Strict.hs
--- a/src/Control/Monad/Ether/Implicit/State/Strict.hs
+++ b/src/Control/Monad/Ether/Implicit/State/Strict.hs
@@ -66,21 +66,21 @@
 type MonadState s = Explicit.MonadState s s
 
 -- | See 'Control.Monad.Ether.State.Strict.get'.
-get :: forall m s . MonadState s m => m s
+get :: forall s m . MonadState s m => m s
 get = Explicit.get (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Strict.gets'.
-gets :: forall m s a . MonadState s m => (s -> a) -> m a
+gets :: forall s m a . MonadState s m => (s -> a) -> m a
 gets = Explicit.gets (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Strict.put'.
-put :: forall m s . MonadState s m => s -> m ()
+put :: forall s m . MonadState s m => s -> m ()
 put = Explicit.put (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Strict.state'.
-state :: forall m s a . MonadState s m => (s -> (a, s)) -> m a
+state :: forall s m a . MonadState s m => (s -> (a, s)) -> m a
 state = Explicit.state (Proxy :: Proxy s)
 
 -- | See 'Control.Monad.Ether.State.Strict.modify'.
-modify :: forall m s . MonadState s m => (s -> s) -> m ()
+modify :: forall s m . MonadState s m => (s -> s) -> m ()
 modify = Explicit.modify (Proxy :: Proxy s)
diff --git a/src/Control/Monad/Ether/Implicit/Writer.hs b/src/Control/Monad/Ether/Implicit/Writer.hs
--- a/src/Control/Monad/Ether/Implicit/Writer.hs
+++ b/src/Control/Monad/Ether/Implicit/Writer.hs
@@ -31,27 +31,27 @@
 type MonadWriter w = Explicit.MonadWriter w w
 
 -- | See 'Control.Monad.Ether.Writer.writer'.
-writer :: forall m w a . MonadWriter w m => (a, w) -> m a
+writer :: forall w m a . MonadWriter w m => (a, w) -> m a
 writer = Explicit.writer (Proxy :: Proxy w)
 
 -- | See 'Control.Monad.Ether.Writer.tell'.
-tell :: forall m w . MonadWriter w m => w -> m ()
+tell :: forall w m . MonadWriter w m => w -> m ()
 tell = Explicit.tell (Proxy :: Proxy w)
 
 -- | See 'Control.Monad.Ether.Writer.listen'.
-listen :: forall m w a . MonadWriter w m => m a -> m (a, w)
+listen :: forall w m a . MonadWriter w m => m a -> m (a, w)
 listen = Explicit.listen (Proxy :: Proxy w)
 
 -- | See 'Control.Monad.Ether.Writer.pass'.
-pass :: forall m w a . MonadWriter w m => m (a, w -> w) -> m a
+pass :: forall w m a . MonadWriter w m => m (a, w -> w) -> m a
 pass = Explicit.pass (Proxy :: Proxy w)
 
 -- | See 'Control.Monad.Ether.Writer.listens'.
-listens :: forall m w a b . MonadWriter w m => (w -> b) -> m a -> m (a, b)
+listens :: forall w m a b . MonadWriter w m => (w -> b) -> m a -> m (a, b)
 listens = Explicit.listens (Proxy :: Proxy w)
 
 -- | See 'Control.Monad.Ether.Writer.censor'.
-censor :: forall m w a . MonadWriter w m => (w -> w) -> m a -> m a
+censor :: forall w m a . MonadWriter w m => (w -> w) -> m a -> m a
 censor = Explicit.censor (Proxy :: Proxy w)
 
 -- | See 'Control.Monad.Ether.Writer.Writer'.
diff --git a/src/Control/Monad/Ether/Reader/Class.hs b/src/Control/Monad/Ether/Reader/Class.hs
--- a/src/Control/Monad/Ether/Reader/Class.hs
+++ b/src/Control/Monad/Ether/Reader/Class.hs
@@ -1,14 +1,16 @@
+{-# LANGUAGE CPP #-}
+
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE OverlappingInstances #-}
 {-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
+#endif
 
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
-
-#if __GLASGOW_HASKELL__ < 710
-{-# LANGUAGE OverlappingInstances #-}
-#endif
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
 
 -- | See "Control.Monad.Reader.Class".
 
@@ -17,7 +19,6 @@
     , asks
     ) where
 
-import Control.Monad.Trans.Ether.Reader hiding (reader, ask, local)
 import qualified Control.Monad.Trans.Ether.Reader as R
 import qualified Control.Monad.Trans.Lift.Local as Lift
 import qualified Control.Ether.Util as Util
@@ -57,7 +58,7 @@
     -> m a
 asks = reader
 
-instance Monad m => MonadReader tag r (ReaderT tag r m) where
+instance (Monad m, r ~ r') => MonadReader tag r (R.ReaderT tag r' m) where
     ask = R.ask
     local = R.local
     reader = R.reader
diff --git a/src/Control/Monad/Ether/State/Class.hs b/src/Control/Monad/Ether/State/Class.hs
--- a/src/Control/Monad/Ether/State/Class.hs
+++ b/src/Control/Monad/Ether/State/Class.hs
@@ -1,14 +1,16 @@
+{-# LANGUAGE CPP #-}
+
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE OverlappingInstances #-}
 {-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
+#endif
 
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
-
-#if __GLASGOW_HASKELL__ < 710
-{-# LANGUAGE OverlappingInstances #-}
-#endif
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
 
 -- | See "Control.Monad.State.Class".
 
@@ -18,10 +20,9 @@
     , gets
     ) where
 
-import Control.Monad.Trans (MonadTrans(..))
-
 import qualified Control.Monad.Trans.Ether.State.Lazy   as S.L
 import qualified Control.Monad.Trans.Ether.State.Strict as S.S
+import qualified Control.Monad.Trans as Lift
 import qualified Control.Ether.Util as Util
 
 -- | See 'Control.Monad.State.MonadState'.
@@ -53,21 +54,21 @@
 gets :: MonadState tag s m => proxy tag -> (s -> a) -> m a
 gets t f = Util.fmap f (get t)
 
-instance Monad m => MonadState tag s (S.L.StateT tag s m) where
+instance (Monad m, s ~ s') => MonadState tag s (S.L.StateT tag s' m) where
     get = S.L.get
     put = S.L.put
     state = S.L.state
 
-instance Monad m => MonadState tag s (S.S.StateT tag s m) where
+instance (Monad m, s ~ s') => MonadState tag s (S.S.StateT tag s' m) where
     get = S.S.get
     put = S.S.put
     state = S.S.state
 
 instance {-# OVERLAPPABLE #-}
-         ( MonadTrans t
+         ( Lift.MonadTrans t
          , Monad (t m)
          , MonadState tag s m
          ) => MonadState tag s (t m) where
-    get t = lift (get t)
-    put t = lift . put t
-    state t = lift . state t
+    get t = Lift.lift (get t)
+    put t = Lift.lift . put t
+    state t = Lift.lift . state t
diff --git a/src/Control/Monad/Ether/Writer/Class.hs b/src/Control/Monad/Ether/Writer/Class.hs
--- a/src/Control/Monad/Ether/Writer/Class.hs
+++ b/src/Control/Monad/Ether/Writer/Class.hs
@@ -1,14 +1,16 @@
+{-# LANGUAGE CPP #-}
+
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE OverlappingInstances #-}
 {-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
+#endif
 
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
-
-#if __GLASGOW_HASKELL__ < 710
-{-# LANGUAGE OverlappingInstances #-}
-#endif
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
 
 -- | See "Control.Monad.Writer.Class".
 
@@ -22,7 +24,6 @@
 import Data.Monoid
 #endif
 
-import Control.Monad.Trans.Ether.Writer hiding (writer, tell, listen, pass)
 import qualified Control.Monad.Trans.Ether.Writer as W
 import qualified Control.Monad.Trans.Lift.Listen as Lift
 import qualified Control.Monad.Trans.Lift.Pass   as Lift
@@ -63,7 +64,7 @@
     a <- m
     return (a, f)
 
-instance (Monoid w, Monad m) => MonadWriter tag w (WriterT tag w m) where
+instance (Monoid w, Monad m, w ~ w') => MonadWriter tag w (W.WriterT tag w' m) where
     writer = W.writer
     tell = W.tell
     listen = W.listen
diff --git a/src/Control/Monad/Trans/Ether/Dispatch.hs b/src/Control/Monad/Trans/Ether/Dispatch.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Trans/Ether/Dispatch.hs
@@ -0,0 +1,209 @@
+{-# LANGUAGE CPP #-}
+
+#if __GLASGOW_HASKELL__ >= 710
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
+#endif
+
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{- |
+
+Type-level machinery to manipulate constraints on the monad
+transformer stack.
+
+Out of the box it provides the following dispatch strategies:
+
+* 'tagAttach' to use functions defined using untagged monad classes
+  as if they were defined using tagged ones.
+
+* 'tagReplace' to use functions defined using one tag
+  as if they were defined using another one.
+
+> import qualified Control.Monad.State as T
+> import Control.Ether.TH (ethereal)
+> import Control.Monad.Ether.State (MonadState)
+> import Control.Monad.Trans.Ether.Dispatch (tagAttach, tagDispatch)
+>
+> ethereal "Foo" "foo"
+> ethereal "Bar" "bar"
+>
+> f :: T.MonadState Int m => m String
+> f = fmap show T.get
+>
+> g :: MonadState Foo Int m => m String
+> g = tagAttach foo f
+>
+> h :: MonadState Bar Int m => m String
+> h = tagReplace foo bar g
+
+-}
+
+module Control.Monad.Trans.Ether.Dispatch
+  (
+  -- * The DispatchT monad transformer
+    DispatchT
+  -- * Dispatch types and functions
+  , K_TagAttach(..)
+  , K_TagReplace(..)
+  , tagAttach
+  , tagReplace
+  ) where
+
+import Control.Applicative
+import Control.Monad (MonadPlus)
+import Control.Monad.Fix (MonadFix)
+import Control.Monad.Trans.Class (MonadTrans)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Morph (MFunctor, MMonad)
+import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
+import GHC.Generics (Generic)
+import Data.Coerce (coerce)
+import Data.Proxy
+
+import qualified Control.Monad.Base as MB
+import qualified Control.Monad.Trans.Control as MC
+import qualified Control.Monad.Trans.Identity as Trans
+
+import qualified Control.Monad.Trans.Lift.StT    as Lift
+import qualified Control.Monad.Trans.Lift.Local  as Lift
+import qualified Control.Monad.Trans.Lift.Catch  as Lift
+import qualified Control.Monad.Trans.Lift.Listen as Lift
+import qualified Control.Monad.Trans.Lift.Pass   as Lift
+import qualified Control.Monad.Trans.Lift.CallCC as Lift
+
+import Control.Monad.Ether.Reader.Class
+import Control.Monad.Ether.State.Class
+import Control.Monad.Ether.Except.Class
+import Control.Monad.Ether.Writer.Class
+
+import qualified Control.Monad.Reader as Class
+import qualified Control.Monad.State  as Class
+import qualified Control.Monad.Except as Class
+import qualified Control.Monad.Writer as Class
+
+-- | Encode type-level information for 'tagAttach'.
+data K_TagAttach t = TagAttach t
+
+-- | Encode type-level information for 'tagReplace'.
+data K_TagReplace tOld tNew = TagReplace tOld tNew
+
+-- | Wrap a monad to change its tags. Under the hood this is
+-- simply 'Trans.IdentityT', all the work is happening on the type level.
+newtype DispatchT dp m a = DispatchT (Trans.IdentityT m a)
+  deriving
+    ( Generic
+    , Functor, Applicative, Alternative, Monad, MonadPlus
+    , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
+    , MonadThrow, MonadCatch, MonadMask )
+
+type DispatchTagAttachT t = DispatchT (TagAttach t)
+type DispatchTagReplaceT tOld tNew = DispatchT (TagReplace tOld tNew)
+
+-- | Type-restricted 'coerce'.
+pack :: Trans.IdentityT m a -> DispatchT dp m a
+pack = coerce
+
+-- | Type-restricted 'coerce'.
+unpack :: DispatchT dp m a -> Trans.IdentityT m a
+unpack = coerce
+
+instance MB.MonadBase b m => MB.MonadBase b (DispatchT dp m) where
+  liftBase = MB.liftBaseDefault
+
+instance MC.MonadTransControl (DispatchT dp) where
+  type StT (DispatchT dp) a = MC.StT Trans.IdentityT a
+  liftWith = MC.defaultLiftWith pack unpack
+  restoreT = MC.defaultRestoreT pack
+
+instance MC.MonadBaseControl b m => MC.MonadBaseControl b (DispatchT dp m) where
+  type StM (DispatchT dp m) a = MC.ComposeSt (DispatchT dp) m a
+  liftBaseWith = MC.defaultLiftBaseWith
+  restoreM = MC.defaultRestoreM
+
+type instance Lift.StT (DispatchT dp) a = MC.StT (DispatchT dp) a
+
+instance Lift.LiftLocal (DispatchT dp) where
+  liftLocal = Lift.defaultLiftLocal pack unpack
+
+instance Lift.LiftCatch (DispatchT dp) where
+  liftCatch = Lift.defaultLiftCatch pack unpack
+
+instance Lift.LiftListen (DispatchT dp) where
+  liftListen = Lift.defaultLiftListen pack unpack
+
+instance Lift.LiftPass (DispatchT dp) where
+  liftPass = Lift.defaultLiftPass pack unpack
+
+instance Lift.LiftCallCC (DispatchT dp) where
+  liftCallCC  = Lift.defaultLiftCallCC  pack unpack
+  liftCallCC' = Lift.defaultLiftCallCC' pack unpack
+
+-- | Attach a tag to untagged transformers.
+tagAttach :: proxy t -> DispatchTagAttachT t m a -> m a
+tagAttach _ = coerce
+
+-- | Replace a tag with another tag.
+tagReplace
+  :: proxy tOld
+  -> proxy tNew
+  -> DispatchTagReplaceT tOld tNew m a
+  -> m a
+tagReplace _ _ = coerce
+
+
+-- TagAttach instances
+
+instance MonadReader tag r m
+      => Class.MonadReader r (DispatchTagAttachT tag m) where
+  ask   = let t = Proxy :: Proxy tag in Lift.lift (ask t)
+  local = let t = Proxy :: Proxy tag in Lift.liftLocal (ask t) (local t)
+
+instance MonadState tag s m
+      => Class.MonadState s (DispatchTagAttachT tag m) where
+  get = let t = Proxy :: Proxy tag in Lift.lift (get t)
+  put = let t = Proxy :: Proxy tag in Lift.lift . put t
+
+instance MonadExcept tag e m
+      => Class.MonadError e (DispatchTagAttachT tag m) where
+  throwError = let t = Proxy :: Proxy tag in Lift.lift . throw t
+  catchError = let t = Proxy :: Proxy tag in Lift.liftCatch (catch t)
+
+instance MonadWriter tag w m
+      => Class.MonadWriter w (DispatchTagAttachT tag m) where
+  writer = let t = Proxy :: Proxy tag in Lift.lift . writer t
+  tell   = let t = Proxy :: Proxy tag in Lift.lift . tell t
+  listen = let t = Proxy :: Proxy tag in Lift.liftListen (listen t)
+  pass   = let t = Proxy :: Proxy tag in Lift.liftPass (pass t)
+
+
+-- TagReplace instances
+
+instance MonadReader tNew r m
+      => MonadReader tOld r (DispatchTagReplaceT tOld tNew m) where
+  ask   _ = let t = Proxy :: Proxy tNew in Lift.lift (ask t)
+  local _ = let t = Proxy :: Proxy tNew in Lift.liftLocal (ask t) (local t)
+
+instance MonadState tNew s m
+      => MonadState tOld s (DispatchTagReplaceT tOld tNew m) where
+  get _ = let t = Proxy :: Proxy tNew in Lift.lift (get t)
+  put _ = let t = Proxy :: Proxy tNew in Lift.lift . put t
+
+instance MonadExcept tNew e m
+      => MonadExcept tOld e (DispatchTagReplaceT tOld tNew m) where
+  throw _ = let t = Proxy :: Proxy tNew in Lift.lift . throw t
+  catch _ = let t = Proxy :: Proxy tNew in Lift.liftCatch (catch t)
+
+instance MonadWriter tNew w m
+      => MonadWriter tOld w (DispatchTagReplaceT tOld tNew m) where
+  writer _ = let t = Proxy :: Proxy tNew in Lift.lift . writer t
+  tell   _ = let t = Proxy :: Proxy tNew in Lift.lift . tell t
+  listen _ = let t = Proxy :: Proxy tNew in Lift.liftListen (listen t)
+  pass   _ = let t = Proxy :: Proxy tNew in Lift.liftPass (pass t)
diff --git a/src/Control/Monad/Trans/Ether/Except.hs b/src/Control/Monad/Trans/Ether/Except.hs
--- a/src/Control/Monad/Trans/Ether/Except.hs
+++ b/src/Control/Monad/Trans/Ether/Except.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- | See "Control.Monad.Trans.Except".
@@ -24,32 +25,8 @@
     ) where
 
 import Data.Functor.Identity (Identity(..))
-import Control.Applicative
-import Control.Monad (MonadPlus)
-import Control.Monad.Fix (MonadFix)
-import Control.Monad.Trans.Class (MonadTrans, lift)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Morph (MFunctor, MMonad)
-import Control.Ether.Tagged (Taggable(..), Tagged(..))
-import GHC.Generics (Generic)
-import qualified Control.Newtype as NT
-
-import qualified Control.Monad.Base as MB
-import qualified Control.Monad.Trans.Control as MC
 import qualified Control.Monad.Trans.Except as Trans
-
-import qualified Control.Monad.Trans.Lift.StT    as Lift
-import qualified Control.Monad.Trans.Lift.Local  as Lift
-import qualified Control.Monad.Trans.Lift.Catch  as Lift
-import qualified Control.Monad.Trans.Lift.Listen as Lift
-import qualified Control.Monad.Trans.Lift.Pass   as Lift
-import qualified Control.Monad.Trans.Lift.CallCC as Lift
-
-import qualified Control.Monad.Cont.Class    as Class
-import qualified Control.Monad.Reader.Class  as Class
-import qualified Control.Monad.State.Class   as Class
-import qualified Control.Monad.Writer.Class  as Class
-import qualified Control.Monad.Error.Class   as Class
+import Control.Monad.Trans.Ether.Tagged
 
 
 -- | The parameterizable exception monad.
@@ -62,60 +39,17 @@
 
 -- | Runs an 'Except' and returns either an exception or a normal value.
 runExcept :: proxy tag -> Except tag e a -> Either e a
-runExcept t = Trans.runExcept . untagged t
+runExcept _ = Trans.runExcept . unpack
 
 -- | The exception monad transformer.
 --
 -- The 'return' function returns a normal value, while '>>=' exits on
 -- the first exception.
-newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
-    deriving ( Generic
-             , Functor, Applicative, Alternative, Monad, MonadPlus
-             , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
-
-instance NT.Newtype (ExceptT tag e m a)
-
-instance MB.MonadBase b m => MB.MonadBase b (ExceptT tag e m) where
-    liftBase = MB.liftBaseDefault
-
-instance MC.MonadTransControl (ExceptT tag e) where
-    type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
-    liftWith = MC.defaultLiftWith NT.pack NT.unpack
-    restoreT = MC.defaultRestoreT NT.pack
-
-instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ExceptT tag e m) where
-    type StM (ExceptT tag e m) a = MC.ComposeSt (ExceptT tag e) m a
-    liftBaseWith = MC.defaultLiftBaseWith
-    restoreM = MC.defaultRestoreM
-
-type instance Lift.StT (ExceptT tag e) a = MC.StT (ExceptT tag e) a
-
-instance Lift.LiftLocal (ExceptT tag e) where
-    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
-
-instance Lift.LiftCatch (ExceptT tag e) where
-    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
-
-instance Lift.LiftListen (ExceptT tag e) where
-    liftListen = Lift.defaultLiftListen NT.pack NT.unpack
-
-instance Lift.LiftPass (ExceptT tag e) where
-    liftPass = Lift.defaultLiftPass NT.pack NT.unpack
-
-instance Lift.LiftCallCC (ExceptT tag e) where
-    liftCallCC  = Lift.defaultLiftCallCC NT.pack NT.unpack
-    liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack
-
-instance Taggable (ExceptT tag e m) where
-    type Tag (ExceptT tag e m) = 'Just tag
-    type Inner (ExceptT tag e m) = 'Just m
-
-instance Tagged (ExceptT tag e m) tag where
-    type Untagged (ExceptT tag e m) = Trans.ExceptT e m
+type ExceptT tag e = TaggedTrans tag (Trans.ExceptT e)
 
 -- | Constructor for computations in the exception monad transformer.
 exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a
-exceptT t = tagged t . Trans.ExceptT
+exceptT _ = pack . Trans.ExceptT
 
 -- | Constructor for computations in the exception monad
 -- (the inverse of 'runExcept').
@@ -124,35 +58,12 @@
 
 -- | Runs an 'ExceptT' and returns either an exception or a normal value.
 runExceptT :: proxy tag -> ExceptT tag e m a -> m (Either e a)
-runExceptT t = Trans.runExceptT . untagged t
+runExceptT _ = Trans.runExceptT . unpack
 
 -- | Is used within a monadic computation to begin exception processing.
 throw :: Monad m => proxy tag -> e -> ExceptT tag e m a
-throw t = tagged t . Trans.throwE
+throw _ = pack . Trans.throwE
 
 -- | A handler function to handle previous exceptions and return to normal execution.
 catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
-catch t m h = tagged t $ Trans.catchE (untagged t m) (untagged t . h)
-
-instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
-    callCC = Lift.liftCallCC Class.callCC
-
-instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where
-    ask = lift Class.ask
-    local = Lift.liftLocal Class.ask Class.local
-    reader = lift . Class.reader
-
-instance Class.MonadState s m => Class.MonadState s (ExceptT tag e m) where
-    get = lift Class.get
-    put = lift . Class.put
-    state = lift . Class.state
-
-instance Class.MonadWriter w m => Class.MonadWriter w (ExceptT tag e m) where
-    writer = lift . Class.writer
-    tell   = lift . Class.tell
-    listen = Lift.liftListen Class.listen
-    pass   = Lift.liftPass Class.pass
-
-instance Class.MonadError e' m => Class.MonadError e' (ExceptT tag e m) where
-    throwError = lift . Class.throwError
-    catchError = Lift.liftCatch Class.catchError
+catch _ m h = pack $ Trans.catchE (unpack m) (unpack . h)
diff --git a/src/Control/Monad/Trans/Ether/Reader.hs b/src/Control/Monad/Trans/Ether/Reader.hs
--- a/src/Control/Monad/Trans/Ether/Reader.hs
+++ b/src/Control/Monad/Trans/Ether/Reader.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- | See "Control.Monad.Trans.Reader".
@@ -24,32 +25,8 @@
     ) where
 
 import Data.Functor.Identity (Identity(..))
-import Control.Applicative
-import Control.Monad (MonadPlus)
-import Control.Monad.Fix (MonadFix)
-import Control.Monad.Trans.Class (MonadTrans, lift)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Morph (MFunctor, MMonad)
-import Control.Ether.Tagged (Taggable(..), Tagged(..))
-import GHC.Generics (Generic)
-import qualified Control.Newtype as NT
-
-import qualified Control.Monad.Base as MB
-import qualified Control.Monad.Trans.Control as MC
 import qualified Control.Monad.Trans.Reader as Trans
-
-import qualified Control.Monad.Trans.Lift.StT    as Lift
-import qualified Control.Monad.Trans.Lift.Local  as Lift
-import qualified Control.Monad.Trans.Lift.Catch  as Lift
-import qualified Control.Monad.Trans.Lift.Listen as Lift
-import qualified Control.Monad.Trans.Lift.Pass   as Lift
-import qualified Control.Monad.Trans.Lift.CallCC as Lift
-
-import qualified Control.Monad.Cont.Class    as Class
-import qualified Control.Monad.Reader.Class  as Class
-import qualified Control.Monad.State.Class   as Class
-import qualified Control.Monad.Writer.Class  as Class
-import qualified Control.Monad.Error.Class   as Class
+import Control.Monad.Trans.Ether.Tagged
 
 -- | The parameterizable reader monad.
 --
@@ -64,73 +41,30 @@
 --
 -- The 'return' function ignores the environment, while '>>=' passes
 -- the inherited environment to both subcomputations.
-newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
-    deriving ( Generic
-             , Functor, Applicative, Alternative, Monad, MonadPlus
-             , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
-
-instance NT.Newtype (ReaderT tag r m a)
-
-instance MB.MonadBase b m => MB.MonadBase b (ReaderT tag r m) where
-    liftBase = MB.liftBaseDefault
-
-instance MC.MonadTransControl (ReaderT tag r) where
-    type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
-    liftWith = MC.defaultLiftWith NT.pack NT.unpack
-    restoreT = MC.defaultRestoreT NT.pack
-
-instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) where
-    type StM (ReaderT tag r m) a = MC.ComposeSt (ReaderT tag r) m a
-    liftBaseWith = MC.defaultLiftBaseWith
-    restoreM = MC.defaultRestoreM
-
-type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a
-
-instance Lift.LiftLocal (ReaderT tag r) where
-    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
-
-instance Lift.LiftCatch (ReaderT tag r) where
-    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
-
-instance Lift.LiftListen (ReaderT tag r) where
-    liftListen = Lift.defaultLiftListen NT.pack NT.unpack
-
-instance Lift.LiftPass (ReaderT tag r) where
-    liftPass = Lift.defaultLiftPass NT.pack NT.unpack
-
-instance Lift.LiftCallCC (ReaderT tag r) where
-    liftCallCC  = Lift.defaultLiftCallCC  NT.pack NT.unpack
-    liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
-
-instance Taggable (ReaderT tag r m) where
-    type Tag (ReaderT tag r m) = 'Just tag
-    type Inner (ReaderT tag r m) = 'Just m
-
-instance Tagged (ReaderT tag r m) tag where
-    type Untagged (ReaderT tag r m) = Trans.ReaderT r m
+type ReaderT tag r = TaggedTrans tag (Trans.ReaderT r)
 
 -- | Constructor for computations in the reader monad transformer.
 readerT :: proxy tag -> (r -> m a) -> ReaderT tag r m a
-readerT t = tagged t . Trans.ReaderT
+readerT _ = pack . Trans.ReaderT
 
 -- | Constructor for computations in the reader monad
 -- (the inverse of 'runReader').
 reader :: Monad m => proxy tag -> (r -> a) -> ReaderT tag r m a
-reader t = tagged t . Trans.reader
+reader _ = pack . Trans.reader
 
 -- | Runs a 'ReaderT' with the given environment
 -- and returns the vinal value.
 runReaderT :: proxy tag -> ReaderT tag r m a -> r -> m a
-runReaderT t = Trans.runReaderT . untagged t
+runReaderT _ = Trans.runReaderT . unpack
 
 -- | Runs a 'ReaderT' with the given environment
 -- and returns the vinal value.
 runReader :: proxy tag -> Reader tag r a -> r -> a
-runReader t = Trans.runReader . untagged t
+runReader _ = Trans.runReader . unpack
 
 -- | Fetch the value of the environment.
 ask :: Monad m => proxy tag -> ReaderT tag r m r
-ask t = tagged t Trans.ask
+ask _ = pack Trans.ask
 
 -- | Execute a computation in a modified environment
 -- (a specialization of 'withReaderT').
@@ -143,29 +77,4 @@
     -> ReaderT tag r m a
     -- ^ Computation to run in the modified environment.
     -> ReaderT tag r m a
-local t f m = tagged t $ Trans.withReaderT f (untagged t m)
-
--- Instances for mtl classes
-
-instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where
-    callCC = Lift.liftCallCC Class.callCC
-
-instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where
-    ask = lift Class.ask
-    local = Lift.liftLocal Class.ask Class.local
-    reader = lift . Class.reader
-
-instance Class.MonadState s m => Class.MonadState s (ReaderT tag r m) where
-    get = lift Class.get
-    put = lift . Class.put
-    state = lift . Class.state
-
-instance Class.MonadWriter w m => Class.MonadWriter w (ReaderT tag r m) where
-    writer = lift . Class.writer
-    tell   = lift . Class.tell
-    listen = Lift.liftListen Class.listen
-    pass   = Lift.liftPass Class.pass
-
-instance Class.MonadError e m => Class.MonadError e (ReaderT tag r m) where
-    throwError = lift . Class.throwError
-    catchError = Lift.liftCatch Class.catchError
+local _ f = pack . Trans.withReaderT f . unpack
diff --git a/src/Control/Monad/Trans/Ether/State/Lazy.hs b/src/Control/Monad/Trans/Ether/State/Lazy.hs
--- a/src/Control/Monad/Trans/Ether/State/Lazy.hs
+++ b/src/Control/Monad/Trans/Ether/State/Lazy.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- | See "Control.Monad.Trans.State.Lazy".
@@ -28,33 +29,8 @@
     ) where
 
 import Data.Functor.Identity (Identity(..))
-import Control.Applicative
-import Control.Monad (MonadPlus)
-import Control.Monad.Fix (MonadFix)
-import Control.Monad.Trans.Class (MonadTrans, lift)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Morph (MFunctor)
-import Control.Ether.Tagged (Taggable(..), Tagged(..))
-import GHC.Generics (Generic)
-import qualified Control.Newtype as NT
-
-import qualified Control.Monad.Base as MB
-import qualified Control.Monad.Trans.Control as MC
 import qualified Control.Monad.Trans.State.Lazy as Trans
-
-import qualified Control.Monad.Trans.Lift.StT    as Lift
-import qualified Control.Monad.Trans.Lift.Local  as Lift
-import qualified Control.Monad.Trans.Lift.Catch  as Lift
-import qualified Control.Monad.Trans.Lift.Listen as Lift
-import qualified Control.Monad.Trans.Lift.Pass   as Lift
-import qualified Control.Monad.Trans.Lift.CallCC as Lift
-
-import qualified Control.Monad.Cont.Class    as Class
-import qualified Control.Monad.Reader.Class  as Class
-import qualified Control.Monad.State.Class   as Class
-import qualified Control.Monad.Writer.Class  as Class
-import qualified Control.Monad.Error.Class   as Class
-
+import Control.Monad.Trans.Ether.Tagged
 
 -- | The parametrizable state monad.
 --
@@ -68,119 +44,51 @@
 --
 -- The 'return' function leaves the state unchanged, while '>>=' uses
 -- the final state of the first computation as the initial state of the second.
-newtype StateT tag s m a = StateT (Trans.StateT s m a)
-    deriving ( Generic
-             , Functor, Applicative, Alternative, Monad, MonadPlus
-             , MonadFix, MonadTrans, MonadIO, MFunctor )
-
-instance NT.Newtype (StateT tag s m a)
-
-instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
-    liftBase = MB.liftBaseDefault
-
-instance MC.MonadTransControl (StateT tag s) where
-    type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
-    liftWith = MC.defaultLiftWith NT.pack NT.unpack
-    restoreT = MC.defaultRestoreT NT.pack
-
-instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
-    type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
-    liftBaseWith = MC.defaultLiftBaseWith
-    restoreM = MC.defaultRestoreM
-
-type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
-
-instance Lift.LiftLocal (StateT tag s) where
-    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
-
-instance Lift.LiftCatch (StateT tag s) where
-    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
-
-instance Lift.LiftListen (StateT tag s) where
-    liftListen = Lift.defaultLiftListen NT.pack NT.unpack
-
-instance Lift.LiftPass (StateT tag s) where
-    liftPass = Lift.defaultLiftPass NT.pack NT.unpack
-
-instance Lift.LiftCallCC (StateT tag s) where
-    liftCallCC  = Lift.defaultLiftCallCC  NT.pack NT.unpack
-    liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
-
-instance Taggable (StateT tag s m) where
-    type Tag (StateT tag s m) = 'Just tag
-    type Inner (StateT tag s m) = 'Just m
-
-instance Tagged (StateT tag s m) tag where
-    type Untagged (StateT tag s m) = Trans.StateT s m
+type StateT tag s = TaggedTrans tag (Trans.StateT s)
 
 -- | Constructor for computations in the state monad transformer.
 stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
-stateT t = tagged t . Trans.StateT
+stateT _ = pack . Trans.StateT
 
 -- | Constructor for computations in the state monad
 -- (the inverse of 'runState').
 state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a
-state t = tagged t . Trans.state
+state _ = pack . Trans.state
 
 -- | Runs a 'StateT' with the given initial state
 -- and returns both the final value and the final state.
 runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)
-runStateT t = Trans.runStateT . untagged t
+runStateT _ = Trans.runStateT . unpack
 
 -- | Runs a 'StateT' with the given initial state
 -- and returns the final value, discarding the final state.
 evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a
-evalStateT t = Trans.evalStateT . untagged t
+evalStateT _ = Trans.evalStateT . unpack
 
 -- | Runs a 'StateT' with the given initial state
 -- and returns the final state, discarding the final value.
 execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s
-execStateT t = Trans.execStateT . untagged t
+execStateT _ = Trans.execStateT . unpack
 
 -- | Runs a 'State' with the given initial state
 -- and returns both the final value and the final state.
 runState :: proxy tag -> State tag s a -> s -> (a, s)
-runState t = Trans.runState . untagged t
+runState _ = Trans.runState . unpack
 
 -- | Runs a 'State' with the given initial state
 -- and returns the final value, discarding the final state.
 evalState :: proxy tag -> State tag s a -> s -> a
-evalState t = Trans.evalState . untagged t
+evalState _ = Trans.evalState . unpack
 
 -- | Runs a 'State' with the given initial state
 -- and returns the final state, discarding the final value.
 execState :: proxy tag -> State tag s a -> s -> s
-execState t = Trans.execState . untagged t
+execState _ = Trans.execState . unpack
 
 -- | Fetch the current value of the state within the monad.
 get :: Monad m => proxy tag -> StateT tag s m s
-get t = tagged t Trans.get
+get _ = pack Trans.get
 
 -- | Set the value of the state within the monad.
 put :: Monad m => proxy tag -> s -> StateT tag s m ()
-put t = tagged t . Trans.put
-
--- Instances for mtl classes
-
-instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
-    callCC = Lift.liftCallCC' Class.callCC
-
-instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
-    ask = lift Class.ask
-    local = Lift.liftLocal Class.ask Class.local
-    reader = lift . Class.reader
-
-instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where
-    get = lift Class.get
-    put = lift . Class.put
-    state = lift . Class.state
-
-instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where
-    writer = lift . Class.writer
-    tell   = lift . Class.tell
-    listen = Lift.liftListen Class.listen
-    pass   = Lift.liftPass Class.pass
-
-instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where
-    throwError = lift . Class.throwError
-    catchError = Lift.liftCatch Class.catchError
+put _ = pack . Trans.put
diff --git a/src/Control/Monad/Trans/Ether/State/Strict.hs b/src/Control/Monad/Trans/Ether/State/Strict.hs
--- a/src/Control/Monad/Trans/Ether/State/Strict.hs
+++ b/src/Control/Monad/Trans/Ether/State/Strict.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- | See "Control.Monad.Trans.State.Strict".
@@ -28,33 +29,8 @@
     ) where
 
 import Data.Functor.Identity (Identity(..))
-import Control.Applicative
-import Control.Monad (MonadPlus)
-import Control.Monad.Fix (MonadFix)
-import Control.Monad.Trans.Class (MonadTrans, lift)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Morph (MFunctor)
-import Control.Ether.Tagged (Taggable(..), Tagged(..))
-import GHC.Generics (Generic)
-import qualified Control.Newtype as NT
-
-import qualified Control.Monad.Base as MB
-import qualified Control.Monad.Trans.Control as MC
 import qualified Control.Monad.Trans.State.Strict as Trans
-
-import qualified Control.Monad.Trans.Lift.StT    as Lift
-import qualified Control.Monad.Trans.Lift.Local  as Lift
-import qualified Control.Monad.Trans.Lift.Catch  as Lift
-import qualified Control.Monad.Trans.Lift.Listen as Lift
-import qualified Control.Monad.Trans.Lift.Pass   as Lift
-import qualified Control.Monad.Trans.Lift.CallCC as Lift
-
-import qualified Control.Monad.Cont.Class    as Class
-import qualified Control.Monad.Reader.Class  as Class
-import qualified Control.Monad.State.Class   as Class
-import qualified Control.Monad.Writer.Class  as Class
-import qualified Control.Monad.Error.Class   as Class
-
+import Control.Monad.Trans.Ether.Tagged
 
 -- | The parametrizable state monad.
 --
@@ -68,119 +44,51 @@
 --
 -- The 'return' function leaves the state unchanged, while '>>=' uses
 -- the final state of the first computation as the initial state of the second.
-newtype StateT tag s m a = StateT (Trans.StateT s m a)
-    deriving ( Generic
-             , Functor, Applicative, Alternative, Monad, MonadPlus
-             , MonadFix, MonadTrans, MonadIO, MFunctor )
-
-instance NT.Newtype (StateT tag s m a)
-
-instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where
-    liftBase = MB.liftBaseDefault
-
-instance MC.MonadTransControl (StateT tag s) where
-    type StT (StateT tag s) a = MC.StT (Trans.StateT s) a
-    liftWith = MC.defaultLiftWith NT.pack NT.unpack
-    restoreT = MC.defaultRestoreT NT.pack
-
-instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where
-    type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a
-    liftBaseWith = MC.defaultLiftBaseWith
-    restoreM = MC.defaultRestoreM
-
-type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a
-
-instance Lift.LiftLocal (StateT tag s) where
-    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
-
-instance Lift.LiftCatch (StateT tag s) where
-    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
-
-instance Lift.LiftListen (StateT tag s) where
-    liftListen = Lift.defaultLiftListen NT.pack NT.unpack
-
-instance Lift.LiftPass (StateT tag s) where
-    liftPass = Lift.defaultLiftPass NT.pack NT.unpack
-
-instance Lift.LiftCallCC (StateT tag s) where
-    liftCallCC  = Lift.defaultLiftCallCC  NT.pack NT.unpack
-    liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack
-
-instance Taggable (StateT tag s m) where
-    type Tag (StateT tag s m) = 'Just tag
-    type Inner (StateT tag s m) = 'Just m
-
-instance Tagged (StateT tag s m) tag where
-    type Untagged (StateT tag s m) = Trans.StateT s m
+type StateT tag s = TaggedTrans tag (Trans.StateT s)
 
 -- | Constructor for computations in the state monad transformer.
 stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
-stateT t = tagged t . Trans.StateT
+stateT _ = pack . Trans.StateT
 
 -- | Constructor for computations in the state monad
 -- (the inverse of 'runState').
 state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a
-state t = tagged t . Trans.state
+state _ = pack . Trans.state
 
 -- | Runs a 'StateT' with the given initial state
 -- and returns both the final value and the final state.
 runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)
-runStateT t = Trans.runStateT . untagged t
+runStateT _ = Trans.runStateT . unpack
 
 -- | Runs a 'StateT' with the given initial state
 -- and returns the final value, discarding the final state.
 evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a
-evalStateT t = Trans.evalStateT . untagged t
+evalStateT _ = Trans.evalStateT . unpack
 
 -- | Runs a 'StateT' with the given initial state
 -- and returns the final state, discarding the final value.
 execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s
-execStateT t = Trans.execStateT . untagged t
+execStateT _ = Trans.execStateT . unpack
 
 -- | Runs a 'State' with the given initial state
 -- and returns both the final value and the final state.
 runState :: proxy tag -> State tag s a -> s -> (a, s)
-runState t = Trans.runState . untagged t
+runState _ = Trans.runState . unpack
 
 -- | Runs a 'State' with the given initial state
 -- and returns the final value, discarding the final state.
 evalState :: proxy tag -> State tag s a -> s -> a
-evalState t = Trans.evalState . untagged t
+evalState _ = Trans.evalState . unpack
 
 -- | Runs a 'State' with the given initial state
 -- and returns the final state, discarding the final value.
 execState :: proxy tag -> State tag s a -> s -> s
-execState t = Trans.execState . untagged t
+execState _ = Trans.execState . unpack
 
 -- | Fetch the current value of the state within the monad.
 get :: Monad m => proxy tag -> StateT tag s m s
-get t = tagged t Trans.get
+get _ = pack Trans.get
 
 -- | Set the value of the state within the monad.
 put :: Monad m => proxy tag -> s -> StateT tag s m ()
-put t = tagged t . Trans.put
-
--- Instances for mtl classes
-
-instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
-    callCC = Lift.liftCallCC' Class.callCC
-
-instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
-    ask = lift Class.ask
-    local = Lift.liftLocal Class.ask Class.local
-    reader = lift . Class.reader
-
-instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where
-    get = lift Class.get
-    put = lift . Class.put
-    state = lift . Class.state
-
-instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where
-    writer = lift . Class.writer
-    tell   = lift . Class.tell
-    listen = Lift.liftListen Class.listen
-    pass   = Lift.liftPass Class.pass
-
-instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where
-    throwError = lift . Class.throwError
-    catchError = Lift.liftCatch Class.catchError
+put _ = pack . Trans.put
diff --git a/src/Control/Monad/Trans/Ether/Tagged.hs b/src/Control/Monad/Trans/Ether/Tagged.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Trans/Ether/Tagged.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | This module defines the core data type of Ether, 'TaggedTrans',
+-- and a bunch of instances for it. 'TaggedTrans' attaches a tag to
+-- an existing monad transformer.
+
+module Control.Monad.Trans.Ether.Tagged where
+
+import Control.Applicative
+import Control.Monad (MonadPlus)
+import Control.Monad.Fix (MonadFix)
+import Control.Monad.Trans.Class (MonadTrans, lift)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Morph (MFunctor, MMonad)
+import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
+
+import qualified Control.Monad.Base as MB
+import qualified Control.Monad.Trans.Control as MC
+
+import qualified Control.Monad.Trans.Lift.StT    as Lift
+import qualified Control.Monad.Trans.Lift.Local  as Lift
+import qualified Control.Monad.Trans.Lift.Catch  as Lift
+import qualified Control.Monad.Trans.Lift.Listen as Lift
+import qualified Control.Monad.Trans.Lift.Pass   as Lift
+import qualified Control.Monad.Trans.Lift.CallCC as Lift
+
+import qualified Control.Monad.Cont.Class    as Class
+import qualified Control.Monad.Reader.Class  as Class
+import qualified Control.Monad.State.Class   as Class
+import qualified Control.Monad.Writer.Class  as Class
+import qualified Control.Monad.Error.Class   as Class
+
+import GHC.Generics (Generic)
+import Data.Coerce (coerce)
+
+import Control.Ether.Util (MonadApplicative)
+
+-- | Tagged monad transformer.
+newtype TaggedTrans tag trans (m :: * -> *) a = TaggedTrans (trans m a)
+  deriving
+    ( Generic
+    , Functor, Applicative, Alternative, Monad, MonadPlus
+    , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
+    , MonadThrow, MonadCatch, MonadMask )
+
+-- | Type-restricted 'coerce'.
+pack :: trans m a -> TaggedTrans tag trans m a
+pack = coerce
+
+-- | Type-restricted 'coerce'.
+unpack :: TaggedTrans tag trans m a -> trans m a
+unpack = coerce
+
+instance
+    ( MB.MonadBase b m
+    , MonadTrans trans
+    , MonadApplicative (trans m)
+    ) => MB.MonadBase b (TaggedTrans tag trans m)
+  where
+    liftBase = MB.liftBaseDefault
+
+instance
+    ( MC.MonadTransControl trans
+    ) => MC.MonadTransControl (TaggedTrans tag trans)
+  where
+    type StT (TaggedTrans tag trans) a = MC.StT trans a
+    liftWith = MC.defaultLiftWith pack unpack
+    restoreT = MC.defaultRestoreT pack
+
+instance
+    ( MC.MonadBaseControl b m
+    , MC.MonadTransControl trans
+    , MonadApplicative (trans m)
+    ) => MC.MonadBaseControl b (TaggedTrans tag trans m)
+  where
+    type StM (TaggedTrans tag trans m) a = MC.ComposeSt trans m a
+    liftBaseWith = MC.defaultLiftBaseWith
+    restoreM = MC.defaultRestoreM
+
+type instance Lift.StT (TaggedTrans tag trans) a = Lift.StT trans a
+
+instance Lift.LiftLocal trans => Lift.LiftLocal (TaggedTrans tag trans) where
+  liftLocal = Lift.defaultLiftLocal pack unpack
+
+instance Lift.LiftCatch trans => Lift.LiftCatch (TaggedTrans tag trans) where
+  liftCatch = Lift.defaultLiftCatch pack unpack
+
+instance Lift.LiftListen trans => Lift.LiftListen (TaggedTrans tag trans) where
+  liftListen = Lift.defaultLiftListen pack unpack
+
+instance Lift.LiftPass trans => Lift.LiftPass (TaggedTrans tag trans) where
+  liftPass = Lift.defaultLiftPass pack unpack
+
+instance Lift.LiftCallCC trans => Lift.LiftCallCC (TaggedTrans tag trans) where
+  liftCallCC  = Lift.defaultLiftCallCC  pack unpack
+  liftCallCC' = Lift.defaultLiftCallCC' pack unpack
+
+-- Instances for mtl classes
+
+instance
+    ( Class.MonadCont m
+    , Lift.LiftCallCC trans
+    , Monad (trans m)
+    ) => Class.MonadCont (TaggedTrans tag trans m)
+  where
+    callCC = Lift.liftCallCC' Class.callCC
+
+instance
+    ( Class.MonadReader r m
+    , Lift.LiftLocal trans
+    , Monad (trans m)
+    ) => Class.MonadReader r (TaggedTrans tag trans m)
+  where
+    ask = lift Class.ask
+    local = Lift.liftLocal Class.ask Class.local
+    reader = lift . Class.reader
+
+instance
+    ( Class.MonadState s m
+    , MonadTrans trans
+    , Monad (trans m)
+    ) => Class.MonadState s (TaggedTrans tag trans m)
+  where
+    get = lift Class.get
+    put = lift . Class.put
+    state = lift . Class.state
+
+instance
+    ( Class.MonadWriter w m
+    , Lift.LiftListen trans
+    , Lift.LiftPass trans
+    , Monad (trans m)
+    ) => Class.MonadWriter w (TaggedTrans tag trans m)
+  where
+    writer = lift . Class.writer
+    tell   = lift . Class.tell
+    listen = Lift.liftListen Class.listen
+    pass   = Lift.liftPass Class.pass
+
+instance
+    ( Class.MonadError e m
+    , Lift.LiftCatch trans
+    , Monad (trans m)
+    ) => Class.MonadError e (TaggedTrans tag trans m)
+  where
+    throwError = lift . Class.throwError
+    catchError = Lift.liftCatch Class.catchError
diff --git a/src/Control/Monad/Trans/Ether/Writer.hs b/src/Control/Monad/Trans/Ether/Writer.hs
--- a/src/Control/Monad/Trans/Ether/Writer.hs
+++ b/src/Control/Monad/Trans/Ether/Writer.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- | See "Control.Monad.Trans.Writer".
@@ -32,32 +33,8 @@
 #endif
 
 import Data.Functor.Identity (Identity(..))
-import Control.Applicative
-import Control.Monad (MonadPlus)
-import Control.Monad.Fix (MonadFix)
-import Control.Monad.Trans.Class (MonadTrans, lift)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Morph (MFunctor, MMonad)
-import Control.Ether.Tagged (Taggable(..), Tagged(..))
-import GHC.Generics (Generic)
-import qualified Control.Newtype as NT
-
-import qualified Control.Monad.Base as MB
-import qualified Control.Monad.Trans.Control as MC
 import qualified Control.Monad.Trans.Writer.Lazy as Trans
-
-import qualified Control.Monad.Trans.Lift.StT    as Lift
-import qualified Control.Monad.Trans.Lift.Local  as Lift
-import qualified Control.Monad.Trans.Lift.Catch  as Lift
-import qualified Control.Monad.Trans.Lift.Listen as Lift
-import qualified Control.Monad.Trans.Lift.Pass   as Lift
-import qualified Control.Monad.Trans.Lift.CallCC as Lift
-
-import qualified Control.Monad.Cont.Class    as Class
-import qualified Control.Monad.Reader.Class  as Class
-import qualified Control.Monad.State.Class   as Class
-import qualified Control.Monad.Writer.Class  as Class
-import qualified Control.Monad.Error.Class   as Class
+import Control.Monad.Trans.Ether.Tagged
 
 -- | The parametrizable writer monad.
 --
@@ -71,79 +48,36 @@
 --
 -- The 'return' function produces the output 'mempty', while '>>=' combines
 -- the outputs of the subcomputations using 'mappend'.
-newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)
-    deriving ( Generic
-             , Functor, Applicative, Alternative, Monad, MonadPlus
-             , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )
-
-instance NT.Newtype (WriterT tag w m a)
-
-instance (Monoid w, MB.MonadBase b m) => MB.MonadBase b (WriterT tag w m) where
-    liftBase = MB.liftBaseDefault
-
-instance Monoid w => MC.MonadTransControl (WriterT tag w) where
-    type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
-    liftWith = MC.defaultLiftWith NT.pack NT.unpack
-    restoreT = MC.defaultRestoreT NT.pack
-
-instance (Monoid w, MC.MonadBaseControl b m) => MC.MonadBaseControl b (WriterT tag w m) where
-    type StM (WriterT tag w m) a = MC.ComposeSt (WriterT tag w) m a
-    liftBaseWith = MC.defaultLiftBaseWith
-    restoreM = MC.defaultRestoreM
-
-type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a
-
-instance Monoid w => Lift.LiftLocal (WriterT tag w) where
-    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack
-
-instance Monoid w => Lift.LiftCatch (WriterT tag w) where
-    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack
-
-instance Monoid w => Lift.LiftListen (WriterT tag w) where
-    liftListen = Lift.defaultLiftListen NT.pack NT.unpack
-
-instance Monoid w' => Lift.LiftPass (WriterT tag w') where
-    liftPass = Lift.defaultLiftPass NT.pack NT.unpack
-
-instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
-    liftCallCC  = Lift.defaultLiftCallCC NT.pack NT.unpack
-    liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack
-
-instance Taggable (WriterT tag w m) where
-    type Tag (WriterT tag w m) = 'Just tag
-    type Inner (WriterT tag w m) = 'Just m
-
-instance Tagged (WriterT tag w m) tag where
-    type Untagged (WriterT tag w m) = Trans.WriterT w m
+type WriterT tag w = TaggedTrans tag (Trans.WriterT w)
 
 -- | Constructor for computations in the writer monad transformer.
 writerT :: proxy tag -> m (a, w) -> WriterT tag w m a
-writerT t = tagged t . Trans.WriterT
+writerT _ = pack . Trans.WriterT
 
 -- | Constructor for computations in the writer monad
 -- (the inverse of 'runWriter').
 writer :: Monad m => proxy tag -> (a, w) -> WriterT tag w m a
-writer t = tagged t . Trans.writer
+writer _ = pack . Trans.writer
 
 -- | Runs a 'WriterT' and returns both the normal value
 -- and the final accumulator.
 runWriterT :: proxy tag -> WriterT tag w m a -> m (a, w)
-runWriterT t = Trans.runWriterT . untagged t
+runWriterT _ = Trans.runWriterT . unpack
 
 -- | Runs a 'Writer' and returns both the normal value
 -- and the final accumulator.
 runWriter :: proxy tag -> Writer tag w a -> (a, w)
-runWriter t = Trans.runWriter . untagged t
+runWriter _ = Trans.runWriter . unpack
 
 -- | Runs a 'WriterT' and returns the final accumulator,
 -- discarding the normal value.
 execWriterT :: Monad m => proxy tag -> WriterT tag w m a -> m w
-execWriterT t = Trans.execWriterT . untagged t
+execWriterT _ = Trans.execWriterT . unpack
 
 -- | Runs a 'Writer' and returns the final accumulator,
 -- discarding the normal value.
 execWriter :: proxy tag -> Writer tag w a -> w
-execWriter t = Trans.execWriter . untagged t
+execWriter _ = Trans.execWriter . unpack
 
 -- | Appends a value to the accumulator within the monad.
 tell :: Monad m => proxy tag -> w -> WriterT tag w m ()
@@ -151,32 +85,9 @@
 
 -- | Executes an action and adds its accumulator to the value of the computation.
 listen :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m a -> WriterT tag w m (a, w)
-listen t m = tagged t $ Trans.listen (untagged t m)
+listen _ = pack . Trans.listen . unpack
 
 -- | Executes an action which returns a value and a function, and returns the
 -- value, applying the function to the accumulator.
 pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a
-pass t m = tagged t $ Trans.pass (untagged t m)
-
-instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
-    callCC = Lift.liftCallCC Class.callCC
-
-instance (Monoid w, Class.MonadReader r m) => Class.MonadReader r (WriterT tag w m) where
-    ask = lift Class.ask
-    local = Lift.liftLocal Class.ask Class.local
-    reader = lift . Class.reader
-
-instance (Monoid w, Class.MonadState s m) => Class.MonadState s (WriterT tag w m) where
-    get = lift Class.get
-    put = lift . Class.put
-    state = lift . Class.state
-
-instance (Monoid w, Class.MonadWriter w' m) => Class.MonadWriter w' (WriterT tag w m) where
-    writer = lift . Class.writer
-    tell   = lift . Class.tell
-    listen = Lift.liftListen Class.listen
-    pass   = Lift.liftPass Class.pass
-
-instance (Monoid w, Class.MonadError e m) => Class.MonadError e (WriterT tag w m) where
-    throwError = lift . Class.throwError
-    catchError = Lift.liftCatch Class.catchError
+pass _ = pack . Trans.pass . unpack
diff --git a/test/Regression.hs b/test/Regression.hs
--- a/test/Regression.hs
+++ b/test/Regression.hs
@@ -1,218 +1,29 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE LambdaCase #-}
 module Main where
 
-import Data.Monoid
-import Control.Monad
-import Control.Ether.Tagged
-import Control.Ether.TH
-import Control.Ether.Wrapped
-
-import Control.Monad.Ether
-import Control.Ether.Abbr
-
-import qualified Control.Monad.Ether.Implicit as I
-import qualified Control.Ether.Implicit.Abbr as I
-
-import qualified Control.Monad.Reader as T
-import qualified Control.Monad.Writer as T
-import qualified Control.Monad.State  as T
-
 import Test.Tasty
-import Test.Tasty.QuickCheck
-import Test.QuickCheck.Function
 
-ethereal "R1" "r1"
-ethereal "R2" "r2"
-ethereal "S1" "s1"
-ethereal "Foo" "foo"
-ethereal "Bar" "bar"
+import Regression.T1
+import Regression.T2
+import Regression.T3
+import Regression.T4
+import Regression.T5
+import Regression.T6
+import Regression.T7
+import Regression.T8
+import Regression.T9
 
 main :: IO ()
 main = defaultMain suite
 
 suite :: TestTree
 suite = testGroup "Ether"
-    [ testGroup "ReaderT"
-        [ testProperty "layered sum (local left)" layeredLocalLeft
-        , testProperty "layered sum (local right)" layeredLocalRight
-        ]
-    ]
-
-layeredLocalLeft, layeredLocalRight
-    :: Fun (Int, Integer) Integer
-    -> Fun Integer Integer
-    -> Int -> Integer -> Property
-
-layeredLocalLeft k f a1 a2 = property (direct == run indirect)
-  where
-    run = flip (runReader r1) a1 . flip (runReaderT r2) a2
-    (direct, indirect) = layeredLocalCore' k f a1 a2
-
-layeredLocalRight k f a1 a2 = property (direct == run indirect)
-  where
-    run = flip (runReader r2) a2 . flip (runReaderT r1) a1
-    (direct, indirect) = layeredLocalCore' k f a1 a2
-
-layeredLocalCore
-    :: Ether '[R1 --> r1, R2 --> r2] m
-    => (r2 -> r2) -> (r1 -> r2 -> a) -> m a
-layeredLocalCore f g = do
-    n <- ask r1
-    m <- local r2 f (ask r2)
-    return (g n m)
-
-layeredLocalCore'
-    :: Ether '[R1 --> Int, R2 --> Integer] m
-    => Fun (Int, Integer) Integer
-    -> Fun Integer Integer
-    -> Int -> Integer -> (Integer, m Integer)
-layeredLocalCore' k f a1 a2 = (direct, indirect)
-  where
-    direct = apply k (fromIntegral a1, apply f a2)
-    indirect = layeredLocalCore (apply f) (\n m -> apply k (fromIntegral n, m))
-
-implicitCore :: Ether '[I.R Int, I.R Bool] m => m String
-implicitCore = I.local (succ :: Int -> Int) $ do
-    n :: Int <- I.ask
-    b <- I.local not I.ask
-    return (if b then "" else show n)
-
-wrapCore :: (T.MonadReader Int m, T.MonadState Int m) => m Int
-wrapCore = do
-    b <- T.get
-    a <- T.ask
-    T.put (a + b)
-    return (a * b)
-
-wrapCore' :: Ether '[S1 --> Int, S1 <-> Int, R1 --> Int] m => m Int
-wrapCore' = do
-    a <- ethered s1 wrapCore
-    c <- ask r1
-    return (a + c)
-
-wrapCore'' :: Int -> (Int, Int)
-wrapCore'' a = runReader r1 (runStateT s1 (runReaderT s1 wrapCore' a) a) (-1)
-
--- Should not compile with `ensureUniqueTags`
-uniqueTagsCore :: IO ()
-uniqueTagsCore = flip (runReaderT r1) (1 :: Int)
-               . flip (runReaderT r1) (True :: Bool)
-               . flip (runReaderT r1) (2 :: Int)
-               . flip (runReaderT r1) (3 :: Integer)
-            {- . ensureUniqueTags -}
-               $ do
-                    a :: Integer <- ask r1
-                    b :: Int <- ask r1
-                    c :: Bool <- ask r1
-                    T.liftIO $ do
-                        print a
-                        print b
-                        print c
-
-stateCore :: (Ether '[S1 <-> Int, R1 --> Int] m, UniqueTags m) => m ()
-stateCore = ensureUniqueTags $ do
-    a <- ask r1
-    n <- get s1
-    put s1 (n * a)
-    modify s1 (subtract 1)
-
-recurseCore :: (Num a, Ord a) => Ether '[I.R a, I.S Int]m => m a
-recurseCore = do
-    a <- I.ask
-    if (a <= 0)
-        then do
-            I.put (0 :: Int)
-            return 1
-        else do
-            I.modify (succ :: Int -> Int)
-            b <- I.runReaderT recurseCore (a - 1)
-            I.modify (succ :: Int -> Int)
-            return (a * b)
-
-factorial :: (Num a, Ord a) => a -> (a, Int)
-factorial a = I.runState (I.runReaderT recurseCore a) (0 :: Int)
-
-factorial' :: Int -> (Int, Int)
-factorial' a = factorial (a :: Int)
-
-data DivideByZero = DivideByZero
-    deriving (Show)
-data NegativeLog a = NegativeLog a
-    deriving (Show)
-
-exceptCore
-    :: ( Floating a, Ord a
-       , Ether '[I.E DivideByZero, I.E (NegativeLog a)] m
-       ) => a -> a -> m a
-exceptCore a b = do
-    T.when (b == 0) (I.throw DivideByZero)
-    let d = a /b
-    T.when (d < 0) (I.throw (NegativeLog d))
-    return (log d)
-
-(&) :: a -> (a -> c) -> c
-(&) = flip ($)
-
-exceptCore' :: Double -> Double -> String
-exceptCore' a b = do
-    liftM show (exceptCore a b)
-    &I.handleT (\(NegativeLog (x::Double)) -> "nl: " ++ show x)
-    &I.handle  (\DivideByZero -> "dz")
-
-summatorCore
-    :: ( Num a
-       , T.MonadWriter (Sum a) m
-       , MonadWriter Foo (Sum a) m
-       ) => [a] -> m ()
-summatorCore xs = do
-    forM_ xs $ \x -> do
-        T.tell (Sum x)
-        tell foo (Sum 1)
-
-summatorCore' :: Num a => [a] -> (Sum a, Sum a)
-summatorCore' = runWriter foo . T.execWriterT . summatorCore
-
-wrapState_f :: T.MonadState Int m => m String
-wrapState_f = liftM show T.get
-
-wrapState_g :: T.MonadState Bool m => m String
-wrapState_g = liftM show T.get
-
-wrapState_useboth :: Ether '[Foo <-> Int, Bar <-> Bool] m => m String
-wrapState_useboth = do
-    a <- ethered foo wrapState_f
-    b <- ethered bar wrapState_g
-    return (a ++ b)
-
-wrapStateCore :: Int -> Bool -> String
-wrapStateCore int bool = evalState foo (evalStateT bar wrapState_useboth bool) int
-
-wrapStateBad1_g :: MonadState Foo Int m => m ()
-wrapStateBad1_g = modify foo (*100)
-
-wrapStateBad1_useboth :: MonadState Foo Int m => m String
-wrapStateBad1_useboth = do
-    wrapStateBad1_g
-    ethered foo wrapState_f
-
-wrapStateBad1 :: Int -> String
-wrapStateBad1 = evalState foo wrapStateBad1_useboth
-
-wrapStateBad2 :: (T.MonadState Int m , MonadState Foo Int m) => m Int
-wrapStateBad2 = do
-    modify foo (*100)
-    T.get
-
-wrapStateBad2Core :: Int -> Int
-wrapStateBad2Core = evalState foo (ensureUniqueTags $ ethered foo wrapStateBad2)
-
-wrapReaderCore :: Int -> Int
-wrapReaderCore = runReader foo (ethered foo (liftM2 (+) T.ask (ask foo)))
+  [ test1
+  , test2
+  , test3
+  , test4
+  , test5
+  , test6
+  , test7
+  , test8
+  , test9
+  ]
diff --git a/test/Regression/T1.hs b/test/Regression/T1.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T1.hs
@@ -0,0 +1,39 @@
+module Regression.T1 (test1) where
+
+import Control.Monad.Ether
+import Control.Ether.Abbr
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+ethereal "Tag1" "tag1"
+ethereal "Tag2" "tag2"
+
+testEther
+  :: Ether '[Tag1 --> String, Tag2 --> String] m
+  => m ((String, String), (String, String))
+testEther = do
+  s1 <- ask tag1
+  s2 <- ask tag2
+  let s1s2 = (s1, s2)
+  s1s2' <- local tag2 (map succ) $ do
+    s1' <- ask tag1
+    s2' <- ask tag2
+    return (s1', s2')
+  return (s1s2, s1s2')
+
+runner1 s1 s2 = flip (runReader tag1) s1 . flip (runReaderT tag2) s2
+runner2 s1 s2 = flip (runReader tag2) s2 . flip (runReaderT tag1) s1
+
+test1 :: TestTree
+test1 = testGroup "T1: Reader local environment"
+  [ testProperty "runner₁ works"
+      $ \s1 s2 -> property
+      $ runner1 s1 s2 testEther == ((s1, s2), (s1, map succ s2))
+  , testProperty "runner₂ works"
+      $ \s1 s2 -> property
+      $ runner2 s1 s2 testEther == ((s1, s2), (s1, map succ s2))
+  , testProperty "runner₁ == runner₂"
+      $ \s1 s2 -> property
+      $ runner1 s1 s2 testEther == runner2 s1 s2 testEther
+  ]
diff --git a/test/Regression/T2.hs b/test/Regression/T2.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T2.hs
@@ -0,0 +1,30 @@
+module Regression.T2 (test2) where
+
+import Control.Ether.Abbr
+import qualified Control.Monad.Ether.Implicit as I
+import qualified Control.Ether.Implicit.Abbr as I
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+testEther :: Ether '[I.R Integer, I.R Bool] m => m String
+testEther = I.local (succ :: Integer -> Integer) $ do
+  n :: Integer <- I.ask
+  b <- I.local not I.ask
+  return (if b then "" else show n)
+
+runner1 (n :: Integer) = flip I.runReader n . flip I.runReaderT True
+runner2 (n :: Integer) = flip I.runReader True . flip I.runReaderT n
+
+test2 :: TestTree
+test2 = testGroup "T2: Implicit tags"
+  [ testProperty "runner₁ works"
+    $ \n -> property
+    $ runner1 n testEther == show (succ n)
+  , testProperty "runner₂ works"
+    $ \n -> property
+    $ runner2 n testEther == show (succ n)
+  , testProperty "runner₁ == runner₂"
+    $ \n -> property
+    $ runner1 n testEther == runner2 n testEther
+  ]
diff --git a/test/Regression/T3.hs b/test/Regression/T3.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T3.hs
@@ -0,0 +1,56 @@
+module Regression.T3 (test3) where
+
+import Control.Ether.Abbr
+import Control.Monad.Ether
+
+import qualified Control.Monad.Reader as T
+import qualified Control.Monad.State as T
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+ethereal "RTag" "rTag"
+ethereal "STag" "sTag"
+
+testMTL :: (T.MonadReader Int m, T.MonadState Int m) => m Int
+testMTL = do
+  b <- T.get
+  a <- T.ask
+  T.put (a + b)
+  return (a * b)
+
+testEther
+  :: Ether '[STag --> Int, STag <-> Int, RTag --> Int] m
+  => m (Int, Int, Int)
+testEther = local rTag (*2) $ do
+  a_mul_b <- tagAttach sTag testMTL
+  a_add_b <- get sTag
+  modify sTag negate
+  c <- ask rTag
+  return (a_mul_b, a_add_b, c)
+
+runner1 s r
+  = flip (runReader  rTag) (negate r)
+  . flip (runReaderT sTag) r
+  . flip (runStateT  sTag) s
+runner2 s r
+  = flip (runReader  rTag) (negate r)
+  . flip (runStateT  sTag) s
+  . flip (runReaderT sTag) r
+
+test3 :: TestTree
+test3 = testGroup "T3: Tag attachement"
+  [ testProperty "runner₁ works"
+    $ \s r -> property
+    $ (==)
+        (runner1 s r testEther)
+        ((s * r, s + r, negate r * 2), negate (s + r))
+  , testProperty "runner₂ works"
+    $ \s r -> property
+    $ (==)
+        (runner2 s r testEther)
+        ((s * r, s + r, negate r * 2), negate (s + r))
+  , testProperty "runner₁ == runner₂"
+    $ \s r -> property
+    $ runner1 s r testEther == runner2 s r testEther
+  ]
diff --git a/test/Regression/T4.hs b/test/Regression/T4.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T4.hs
@@ -0,0 +1,25 @@
+module Regression.T4 (test4) where
+
+import Control.Ether.Abbr
+import Control.Monad.Ether
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+ethereal "RTag" "rTag"
+
+testEther :: Ether '[RTag --> Int] m => m Int
+testEther = ask rTag
+
+runner r
+  = flip (runReader  rTag) (r' :: Int)
+  . flip (runReaderT rTag) (r  :: Int)
+  where
+    r' = negate r
+
+test4 :: TestTree
+test4 = testGroup "T4: Nested same-tag readers"
+  [ testProperty "runner works"
+    $ \r -> property
+    $ runner r testEther == r
+  ]
diff --git a/test/Regression/T5.hs b/test/Regression/T5.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T5.hs
@@ -0,0 +1,45 @@
+module Regression.T5 (test5) where
+
+import Control.Ether.Abbr
+
+import qualified Control.Monad.Ether.Implicit as I
+import qualified Control.Ether.Implicit.Abbr as I
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+newtype Counter = Counter Int
+  deriving (Eq, Ord, Num, Enum)
+
+incCounter :: Counter -> Counter
+incCounter = succ
+
+testEther
+  :: (Num a, Ord a)
+  => Ether '[I.R a, I.S Counter] m
+  => m a
+testEther = do
+  a <- I.ask
+  if a <= 0
+    then do
+      I.put (0 :: Counter)
+      return 1
+    else do
+      I.modify incCounter -- overriden in the base case
+      b <- I.runReaderT testEther (a - 1)
+      I.modify incCounter
+      return (a * b)
+
+runner :: (Num a, Ord a) => a -> (a, Counter)
+runner a = I.runState (I.runReaderT testEther a) (0 :: Counter)
+
+factorial :: (Num a, Enum a) => a -> a
+factorial a = product [1..a]
+
+test5 :: TestTree
+test5 = testGroup "T5: Factorial via Ether"
+  [ testProperty "runner works"
+    $ \n -> property
+    $ let n' = fromIntegral n :: Integer
+      in runner n' == (factorial n', max 0 (Counter n))
+  ]
diff --git a/test/Regression/T6.hs b/test/Regression/T6.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T6.hs
@@ -0,0 +1,66 @@
+module Regression.T6 (test6) where
+
+import Control.Monad
+import Control.Ether.Abbr
+
+import qualified Control.Monad.Ether.Implicit as I
+import qualified Control.Ether.Implicit.Abbr as I
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+data DivideByZero = DivideByZero
+    deriving (Show)
+
+data NegativeLog a = NegativeLog a
+    deriving (Show)
+
+testEther
+  :: (Floating a, Ord a)
+  => Ether '[I.E DivideByZero, I.E (NegativeLog a)] m
+  => a -> a -> m a
+testEther a b = do
+  when (b == 0) (I.throw DivideByZero)
+  let d = a / b
+  when (d < 0) (I.throw (NegativeLog d))
+  return (log d)
+
+-- Copied verbatim from "Data.Function" to support @base < 4.8@.
+(&) :: a -> (a -> b) -> b
+x & f = f x
+
+handleNegativeLog (NegativeLog (x :: Double)) = "nl: " ++ show x
+handleDivideByZero DivideByZero = "dz"
+
+runner1 :: Double -> Double -> String
+runner1 a b = do
+  (show `fmap` testEther a b)
+    & I.handleT handleNegativeLog
+    & I.handle  handleDivideByZero
+
+runner2 :: Double -> Double -> String
+runner2 a b = do
+  (show `fmap` testEther a b)
+    & I.handleT handleDivideByZero
+    & I.handle  handleNegativeLog
+
+logDiv :: Double -> Double -> String
+logDiv a b
+  | b == 0    = "dz"
+  | d  < 0    = "nl: " ++ show d
+  | otherwise = show (log d)
+  where
+    d = a / b
+
+test6 :: TestTree
+test6 = testGroup "T6: Checked exceptions"
+  [ testProperty "runner₁ works"
+    $ \a b -> property
+    $ runner1 a b == logDiv a b
+  , testProperty "runner₂ works"
+    $ \a b -> property
+    $ runner2 a b == logDiv a b
+  , testProperty "runner₁ == runner₂"
+    $ \a b -> property
+    $ runner1 a b == runner2 a b
+  ]
diff --git a/test/Regression/T7.hs b/test/Regression/T7.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T7.hs
@@ -0,0 +1,50 @@
+module Regression.T7 (test7) where
+
+import Data.Monoid
+import Control.Monad
+
+import Control.Monad.Ether
+import qualified Control.Monad.Writer as T
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+ethereal "WTag" "wTag"
+
+testEther
+  :: Num a
+  => T.MonadWriter (Sum a) m
+  => MonadWriter WTag (Sum a) m
+  => [a] -> m ()
+testEther xs = do
+  forM_ xs $ \x -> do
+    T.tell (Sum x)
+    tell wTag (Sum 1)
+
+runner1 :: Num a => [a] -> (a, a)
+runner1 xs =
+  let (s, c) = T.runWriter . execWriterT wTag $ testEther xs
+  in (getSum s, getSum c)
+
+runner2 :: Num a => [a] -> (a, a)
+runner2 xs =
+  let (c, s) = runWriter wTag . T.execWriterT $ testEther xs
+  in (getSum s, getSum c)
+
+triangular :: Integral a => a -> a
+triangular n = div (n * (n + 1)) 2
+
+test7 :: TestTree
+test7 = testGroup "T7: Triangular via Ether"
+  [ testProperty "runner₁ works"
+    $ \n -> property
+    $ let n' = abs n :: Integer
+      in runner1 [1..n'] == (n', triangular n')
+  , testProperty "runner₂ works"
+    $ \n -> property
+    $ let n' = abs n :: Integer
+      in runner2 [1..n'] == (n', triangular n')
+  , testProperty "runner₁ == runner₂"
+    $ \(ns :: [Integer]) -> property
+    $ runner1 ns == runner2 ns
+  ]
diff --git a/test/Regression/T8.hs b/test/Regression/T8.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T8.hs
@@ -0,0 +1,52 @@
+module Regression.T8 (test8) where
+
+import Control.Ether.Abbr
+import Control.Monad.Ether
+
+import qualified Control.Monad.State as T
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+ethereal "Foo" "foo"
+ethereal "Bar" "bar"
+
+testMTL1 :: T.MonadState Int m => m ()
+testMTL1 = T.modify negate
+
+testMTL2 :: T.MonadState Bool m => m ()
+testMTL2 = T.modify not
+
+testEther
+  :: Ether '[Foo <-> Int, Bar <-> Bool] m
+  => m String
+testEther = do
+  tagAttach foo testMTL1
+  tagAttach bar testMTL2
+  a <- gets foo show
+  b <- gets bar show
+  return (a ++ b)
+
+model :: Int -> Bool -> String
+model a b = show (negate a) ++ show (not b)
+
+runner1 a b
+  = flip (evalState  foo) a
+  . flip (evalStateT bar) b
+
+runner2 a b
+  = flip (evalState  bar) b
+  . flip (evalStateT foo) a
+
+test8 :: TestTree
+test8 = testGroup "T8: Multiple tag attachements"
+  [ testProperty "runner₁ works"
+    $ \a b -> property
+    $ runner1 a b testEther == model a b
+  , testProperty "runner₂ works"
+    $ \a b -> property
+    $ runner2 a b testEther == model a b
+  , testProperty "runner₁ == runner₂"
+    $ \a b -> property
+    $ runner1 a b testEther == runner2 a b testEther
+  ]
diff --git a/test/Regression/T9.hs b/test/Regression/T9.hs
new file mode 100644
--- /dev/null
+++ b/test/Regression/T9.hs
@@ -0,0 +1,51 @@
+module Regression.T9 (test9) where
+
+import Control.Ether.Abbr
+import Control.Monad.Ether
+
+import Test.Tasty
+import Test.Tasty.QuickCheck
+
+ethereal "Foo" "foo"
+ethereal "Bar" "bar"
+
+
+testEther1 :: Ether '[Foo <-> Int] m => m String
+testEther1 = do
+  modify foo negate
+  gets foo show
+
+testEther2 :: Ether '[Bar <-> Int] m => m String
+testEther2 = tagReplace foo bar testEther1
+
+testEther
+  :: Ether '[Foo <-> Int, Bar <-> Int] m
+  => m String
+testEther = do
+  a <- testEther1
+  b <- testEther2
+  return (a ++ b)
+
+model :: Int -> Int -> String
+model a b = show (negate a) ++ show (negate b)
+
+runner1 a b
+  = flip (evalState  foo) a
+  . flip (evalStateT bar) b
+
+runner2 a b
+  = flip (evalState  bar) b
+  . flip (evalStateT foo) a
+
+test9 :: TestTree
+test9 = testGroup "T9: Tag replacement"
+  [ testProperty "runner₁ works"
+    $ \a b -> property
+    $ runner1 a b testEther == model a b
+  , testProperty "runner₂ works"
+    $ \a b -> property
+    $ runner2 a b testEther == model a b
+  , testProperty "runner₁ == runner₂"
+    $ \a b -> property
+    $ runner1 a b testEther == runner2 a b testEther
+  ]