diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,55 @@
+# Blue Oak Model License
+
+Version 1.0.0
+
+## Purpose
+
+This license gives everyone as much permission to work with
+this software as possible, while protecting contributors
+from liability.
+
+## Acceptance
+
+In order to receive this license, you must agree to its
+rules.  The rules of this license are both obligations
+under that agreement and conditions to your license.
+You must not do anything with this software that triggers
+a rule that you cannot or will not follow.
+
+## Copyright
+
+Each contributor licenses you to do everything with this
+software that would otherwise infringe that contributor's
+copyright in it.
+
+## Notices
+
+You must ensure that everyone who gets a copy of
+any part of this software from you, with or without
+changes, also gets the text of this license or a link to
+<https://blueoakcouncil.org/license/1.0.0>.
+
+## Excuse
+
+If anyone notifies you in writing that you have not
+complied with [Notices](#notices), you can keep your
+license by taking all practical steps to comply within 30
+days after the notice.  If you do not do so, your license
+ends immediately.
+
+## Patent
+
+Each contributor licenses you to do everything with this
+software that would otherwise infringe any patent claims
+they can license or become able to license.
+
+## Reliability
+
+No contributor can revoke this license.
+
+## No Liability
+
+***As far as the law allows, this software comes as is,
+without any warranty or condition, and no contributor
+will be liable to anyone for any damages related to this
+software or this license, under any kind of legal claim.***
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,65 @@
+# Intro
+
+Classes for accessing and mutating nested data types with corresponding adapter classes for `MonadState` and `MonadError`.
+
+# Example
+
+For `MonadError`:
+
+```haskell
+{-# LANGUAGE TemplateHaskell #-}
+
+import Control.Monad.DeepError (MonadDeepError(throwHoist))
+import Control.Monad.Trans.Except (runExceptT)
+import Data.DeepPrisms (deepPrisms)
+
+newtype Error = Error String
+
+newtype Inner = Inner Error
+deepPrisms ''Inner
+
+data Mid = Mid Inner
+deepPrisms ''Mid
+
+newtype Outer = Outer Mid
+deepPrisms ''Outer
+
+throwDeep :: MonadDeepError e Inner m => m ()
+throwDeep = throwHoist (Inner (Error "boom"))
+
+main :: IO (Either Outer ())
+main = runExceptT throwDeep
+```
+
+In `main`, `MonadError Outer IO` and `DeepPrisms Outer Inner` is summoned.
+
+Analogously for `MonadState`:
+
+```haskell
+{-# LANGUAGE TemplateHaskell #-}
+
+import Control.Monad.DeepState (MonadDeepState(get, gets, put))
+import Control.Monad.Trans.State (execStateT)
+import Data.DeepLenses (deepLenses)
+
+newtype S = S Int
+
+newtype Inner = Inner { innerS :: S }
+deepLenses ''Inner
+
+data Mid = Mid { _midInner :: Inner }
+deepLenses ''Mid
+
+newtype Outer = Outer { _outerMid :: Mid }
+deepLenses ''Outer
+
+stateDeep :: MonadDeepState s Inner m => m ()
+stateDeep = do
+  (Inner (S a)) <- get
+  b <- gets $ \(Inner (S b)) -> b
+  put (Inner (S (a + b + 3)))
+
+main :: IO Outer
+main = do
+  execStateT stateDeep (Outer (Mid (Inner (S 5))))
+```
diff --git a/cornea.cabal b/cornea.cabal
new file mode 100644
--- /dev/null
+++ b/cornea.cabal
@@ -0,0 +1,81 @@
+cabal-version: 1.12
+name: cornea
+version: 0.2.0.0
+license: OtherLicense
+license-file: LICENSE
+copyright: 2019 Torsten Schmits
+maintainer: tek@tryp.io
+author: Torsten Schmits
+homepage: https://github.com/tek/cornea#readme
+bug-reports: https://github.com/tek/cornea/issues
+synopsis: classy optical monadic state
+description:
+    Please see the README on GitHub at <https://github.com/tek/cornea>
+category: Lens
+build-type: Simple
+extra-source-files:
+    README.md
+
+source-repository head
+    type: git
+    location: https://github.com/tek/cornea
+
+library
+    exposed-modules:
+        Control.Monad.DeepError
+        Control.Monad.DeepState
+        Data.DeepLenses
+        Data.DeepPrisms
+    hs-source-dirs: lib
+    other-modules:
+        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
+    build-depends:
+        base >=4.7 && <5,
+        lens >=4.16.1 && <4.17,
+        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
+
+test-suite cornea-unit
+    type: exitcode-stdio-1.0
+    main-is: SpecMain.hs
+    hs-source-dirs: test/u
+    other-modules:
+        DeepErrorSpec
+        DeepStateSpec
+        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
+    ghc-options: -threaded -rtsopts -with-rtsopts=-N
+    build-depends:
+        HTF >=0.13.2.5 && <0.14,
+        base >=4.7 && <5,
+        cornea -any,
+        lens >=4.16.1 && <4.17,
+        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
diff --git a/lib/Control/Monad/DeepError.hs b/lib/Control/Monad/DeepError.hs
new file mode 100644
--- /dev/null
+++ b/lib/Control/Monad/DeepError.hs
@@ -0,0 +1,28 @@
+module Control.Monad.DeepError where
+
+import Control.Monad.Error.Class (MonadError(throwError, catchError))
+
+import Data.DeepPrisms (DeepPrisms, hoist, retrieve)
+
+class (MonadError e m, DeepPrisms e e') => MonadDeepError e e' m where
+  throwHoist :: e' -> m a
+
+instance (MonadError e m, DeepPrisms e e') => MonadDeepError e e' m where
+  throwHoist =
+    throwError . hoist
+
+catchAt :: (MonadError e m, DeepPrisms e e') => (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
+hoistEither =
+  either throwHoist return
+
+hoistMaybe :: MonadDeepError e e' m => e' -> Maybe a -> m a
+hoistMaybe e' =
+  maybe (throwHoist e') return
+
+-- TODO derive multiple errors with HList + Generic
diff --git a/lib/Control/Monad/DeepState.hs b/lib/Control/Monad/DeepState.hs
new file mode 100644
--- /dev/null
+++ b/lib/Control/Monad/DeepState.hs
@@ -0,0 +1,25 @@
+module Control.Monad.DeepState where
+
+import qualified Control.Lens as Lens (set, view)
+import Control.Monad.State.Class (MonadState)
+import qualified Control.Monad.State.Class as MS (MonadState(get), modify)
+
+import Data.DeepLenses (DeepLenses(deepLens))
+
+class (MonadState s m, DeepLenses s s') => MonadDeepState s s' m where
+  get :: m s'
+  put :: s' -> m ()
+  state :: (s' -> m (a, s')) -> m a
+
+instance (MonadState s m, DeepLenses s s') => MonadDeepState s s' m where
+  get = Lens.view deepLens <$> MS.get
+  put = MS.modify . Lens.set deepLens
+  state f = do
+    s' <- get
+    ~(a, s'') <- f s'
+    put s''
+    return a
+
+gets :: MonadDeepState s s' m => (s' -> a) -> m a
+gets =
+  (<$> get)
diff --git a/lib/Data/DeepLenses.hs b/lib/Data/DeepLenses.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/DeepLenses.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Data.DeepLenses where
+
+import Control.Lens (Lens', makeClassy)
+import Control.Monad (join)
+import Data.List (zipWith)
+import Language.Haskell.TH
+import Language.Haskell.TH.Datatype (
+  ConstructorInfo(ConstructorInfo),
+  ConstructorVariant(RecordConstructor),
+  DatatypeInfo(datatypeCons, datatypeName),
+  reifyDatatype,
+  )
+import Language.Haskell.TH.Syntax (ModName(..), Name(Name), NameFlavour(NameQ, NameS, NameG), OccName(..))
+
+class DeepLenses e e' where
+  deepLens :: Lens' e e'
+
+data Field =
+  Field {
+    fieldName :: Name,
+    fieldType :: Type
+  }
+  deriving Show
+
+data DT =
+  DT {
+    dtName :: Name,
+    dtFields :: [Field]
+  }
+  deriving Show
+
+dataType :: Name -> Q DT
+dataType name = do
+  info <- reifyDatatype name
+  return $ DT (datatypeName info) (fields $ datatypeCons info)
+  where
+    fields [ConstructorInfo _ _ _ types _ (RecordConstructor names)] =
+      zipWith Field names types
+    fields _ =
+      []
+
+mkHoist :: TypeQ -> TypeQ -> BodyQ -> DecQ
+mkHoist _ _ body = do
+  (VarE name) <- [|deepLens|]
+  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]
+
+idLenses :: Name -> DecQ
+idLenses name =
+  deepLensesInstance nt nt body
+  where
+    nt = conT name
+    body = normalB [|id|]
+
+eligibleForDeepError :: Name -> Q Bool
+eligibleForDeepError tpe = do
+  (ConT name) <- [t|DeepLenses|]
+  isInstance name [ConT tpe, ConT tpe]
+
+modName :: NameFlavour -> Maybe ModName
+modName (NameQ mod') =
+  Just mod'
+modName (NameG _ _ mod') =
+  Just mod'
+modName _ =
+  Nothing
+
+sameModule :: NameFlavour -> NameFlavour -> Bool
+sameModule f1 f2 =
+  case (modName f1, modName f2) of
+    (Just a, Just b) | a == b -> True
+    _ -> False
+
+lensName :: Name -> Name -> ExpQ
+lensName (Name _ topFlavour) (Name (OccName n) lensFlavour) =
+  varE (Name (OccName (lensName' n)) flavour)
+  where
+    lensName' ('_' : t) = t
+    lensName' [] = []
+    lensName' a = a
+    flavour
+      | sameModule topFlavour lensFlavour = NameS
+      | otherwise = lensFlavour
+
+fieldLenses :: Name -> [Name] -> Field -> DecsQ
+fieldLenses top intermediate (Field name (ConT tpe)) = do
+  current <- deepLensesInstance (conT top) (conT tpe) (normalB body)
+  sub <- dataLensesIfEligible top (name : intermediate) tpe
+  return (current : sub)
+  where
+    compose = appE . appE [|(.)|] . lensName top
+    body = foldr compose (lensName top name) (reverse intermediate)
+fieldLenses _ _ _ =
+  return []
+
+dataLenses :: Name -> [Name] -> Name -> DecsQ
+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 []
+
+lensesForMainData :: Name -> DecsQ
+lensesForMainData name = do
+  idL <- idLenses name
+  fields <- dataLenses name [] name
+  return (idL : fields)
+
+deepLenses :: Name -> DecsQ
+deepLenses name = do
+  lenses <- makeClassy name
+  err <- lensesForMainData name
+  return $ lenses ++ err
diff --git a/lib/Data/DeepPrisms.hs b/lib/Data/DeepPrisms.hs
new file mode 100644
--- /dev/null
+++ b/lib/Data/DeepPrisms.hs
@@ -0,0 +1,132 @@
+{-# 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 Language.Haskell.TH
+import Language.Haskell.TH.Datatype (
+  ConstructorInfo(constructorName, constructorFields),
+  DatatypeInfo(datatypeCons, datatypeName),
+  reifyDatatype,
+  )
+import Language.Haskell.TH.Syntax (ModName(..), Name(Name), NameFlavour(NameQ, NameS, NameG), OccName(..))
+
+class DeepPrisms e e' where
+  prism :: Prism' e e'
+
+hoist :: DeepPrisms e e' => e' -> e
+hoist =
+  Lens.review prism
+
+retrieve :: DeepPrisms e e' => e -> Maybe e'
+retrieve =
+  Lens.preview prism
+
+data Ctor =
+  Ctor {
+    ctorName :: Name,
+    ctorTypes :: [Type]
+  }
+
+data SubError =
+  SubError {
+    seCtor :: Name,
+    seWrapped :: Name
+  }
+
+ctor :: ConstructorInfo -> Ctor
+ctor info = Ctor (constructorName info) (constructorFields info)
+
+data DT =
+  DT {
+    dtName :: Name,
+    dtCons :: [Ctor]
+  }
+
+dataType :: Name -> Q DT
+dataType name = do
+  info <- reifyDatatype name
+  return $ DT (datatypeName info) (ctor <$> datatypeCons info)
+
+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]
+
+idInstance :: Name -> DecQ
+idInstance name =
+  deepPrismsInstance nt nt body
+  where
+    nt = conT name
+    body = normalB [|id|]
+
+eligibleForDeepError :: Name -> Q Bool
+eligibleForDeepError 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'
+modName (NameG _ _ mod') =
+  Just mod'
+modName _ =
+  Nothing
+
+sameModule :: NameFlavour -> NameFlavour -> Bool
+sameModule f1 f2 =
+  case (modName f1, modName f2) of
+    (Just a, Just b) | a == b -> True
+    _ -> False
+
+prismName :: Name -> Name -> ExpQ
+prismName (Name _ topFlavour) (Name (OccName n) prismFlavour) =
+  varE (Name (OccName ('_' : n)) flavour)
+  where
+    flavour
+      | sameModule topFlavour prismFlavour = NameS
+      | otherwise = prismFlavour
+
+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)
+  where
+    compose = appE . appE [|(.)|] . prismName top
+    body = foldr compose (prismName top name) 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 []
+
+errorInstances :: DT -> DecsQ
+errorInstances (DT name cons) = do
+  idInst <- idInstance name
+  deepInsts <- traverse (deepInstancesIfEligible name []) cons
+  return (idInst : join deepInsts)
+
+deepPrisms' :: Name -> DecsQ
+deepPrisms' =
+  errorInstances <=< dataType
+
+deepPrisms :: Name -> DecsQ
+deepPrisms name = do
+  prisms <- makeClassyPrisms name
+  err <- deepPrisms' name
+  return $ prisms ++ err
diff --git a/test/u/DeepErrorSpec.hs b/test/u/DeepErrorSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/u/DeepErrorSpec.hs
@@ -0,0 +1,62 @@
+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module DeepErrorSpec(
+  htf_thisModulesTests,
+) where
+
+import Control.Monad.Trans.Except (runExceptT)
+import Test.Framework
+
+import Control.Monad.DeepError (MonadDeepError(throwHoist))
+import Data.DeepPrisms (deepPrisms)
+
+newtype Err1 =
+  Err1 Int
+  deriving (Eq, Show)
+
+newtype Err2 =
+  Err2 Int
+  deriving (Eq, Show)
+
+data Err =
+  ErrC Err1
+  |
+  ErrC1 Err2
+  deriving (Eq, Show)
+
+deepPrisms ''Err
+
+newtype MiddleOther =
+  MiddleOther Int
+  deriving (Eq, Show)
+
+data MiddleErr =
+  MiddleErrC Err
+  |
+  MiddleErrOther MiddleOther
+  deriving (Eq, Show)
+
+deepPrisms ''MiddleErr
+
+newtype MainOther =
+  MainOther Int
+  deriving (Eq, Show)
+
+data MainErr =
+  MainErrC MiddleErr
+  |
+  MainErrOther MainOther
+  deriving (Eq, Show)
+
+deepPrisms ''MainErr
+
+throwDeep :: MonadDeepError e Err m => m ()
+throwDeep =
+  throwHoist (ErrC (Err1 5))
+
+test_hoist :: IO ()
+test_hoist = do
+  -- traverse_ putStrLn $ lines $(stringE . pprint =<< deepPrisms ''MainErr)
+  a <- runExceptT throwDeep
+  assertEqual (Left (MainErrC (MiddleErrC (ErrC (Err1 5))))) a
diff --git a/test/u/DeepStateSpec.hs b/test/u/DeepStateSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/u/DeepStateSpec.hs
@@ -0,0 +1,56 @@
+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module DeepStateSpec(
+  htf_thisModulesTests,
+) where
+
+import Control.Monad.Trans.State (execStateT)
+import Test.Framework
+
+import Control.Monad.DeepState (MonadDeepState(get, put), gets)
+import Data.DeepLenses (deepLenses)
+
+newtype S1 =
+  S1 Int
+  deriving (Eq, Show)
+
+newtype S2 =
+  S2 Int
+  deriving (Eq, Show)
+
+newtype Bot =
+  BotC { _botS1 :: S1 }
+  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 :: MonadDeepState s Bot m => m ()
+stateDeep = do
+  (BotC (S1 a)) <- get
+  b <- gets $ \(BotC (S1 b)) -> b
+  put (BotC (S1 (a + b + 3)))
+
+test_lens :: IO ()
+test_lens = do
+  a <- execStateT stateDeep (MainSC (MiddleSC (BotC (S1 5)) (S2 1)))
+  assertEqual (MainSC (MiddleSC (BotC (S1 13)) (S2 1))) a
diff --git a/test/u/SpecMain.hs b/test/u/SpecMain.hs
new file mode 100644
--- /dev/null
+++ b/test/u/SpecMain.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+
+module Main where
+
+import Test.Framework
+import Test.Framework.BlackBoxTest ()
+import {-@ HTF_TESTS @-} DeepErrorSpec
+import {-@ HTF_TESTS @-} DeepStateSpec
+
+main :: IO ()
+main = htfMain htf_importedTests