diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,14 +1,17 @@
 # Intro
 
-Classes for accessing and mutating nested data types with corresponding adapter classes for `MonadState` and `MonadError`.
-Inspired by the [next level mtl with classy optics] talk.
+Classes for accessing and mutating nested data types with corresponding adapter
+classes for `MonadState`, `MonadReader` and `MonadError`. Inspired by the
+[next level mtl with classy optics] talk.
 
 [Hackage]
 
 # Internals
 
-Lenses and Prisms from [lens] are autogenerated with [TH] by splicing with `deepPrisms` and `deepLenses`.
-The generator recurses into single-field constructors and record fields if there are instances of `DeepPrisms` or `DeepLenses` for their parameter types.
+Lenses and Prisms from [lens] are autogenerated with [TH] by splicing with
+`deepPrisms` and `deepLenses`.
+The generator recurses into single-field constructors and record fields if
+there are instances of `DeepPrisms` or `DeepLenses` for their parameter types.
 
 # Example
 
@@ -17,7 +20,7 @@
 ```haskell
 {-# LANGUAGE TemplateHaskell #-}
 
-import Control.Monad.DeepError (MonadDeepError(throwHoist))
+import Cornea (MonadDeepError(throwHoist))
 import Control.Monad.Trans.Except (runExceptT)
 import Data.DeepPrisms (deepPrisms)
 
@@ -46,7 +49,7 @@
 ```haskell
 {-# LANGUAGE TemplateHaskell #-}
 
-import Control.Monad.DeepState (MonadDeepState(get, gets, put))
+import Cornea (MonadDeepState(get, gets, put))
 import Control.Monad.Trans.State (execStateT)
 import Data.DeepLenses (deepLenses)
 
@@ -71,6 +74,8 @@
 main = do
   execStateT stateDeep (Outer (Mid (Inner (S 5))))
 ```
+
+`MonadReader` works basically the same as `MonadState`.
 
 [lens]: https://hackage.haskell.org/package/lens
 [TH]: https://hackage.haskell.org/package/template-haskell
diff --git a/cornea.cabal b/cornea.cabal
--- a/cornea.cabal
+++ b/cornea.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 name: cornea
-version: 0.2.2.0
+version: 0.3.0.0
 license: OtherLicense
 license-file: LICENSE
 copyright: 2019 Torsten Schmits
@@ -23,31 +23,39 @@
 library
     exposed-modules:
         Control.Monad.DeepError
+        Control.Monad.DeepReader
         Control.Monad.DeepState
+        Cornea
         Data.DeepLenses
         Data.DeepPrisms
     hs-source-dirs: lib
     other-modules:
-        Paths_cornea
+        Prelude
     default-language: Haskell2010
-    default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals
-                        ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable
-                        DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable
-                        DoAndIfThenElse EmptyDataDecls ExistentialQuantification
-                        FlexibleContexts FlexibleInstances FunctionalDependencies GADTs
-                        GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase
-                        MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns
-                        OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds
-                        RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving
-                        TupleSections TypeApplications TypeFamilies TypeSynonymInstances
-                        UnicodeSyntax ViewPatterns
+    default-extensions: AllowAmbiguousTypes AutoDeriveTypeable
+                        BangPatterns BinaryLiterals ConstraintKinds DataKinds
+                        DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor
+                        DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls
+                        ExistentialQuantification FlexibleContexts FlexibleInstances
+                        FunctionalDependencies GADTs GeneralizedNewtypeDeriving
+                        InstanceSigs KindSignatures LambdaCase MonadFailDesugaring
+                        MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings
+                        PartialTypeSignatures PatternGuards PolyKinds RankNTypes
+                        RecordWildCards ScopedTypeVariables StandaloneDeriving
+                        TemplateHaskell TupleSections TypeApplications TypeFamilies
+                        TypeSynonymInstances UndecidableInstances UnicodeSyntax
+                        ViewPatterns
     build-depends:
-        base >=4.7 && <5,
-        lens >=4.16.1 && <4.17,
+        base-noprelude >=4.7 && <5,
+        either >=5.0.1.1 && <5.1,
+        lens >=4.17.1 && <4.18,
+        lifted-base >=0.2.3.12 && <0.3,
+        monad-control >=1.0.2.3 && <1.1,
         mtl >=2.2.2 && <2.3,
-        template-haskell >=2.13.0.0 && <2.14,
-        th-abstraction >=0.2.10.0 && <0.3,
-        transformers >=0.5.5.0 && <0.6
+        relude >=0.4.0 && <0.5,
+        template-haskell >=2.14.0.0 && <2.15,
+        th-abstraction >=0.2.11.0 && <0.3,
+        transformers >=0.5.6.2 && <0.6
 
 test-suite cornea-unit
     type: exitcode-stdio-1.0
@@ -55,27 +63,35 @@
     hs-source-dirs: test/u
     other-modules:
         DeepErrorSpec
+        DeepReaderSpec
         DeepStateSpec
+        Prelude
         Paths_cornea
     default-language: Haskell2010
-    default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals
-                        ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable
-                        DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable
-                        DoAndIfThenElse EmptyDataDecls ExistentialQuantification
-                        FlexibleContexts FlexibleInstances FunctionalDependencies GADTs
-                        GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase
-                        MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns
-                        OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds
-                        RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving
-                        TupleSections TypeApplications TypeFamilies TypeSynonymInstances
-                        UnicodeSyntax ViewPatterns
+    default-extensions: AllowAmbiguousTypes AutoDeriveTypeable
+                        BangPatterns BinaryLiterals ConstraintKinds DataKinds
+                        DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor
+                        DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls
+                        ExistentialQuantification FlexibleContexts FlexibleInstances
+                        FunctionalDependencies GADTs GeneralizedNewtypeDeriving
+                        InstanceSigs KindSignatures LambdaCase MonadFailDesugaring
+                        MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings
+                        PartialTypeSignatures PatternGuards PolyKinds RankNTypes
+                        RecordWildCards ScopedTypeVariables StandaloneDeriving
+                        TemplateHaskell TupleSections TypeApplications TypeFamilies
+                        TypeSynonymInstances UndecidableInstances UnicodeSyntax
+                        ViewPatterns
     ghc-options: -threaded -rtsopts -with-rtsopts=-N
     build-depends:
         HTF >=0.13.2.5 && <0.14,
-        base >=4.7 && <5,
+        base-noprelude >=4.7 && <5,
         cornea -any,
-        lens >=4.16.1 && <4.17,
+        either >=5.0.1.1 && <5.1,
+        lens >=4.17.1 && <4.18,
+        lifted-base >=0.2.3.12 && <0.3,
+        monad-control >=1.0.2.3 && <1.1,
         mtl >=2.2.2 && <2.3,
-        template-haskell >=2.13.0.0 && <2.14,
-        th-abstraction >=0.2.10.0 && <0.3,
-        transformers >=0.5.5.0 && <0.6
+        relude >=0.4.0 && <0.5,
+        template-haskell >=2.14.0.0 && <2.15,
+        th-abstraction >=0.2.11.0 && <0.3,
+        transformers >=0.5.6.2 && <0.6
diff --git a/lib/Control/Monad/DeepError.hs b/lib/Control/Monad/DeepError.hs
--- a/lib/Control/Monad/DeepError.hs
+++ b/lib/Control/Monad/DeepError.hs
@@ -1,8 +1,12 @@
 module Control.Monad.DeepError where
 
+import Control.Exception (Exception, IOException, SomeException)
+import Control.Exception.Lifted (try)
 import Control.Monad.Error.Class (MonadError(throwError, catchError))
+import Control.Monad.Trans.Control (MonadBaseControl)
 
 import Data.DeepPrisms (DeepPrisms, hoist, retrieve)
+import Data.Either.Combinators (mapLeft)
 
 class (MonadError e m, DeepPrisms e e') => MonadDeepError e e' m where
   throwHoist :: e' -> m a
@@ -11,18 +15,120 @@
   throwHoist =
     throwError . hoist
 
-catchAt :: (MonadError e m, DeepPrisms e e') => (e' -> m a) -> m a -> m a
+catchAt ::
+  ∀ e' e m a .
+  MonadDeepError e e' m =>
+  (e' -> m a) ->
+  m a ->
+  m a
 catchAt handle ma =
   catchError ma f
   where
     f e = maybe (throwError e) handle (retrieve e)
 
-hoistEither :: MonadDeepError e e' m => Either e' a -> m a
+catchAs ::
+  ∀ e' e m a .
+  MonadDeepError e e' m =>
+  a ->
+  m a ->
+  m a
+catchAs =
+  catchAt @e' . const . return
+
+ignoreError ::
+  ∀ e' e m .
+  MonadDeepError e e' m =>
+  m () ->
+  m ()
+ignoreError =
+  catchAs @e' ()
+
+hoistEither ::
+  MonadDeepError e e' m =>
+  Either e' a ->
+  m a
 hoistEither =
   either throwHoist return
 
-hoistMaybe :: MonadDeepError e e' m => e' -> Maybe a -> m a
+hoistEitherWith ::
+  MonadDeepError e e'' m =>
+  (e' -> e'') ->
+  Either e' a ->
+  m a
+hoistEitherWith f =
+  hoistEither . mapLeft f
+
+hoistEitherAs ::
+  MonadDeepError e e'' m =>
+  e'' ->
+  Either e' a ->
+  m a
+hoistEitherAs =
+  hoistEitherWith . const
+
+hoistMaybe ::
+  MonadDeepError e e' m =>
+  e' ->
+  Maybe a ->
+  m a
 hoistMaybe e' =
   maybe (throwHoist e') return
+
+tryHoist ::
+  MonadBaseControl IO m =>
+  MonadDeepError e e' m =>
+  Exception ex =>
+  (ex -> e') ->
+  m a ->
+  m a
+tryHoist f =
+  hoistEitherWith f <=< try
+
+tryHoistAs ::
+  ∀ ex e e' m a .
+  MonadBaseControl IO m =>
+  MonadDeepError e e' m =>
+  Exception ex =>
+  e' ->
+  m a ->
+  m a
+tryHoistAs e =
+  hoistEitherAs e <=< try @m @ex
+
+tryHoistIO ::
+  MonadBaseControl IO m =>
+  MonadDeepError e e' m =>
+  (IOException -> e') ->
+  m a ->
+  m a
+tryHoistIO =
+  tryHoist
+
+tryHoistIOAs ::
+  MonadBaseControl IO m =>
+  MonadDeepError e e' m =>
+  e' ->
+  m a ->
+  m a
+tryHoistIOAs =
+  tryHoistAs @IOException
+
+tryHoistAny ::
+  MonadBaseControl IO m =>
+  MonadDeepError e e' m =>
+  (SomeException -> e') ->
+  m a ->
+  m a
+tryHoistAny =
+  tryHoist
+
+tryHoistAnyAs ::
+  MonadBaseControl IO m =>
+  MonadDeepError e e' m =>
+  e' ->
+  m a ->
+  m a
+tryHoistAnyAs =
+  tryHoistAs @SomeException
 
 -- TODO derive multiple errors with HList + Generic
diff --git a/lib/Control/Monad/DeepReader.hs b/lib/Control/Monad/DeepReader.hs
new file mode 100644
--- /dev/null
+++ b/lib/Control/Monad/DeepReader.hs
@@ -0,0 +1,21 @@
+module Control.Monad.DeepReader where
+
+import Control.Lens (over)
+import qualified Control.Lens as Lens (view)
+import qualified Control.Monad.Reader.Class as MR (MonadReader(ask))
+import Control.Monad.Trans.Reader (ReaderT)
+
+import Data.DeepLenses (DeepLenses(deepLens))
+
+class Monad m => MonadDeepReader (r :: *) (r' :: *) (m :: * -> *) | m -> r where
+  ask :: m r'
+  local :: (r' -> r') -> m a -> m a
+  asks :: (r' -> a) -> m a
+
+instance (Monad m, DeepLenses r r') => MonadDeepReader r r' (ReaderT r m) where
+  ask =
+    Lens.view deepLens <$> MR.ask
+  local f m =
+    ReaderT $ runReaderT m . over deepLens f
+  asks =
+    (<$> ask)
diff --git a/lib/Control/Monad/DeepState.hs b/lib/Control/Monad/DeepState.hs
--- a/lib/Control/Monad/DeepState.hs
+++ b/lib/Control/Monad/DeepState.hs
@@ -1,36 +1,110 @@
 module Control.Monad.DeepState where
 
-import qualified Control.Lens as Lens (set, view)
-import Control.Monad.State.Class (MonadState)
+import Control.Lens (Lens')
+import qualified Control.Lens as Lens (mapMOf, over, set, view, views)
 import qualified Control.Monad.State.Class as MS (MonadState(get), modify)
+import Control.Monad.Trans.Class (MonadTrans(lift))
+import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT)
+import Control.Monad.Trans.State.Strict (StateT)
+import Data.Functor (void)
 
 import Data.DeepLenses (DeepLenses(deepLens))
 
-class (MonadState s m, DeepLenses s s') => MonadDeepState s s' m where
+class Monad m => MonadDeepState (s :: *) (s' :: *) (m :: * -> *) | m -> s where
   get :: m s'
   put :: s' -> m ()
   stateM :: (s' -> m (a, s')) -> m a
+  stateM f = do
+    ~(a, s'') <- f =<< get
+    a <$ put s''
+  state :: (s' -> (a, s')) -> m a
+  state f =
+    stateM (pure . f)
+  modifyM' :: (s' -> m s') -> m s'
+  modifyM' f = do
+    s' <- f =<< get
+    s' <$ put s'
+  modify :: (s' -> s') -> m ()
+  modify f =
+    modifyM (pure . f)
 
-instance (MonadState s m, DeepLenses s s') => MonadDeepState s s' m where
+instance {-# OVERLAPPING #-} (Monad m, DeepLenses s s') => MonadDeepState s s' (Lazy.StateT s m) where
   get = Lens.view deepLens <$> MS.get
   put = MS.modify . Lens.set deepLens
-  stateM f = do
-    s' <- get
-    ~(a, s'') <- f s'
-    put s''
-    return a
 
-state :: MonadDeepState s s' m => (s' -> (a, s')) -> m a
-state f = stateM (pure . f)
+instance {-# OVERLAPPING #-} (Monad m, DeepLenses s s') => MonadDeepState s s' (StateT s m) where
+  get = Lens.view deepLens <$> MS.get
+  put = MS.modify . Lens.set deepLens
 
-gets :: MonadDeepState s s' m => (s' -> a) -> m a
+instance {-# OVERLAPPABLE #-} (Monad (t m), MonadTrans t, MonadDeepState s s' m) => MonadDeepState s s' (t m) where
+  get = lift get
+  put = lift . put
+  state = lift . state
+
+gets ::
+  ∀ s' s m a .
+  MonadDeepState s s' m =>
+  (s' -> a) ->
+  m a
 gets =
   (<$> get)
 
-modifyM :: MonadDeepState s s' m => (s' -> m s') -> m ()
-modifyM f =
-  stateM (fmap ((),) . f)
+modifyM ::
+  MonadDeepState s s' m =>
+  (s' -> m s') ->
+  m ()
+modifyM =
+  void . modifyM'
 
-modify :: MonadDeepState s s' m => (s' -> s') -> m ()
-modify f =
-  modifyM (pure . f)
+modifyL ::
+  ∀ s' s a m.
+  MonadDeepState s s' m =>
+  Lens' s' a ->
+  (a -> a) ->
+  m ()
+modifyL lens f =
+  modify $ Lens.over lens f
+
+modifyML' ::
+  ∀ s' s a m.
+  MonadDeepState s s' m =>
+  Lens' s' a ->
+  (a -> m a) ->
+  m a
+modifyML' lens f =
+  Lens.view lens <$> modifyM' (Lens.mapMOf lens f)
+
+modifyML ::
+  ∀ s' s a m.
+  MonadDeepState s s' m =>
+  Lens' s' a ->
+  (a -> m a) ->
+  m ()
+modifyML lens f =
+  modifyM $ Lens.mapMOf lens f
+
+getL ::
+  ∀ s' s m a.
+  MonadDeepState s s' m =>
+  Lens' s' a ->
+  m a
+getL =
+  gets . Lens.view
+
+getsL ::
+  ∀ s' s m a b.
+  MonadDeepState s s' m =>
+  Lens' s' a ->
+  (a -> b) ->
+  m b
+getsL lens =
+  gets . Lens.views lens
+
+setL ::
+  ∀ s' s m a.
+  MonadDeepState s s' m =>
+  Lens' s' a ->
+  a ->
+  m ()
+setL lens =
+  modify . Lens.set lens
diff --git a/lib/Cornea.hs b/lib/Cornea.hs
new file mode 100644
--- /dev/null
+++ b/lib/Cornea.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Cornea (
+  module Control.Monad.DeepError,
+  module Control.Monad.DeepState,
+  module Data.DeepLenses,
+  module Data.DeepPrisms,
+  modify,
+) where
+
+import Control.Monad.DeepError
+import qualified Control.Monad.DeepState as DeepState (modify)
+import Control.Monad.DeepState hiding (modify)
+import Data.DeepLenses (deepLenses)
+import Data.DeepPrisms (deepPrisms)
+
+modify ::
+  ∀ s' s m .
+  MonadDeepState s s' m =>
+  (s' -> s') ->
+  m ()
+modify =
+  DeepState.modify
diff --git a/lib/Data/DeepLenses.hs b/lib/Data/DeepLenses.hs
--- a/lib/Data/DeepLenses.hs
+++ b/lib/Data/DeepLenses.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module Data.DeepLenses where
 
 import Control.Lens (Lens', makeClassy)
@@ -14,8 +12,8 @@
   )
 import Language.Haskell.TH.Syntax (ModName(..), Name(Name), NameFlavour(NameQ, NameS, NameG), OccName(..))
 
-class DeepLenses e e' where
-  deepLens :: Lens' e e'
+class DeepLenses s s' where
+  deepLens :: Lens' s s'
 
 data Field =
   Field {
@@ -47,8 +45,8 @@
   funD name [clause [] body []]
 
 deepLensesInstance :: TypeQ -> TypeQ -> BodyQ -> DecQ
-deepLensesInstance top local body =
-  instanceD (cxt []) (appT (appT [t|DeepLenses|] top) local) [mkHoist top local body]
+deepLensesInstance top local' body =
+  instanceD (cxt []) (appT (appT [t|DeepLenses|] top) local') [mkHoist top local' body]
 
 idLenses :: Name -> DecQ
 idLenses name =
@@ -78,11 +76,11 @@
 
 lensName :: Name -> Name -> ExpQ
 lensName (Name _ topFlavour) (Name (OccName n) lensFlavour) =
-  varE (Name (OccName (lensName' n)) flavour)
+  varE (Name (OccName (lensNams' n)) flavour)
   where
-    lensName' ('_' : t) = t
-    lensName' [] = []
-    lensName' a = a
+    lensNams' ('_' : t) = t
+    lensNams' [] = []
+    lensNams' a = a
     flavour
       | sameModule topFlavour lensFlavour = NameS
       | otherwise = lensFlavour
@@ -99,14 +97,14 @@
   return []
 
 dataLenses :: Name -> [Name] -> Name -> DecsQ
-dataLenses top intermediate local = do
-  (DT _ fields) <- dataType local
+dataLenses top intermediate local' = do
+  (DT _ fields) <- dataType local'
   join <$> traverse (fieldLenses top intermediate) fields
 
 dataLensesIfEligible :: Name -> [Name] -> Name -> DecsQ
-dataLensesIfEligible top intermediate local = do
-  eligible <- eligibleForDeepError local
-  if eligible then dataLenses top intermediate local else return []
+dataLensesIfEligible top intermediate local' = do
+  eligible <- eligibleForDeepError local'
+  if eligible then dataLenses top intermediate local' else return []
 
 lensesForMainData :: Name -> DecsQ
 lensesForMainData name = do
diff --git a/lib/Data/DeepPrisms.hs b/lib/Data/DeepPrisms.hs
--- a/lib/Data/DeepPrisms.hs
+++ b/lib/Data/DeepPrisms.hs
@@ -1,15 +1,13 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE TemplateHaskell #-}
-
 module Data.DeepPrisms where
 
 import Control.Lens (Prism', makeClassyPrisms)
 import qualified Control.Lens as Lens (preview, review)
-import Control.Monad (join, (<=<))
+import Control.Monad (filterM, (<=<))
+import Data.Maybe (mapMaybe)
 import Language.Haskell.TH
 import Language.Haskell.TH.Datatype (
   ConstructorInfo(constructorName, constructorFields),
-  DatatypeInfo(datatypeCons, datatypeName),
+  DatatypeInfo(datatypeCons),
   reifyDatatype,
   )
 import Language.Haskell.TH.Syntax (
@@ -34,37 +32,45 @@
 data Ctor =
   Ctor {
     ctorName :: Name,
-    ctorTypes :: [Type]
+    ctorType :: Name
   }
+  deriving (Eq, Show)
 
 data SubError =
   SubError {
     seCtor :: Name,
     seWrapped :: Name
   }
-
-ctor :: ConstructorInfo -> Ctor
-ctor info = Ctor (constructorName info) (constructorFields info)
+  deriving (Eq, Show)
 
-data DT =
-  DT {
-    dtName :: Name,
-    dtCons :: [Ctor]
+data PrismsInstance =
+  PrismsInstance {
+    prismInstanceName :: Name,
+    prismInstanceDec :: Dec
   }
+  deriving (Eq, Show)
 
-dataType :: Name -> Q DT
-dataType name = do
-  info <- reifyDatatype name
-  return $ DT (datatypeName info) (ctor <$> datatypeCons info)
+ctor :: ConstructorInfo -> Maybe Ctor
+ctor info =
+  cons (constructorFields info)
+  where
+    cons [ConT tpe] =
+      Just $ Ctor (constructorName info) tpe
+    cons _ =
+      Nothing
 
+dataType :: Name -> Q [Ctor]
+dataType =
+  fmap (mapMaybe ctor . datatypeCons) . reifyDatatype
+
 mkHoist :: TypeQ -> TypeQ -> BodyQ -> DecQ
 mkHoist _ _ body = do
   (VarE name) <- [|prism|]
   funD name [clause [] body []]
 
 deepPrismsInstance :: TypeQ -> TypeQ -> BodyQ -> DecQ
-deepPrismsInstance top local body =
-  instanceD (cxt []) (appT (appT [t|DeepPrisms|] top) local) [mkHoist top local body]
+deepPrismsInstance top local' body =
+  instanceD (cxt []) (appT (appT [t|DeepPrisms|] top) local') [mkHoist top local' body]
 
 idInstance :: Name -> DecQ
 idInstance name =
@@ -73,16 +79,11 @@
     nt = conT name
     body = normalB [|id|]
 
-eligibleForDeepError :: Name -> Q Bool
-eligibleForDeepError tpe = do
+typeHasDeepPrisms :: Ctor -> Q Bool
+typeHasDeepPrisms (Ctor _ tpe) = do
   (ConT name) <- [t|DeepPrisms|]
   isInstance name [ConT tpe, ConT tpe]
 
-subInstances :: Name -> [Name] -> Name -> DecsQ
-subInstances top intermediate local = do
-  (DT _ subCons) <- dataType local
-  join <$> traverse (deepInstancesIfEligible top intermediate) subCons
-
 modName :: NameFlavour -> Maybe ModName
 modName (NameQ mod') =
   Just mod'
@@ -114,34 +115,44 @@
       | sameModule topFlavour localFlavour = NameS
       | otherwise = prismFlavour localFlavour
 
-deepInstances :: Name -> [Name] -> Name -> Name -> DecsQ
-deepInstances top intermediate name tpe = do
-  current <- deepPrismsInstance (conT top) (conT tpe) (normalB body)
-  sub <- subInstances top (name : intermediate) tpe
-  return (current : sub)
+constructorPrism :: Name -> [Name] -> Ctor -> Q PrismsInstance
+constructorPrism top intermediate (Ctor name tpe) = do
+  inst <- deepPrismsInstance (conT top) (conT tpe) (normalB body)
+  return (PrismsInstance tpe inst)
   where
     compose = appE . appE [|(.)|] . prismName top
     body = foldr compose (prismName top name) (reverse intermediate)
 
-deepInstancesIfEligible :: Name -> [Name] -> Ctor -> DecsQ
-deepInstancesIfEligible top intermediate (Ctor name [ConT tpe]) = do
-  eligible <- eligibleForDeepError tpe
-  if eligible then deepInstances top intermediate name tpe else return []
-deepInstancesIfEligible _ _ _ =
-  return []
+filterDuplicates :: [Ctor] -> [PrismsInstance] -> [PrismsInstance]
+filterDuplicates created =
+  filter (not . (`elem` (ctorType <$> created)) . prismInstanceName)
 
-errorInstances :: DT -> DecsQ
-errorInstances (DT name cons) = do
-  idInst <- idInstance name
-  deepInsts <- traverse (deepInstancesIfEligible name []) cons
-  return (idInst : join deepInsts)
+deepPrismCtors :: Name -> Q [Ctor]
+deepPrismCtors =
+  filterM typeHasDeepPrisms <=< dataType
 
-deepPrisms' :: Name -> DecsQ
-deepPrisms' =
-  errorInstances <=< dataType
+basicPrisms :: Name -> DecsQ
+basicPrisms name = do
+  ctors <- dataType name
+  if length ctors > 1 then makeClassyPrisms name else return []
 
+prismsForData :: Name -> [Name] -> Name -> Q [PrismsInstance]
+prismsForData top intermediate local' = do
+  cons <- deepPrismCtors local'
+  localInstances <- traverse (constructorPrism top intermediate) cons
+  deepInstances <- traverse recurse cons
+  return (localInstances ++ (deepInstances >>= filterDuplicates cons))
+  where
+    recurse (Ctor name tpe) = prismsForData top (name : intermediate) tpe
+
+prismsForMainData :: Name -> DecsQ
+prismsForMainData name = do
+  idInst <- idInstance name
+  insts <- prismsForData name [] name
+  return (idInst : (prismInstanceDec <$> insts))
+
 deepPrisms :: Name -> DecsQ
 deepPrisms name = do
-  prisms <- makeClassyPrisms name
-  err <- deepPrisms' name
-  return $ prisms ++ err
+  basic <- basicPrisms name
+  deep <- prismsForMainData name
+  return $ basic ++ deep
diff --git a/lib/Prelude.hs b/lib/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/lib/Prelude.hs
@@ -0,0 +1,7 @@
+module Prelude (
+  module Relude,
+  undefined,
+) where
+
+import GHC.Err (undefined)
+import Relude hiding (Type, ask, asks, get, gets, hoistEither, local, modify, put, state, undefined)
diff --git a/test/u/DeepErrorSpec.hs b/test/u/DeepErrorSpec.hs
--- a/test/u/DeepErrorSpec.hs
+++ b/test/u/DeepErrorSpec.hs
@@ -1,11 +1,12 @@
 {-# OPTIONS_GHC -F -pgmF htfpp #-}
-{-# LANGUAGE TemplateHaskell #-}
 
-module DeepErrorSpec(
-  htf_thisModulesTests,
-) where
+module DeepErrorSpec (htf_thisModulesTests) where
 
+import qualified Data.String as String (lines)
+import Control.Monad (when)
 import Control.Monad.Trans.Except (runExceptT)
+import Data.Foldable (traverse_)
+import Language.Haskell.TH
 import Test.Framework
 
 import Control.Monad.DeepError (MonadDeepError(throwHoist))
@@ -16,7 +17,7 @@
   deriving (Eq, Show)
 
 newtype Err2 =
-  Err2 Int
+  Err2C Int
   deriving (Eq, Show)
 
 data Err =
@@ -63,8 +64,14 @@
 throwDeep =
   throwHoist (ErrC (Err1 5))
 
+debugPrint :: IO ()
+debugPrint =
+  traverse_ putStrLn . String.lines $ $(stringE . pprint =<< deepPrisms ''Err2)
+
 test_hoist :: IO ()
 test_hoist = do
-  -- traverse_ putStrLn $ lines $(stringE . pprint =<< deepPrisms ''MainErr)
+  when debug debugPrint
   a <- runExceptT throwDeep
   assertEqual (Left (MainErrC (MiddleErrC (BotC (ErrC (Err1 5)))))) a
+  where
+    debug = False
diff --git a/test/u/DeepReaderSpec.hs b/test/u/DeepReaderSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/u/DeepReaderSpec.hs
@@ -0,0 +1,58 @@
+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+
+module DeepReaderSpec (htf_thisModulesTests) where
+
+import Test.Framework
+
+import Control.Monad.DeepReader (MonadDeepReader(ask), asks)
+import Data.DeepLenses (deepLenses)
+
+newtype S1 =
+  S1 Int
+  deriving (Eq, Show)
+
+newtype S2 =
+  S2 Int
+  deriving (Eq, Show)
+
+newtype S =
+  SC { _sS1 :: S1 }
+  deriving (Eq, Show)
+
+deepLenses ''S
+
+newtype Bot =
+  BotC { _botS :: S }
+  deriving (Eq, Show)
+
+deepLenses ''Bot
+
+newtype MiddleOther =
+  MiddleOther Int
+  deriving (Eq, Show)
+
+data MiddleS =
+  MiddleSC {
+    _middleBot :: Bot,
+    _middleS2 :: S2
+    }
+  deriving (Eq, Show)
+
+deepLenses ''MiddleS
+
+newtype MainS =
+  MainSC { _mainMiddle :: MiddleS }
+  deriving (Eq, Show)
+
+deepLenses ''MainS
+
+stateDeep :: MonadDeepReader r S m => m S
+stateDeep = do
+  (SC (S1 a)) <- ask
+  b <- asks $ \(SC (S1 b)) -> b
+  pure (SC (S1 (a + b + 3)))
+
+test_reader :: IO ()
+test_reader = do
+  a <- runReaderT stateDeep (MainSC (MiddleSC (BotC (SC (S1 5))) (S2 1)))
+  assertEqual (SC (S1 13)) a
diff --git a/test/u/DeepStateSpec.hs b/test/u/DeepStateSpec.hs
--- a/test/u/DeepStateSpec.hs
+++ b/test/u/DeepStateSpec.hs
@@ -1,11 +1,7 @@
 {-# OPTIONS_GHC -F -pgmF htfpp #-}
-{-# LANGUAGE TemplateHaskell #-}
 
-module DeepStateSpec(
-  htf_thisModulesTests,
-) where
+module DeepStateSpec (htf_thisModulesTests) where
 
-import Control.Monad.Trans.State (execStateT)
 import Test.Framework
 
 import Control.Monad.DeepState (MonadDeepState(get, put), gets)
diff --git a/test/u/Prelude.hs b/test/u/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/test/u/Prelude.hs
@@ -0,0 +1,10 @@
+module Prelude (
+  module Cornea,
+  module Relude,
+  undefined,
+) where
+
+import GHC.Err (undefined)
+import Relude hiding (Type, ask, asks, get, gets, hoistEither, hoistMaybe, modify, put, state, undefined)
+
+import Cornea
diff --git a/test/u/SpecMain.hs b/test/u/SpecMain.hs
--- a/test/u/SpecMain.hs
+++ b/test/u/SpecMain.hs
@@ -5,6 +5,7 @@
 import Test.Framework
 import Test.Framework.BlackBoxTest ()
 import {-@ HTF_TESTS @-} DeepErrorSpec
+import {-@ HTF_TESTS @-} DeepReaderSpec
 import {-@ HTF_TESTS @-} DeepStateSpec
 
 main :: IO ()