diff --git a/Control/Lens/Codec.hs b/Control/Lens/Codec.hs
deleted file mode 100644
--- a/Control/Lens/Codec.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-
-module Control.Lens.Codec (lensCodec) where
-
-import Control.Applicative
-import Control.Monad.Identity
-import Control.Monad.Reader
-import Control.Monad.State
-
-import Data.Codec
-
--- | Turn a `Lens` into a `Codec` operating in a `MonadReader`/`MonadState`.
-lensCodec :: (MonadReader s fr, MonadState s fw)
-  => (forall f. (a -> f a) -> s -> f s) -> Codec fr fw a
-lensCodec l = Codec
-  { parse = liftM getConst $ asks (l Const)
-  , produce = \x -> modify (runIdentity . l (const $ Identity x))
-  }
diff --git a/Data/Codec/Codec.hs b/Data/Codec/Codec.hs
new file mode 100644
--- /dev/null
+++ b/Data/Codec/Codec.hs
@@ -0,0 +1,115 @@
+module Data.Codec.Codec
+  ( -- * Codecs
+    Codec'(..), Codec
+  , (>-<)
+    -- * Concrete codecs
+  , ConcreteCodec, concrete, parseVal, produceVal
+    -- * Partial codecs
+    -- | Partial codecs are useful for creating codecs
+    -- for types with multiple constructors. See @examples/Multi.hs@.
+  , PartialCodec, cbuild, assume, covered, (<->), produceMaybe
+    -- * Codec combinators
+  , opt, mapCodec, mapCodecF, mapCodecM
+  )
+where
+
+import Control.Applicative
+import Control.Monad ((>=>))
+import Control.Monad.Reader (ReaderT(..))
+import Data.Codec.Field
+import Data.Functor.Compose
+import Data.Maybe (fromMaybe)
+
+-- | De/serializer for the given types. Usually w ~ r, but they are separate
+-- to allow for an `Applicative` instance.
+data Codec' fr fw w r = Codec
+  { parse :: fr r
+  , produce :: w -> fw () 
+  }
+  deriving Functor
+
+-- | De/serializer for @a@.
+type Codec fr fw a = Codec' fr fw a a
+
+-- Build up a serializer in parallel to a deserializer.
+instance (Applicative fw, Applicative fr) => Applicative (Codec' fr fw w) where
+  pure x = Codec (pure x) (const $ pure ())
+  Codec f fw <*> Codec x xw
+    = Codec (f <*> x) (\w -> fw w *> xw w)
+
+-- | Associate a `Field` with a `Codec` to create a `Codec` `Build`.
+(>-<) :: Functor fr => Field r a x y -> Codec fr fw a -> Build r (Codec' fr fw r) x y
+Field c g >-< Codec r w
+  = Build (c <$> Codec r (w . g))
+
+-- Codec combinators
+
+-- | Given a `Codec` for @a@, make one for `Maybe` @a@ that applies its deserializer optionally
+-- and does nothing when serializing `Nothing`.
+opt :: (Alternative fr, Applicative fw) => Codec fr fw a -> Codec fr fw (Maybe a)
+opt (Codec r w) = Codec (optional r) (maybe (pure ()) w)
+
+-- | Turn a @`Codec` a@ into a @`Codec` b@ by providing an isomorphism.
+mapCodec :: Functor fr => (a -> b) -> (b -> a) -> Codec fr fw a -> Codec fr fw b
+mapCodec to from (Codec r w)
+  = Codec (to <$> r) (w . from)
+
+-- | Map a field codec monadically. Useful for error handling but care must be taken to make sure that
+-- the results are still complementary.
+mapCodecM :: (Monad fr, Monad fw) => (a -> fr b) -> (b -> fw a) -> Codec fr fw a -> Codec fr fw b
+mapCodecM to from (Codec r w)
+  = Codec (r >>= to) (from >=> w)
+
+-- | Map the contexts of a given `Codec`.
+mapCodecF :: (fr a -> gr a) -> (fw () -> gw ()) -> Codec fr fw a -> Codec gr gw a
+mapCodecF fr fw (Codec r w)
+  = Codec (fr r) (fw . w)
+
+-- | A codec where `a` can be produced from a concrete value of `b` in context `f`,
+-- and a concrete type of value `b` can always be produced.
+type ConcreteCodec b f a = Codec (ReaderT b f) (Const b) a
+
+-- | Create a concrete codec from a reader and a writer.
+concrete :: (b -> f a) -> (a -> b) -> ConcreteCodec b f a
+concrete r w = Codec (ReaderT r) (Const . w)
+
+-- | Parse a concrete value with a given `ConcreteCodec`.
+parseVal :: ConcreteCodec b f a -> b -> f a
+parseVal (Codec r _) = runReaderT r
+
+-- | Produce a concrete value with a given `ConcreteCodec`.
+produceVal :: ConcreteCodec b f a -> a -> b
+produceVal (Codec _ w) = getConst . w
+
+-- | A codec that can only serialize a subset of values.
+type PartialCodec fr fw a = Codec fr (Compose Maybe fw) a
+
+-- | Finish a codec construction with a @`Con` r@ to produce a `PartialCodec`.
+-- This will check that the given record has the appropriate constructor
+-- before serializing.
+cbuild :: (Functor fr, Buildable r y)
+  => Con r x -> Build r (Codec' fr fw r) x y -> PartialCodec fr fw r
+cbuild (Con c p) = assume p . build c
+
+-- | Guard a `Codec` with a predicate to create a `PartialCodec`.
+assume :: (a -> Bool) -> Codec fr fw a -> PartialCodec fr fw a
+assume p (Codec r w)
+  = Codec r (\x -> Compose $ if p x then Just (w x) else Nothing)
+
+-- | Convert a `PartialCodec` into a `Codec`, throwing an error
+-- on values it cannot serialize.
+covered :: PartialCodec fr fw a -> Codec fr fw a
+covered cd
+  = Codec (parse cd) (fromMaybe (error "Could not serialize value.") . produceMaybe cd)
+
+-- | Combine alternative `PartialCodec`s.
+(<->) :: Alternative fr => PartialCodec fr fw a -> PartialCodec fr fw a -> PartialCodec fr fw a
+cd <-> acd = Codec
+  { parse = parse cd <|> parse acd
+  , produce = \x -> Compose $ produceMaybe cd x <|> produceMaybe acd x
+}
+
+-- | Attempt to get a serialization for a given value.
+produceMaybe :: PartialCodec fr fw a -> a -> Maybe (fw ())
+produceMaybe (Codec _ w) x
+  = getCompose (w x)
diff --git a/Data/Codec/Field.hs b/Data/Codec/Field.hs
new file mode 100644
--- /dev/null
+++ b/Data/Codec/Field.hs
@@ -0,0 +1,68 @@
+module Data.Codec.Field
+  ( 
+  -- * First-class record construction
+    Field(..)
+  , Build(..)
+  , Con(..)
+  , ($>>), (>>>), done
+  , X(X), Buildable(..)
+  , having, build
+  ) where
+
+import Control.Applicative
+import Control.Category
+import Prelude hiding ((.), id)
+
+-- | `Field`s partially apply constructors and replace arguments with this type.
+data X = X
+
+-- | The class of constructor applications that have been completely filled in by composing
+-- `Build`s. If you see an error message involving this, it means that you forgot to specify
+-- a `Build` for a field.
+class Buildable r a where
+  give :: a -> r
+
+instance Buildable r r where
+  give = id
+
+instance Buildable r b => Buildable r (X -> b) where
+  give f = give $ f X
+
+-- | Describes how to apply a constructor argument and how to extract from a record.
+-- @y@ should be @x@ with one argument knocked out: e. g.
+--
+-- @
+-- Field MyType Int (Int -> a2 -> MyType) (X -> a2 -> MyType)
+-- @
+data Field r a x y = Field (a -> x -> y) (r -> a)
+
+-- Static (Backwards f) + phantom parameter
+-- | An ongoing record construction of an @r@ in context @f@.
+-- Applicative actions are sequenced in the direction of `>>>`.
+newtype Build r f x y = Build (f (x -> y))
+
+-- | Combine a `Field` and a way to produce an @a@ to get a `Build`.
+having :: Functor f => Field r a x y -> f a -> Build r f x y
+having (Field c _) p = Build (c <$> p)
+
+-- | No-op `Build` (same as `id`).
+done :: Applicative f => Build r f x x
+done = id
+
+instance Applicative f => Category (Build r f) where
+  id = Build (pure id)
+  Build f . Build g
+    = Build ((>>>) <$> g <*> f)
+
+-- | Finish a construction given a constructor.
+build :: (Functor f, Buildable r y) => x -> Build r f x y -> f r
+build x (Build b)
+  = (\f -> give $ f x) <$> b
+
+-- | Infix version of `build`.
+($>>) :: (Functor f, Buildable r y) => x -> Build r f x y -> f r
+($>>) = build
+infixr 1 $>>
+
+-- | A constructor for a given record and a way to check whether it has it.
+data Con r x = Con x (r -> Bool)
diff --git a/Data/Codec/TH.hs b/Data/Codec/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/Codec/TH.hs
@@ -0,0 +1,89 @@
+module Data.Codec.TH (genFields) where
+
+import Control.Applicative
+import Data.Foldable (foldl')
+import Data.Traversable (for, traverse)
+import Language.Haskell.TH as TH
+import Language.Haskell.TH.Syntax as TH
+
+import Data.Codec.Field as F
+
+replaceAt :: a -> Int -> [ a ] -> [ a ]
+replaceAt x i xs = pr ++ x : suf
+  where ( pr, _ : suf ) = splitAt i xs
+
+deleteAt :: Int -> [ a ] -> [ a ]
+deleteAt i xs = pr ++ suf
+  where ( pr, _ : suf ) = splitAt i xs
+
+fun :: Type -> Type -> Type
+fun x = AppT (AppT ArrowT x)
+
+genField :: [ Name ] -> Type -> Int -> ( Int, VarStrictType ) -> Q [ Dec ]
+genField recVars recType fc ( i, ( fn, _, ft ) ) = do
+  polyNames <- for [1..fc] $ \j -> do
+    let pn = "arg" ++ show j
+    if any (\rv -> nameBase rv == pn) recVars
+      then newName pn
+      else return $ mkName pn
+  let polyTypes = map VarT polyNames
+      polyArgs = map (\j -> mkName $ "arg" ++ show j) [1..fc]
+      fieldVars = map PlainTV $ recVars ++ deleteAt i polyNames
+      fieldName = mkName ("f_" ++ nameBase fn)
+      r = pure recType
+      a = pure ft
+      x = pure $ foldr fun recType $ replaceAt ft i polyTypes
+      y = pure $ foldr fun recType $ replaceAt (ConT ''X) i polyTypes
+      mkApplicator c v = pure $ LamE argPats app
+        where
+          app = foldl' AppE (VarE c) $ map VarE $ replaceAt v i polyArgs
+          argPats = replaceAt WildP i $ map VarP polyArgs
+      -- \c x -> \a1 -> .. \_ -> .. \an -> c a1 .. x .. an
+      applicator = [|\v c -> $(mkApplicator 'c 'v)|]
+      extractor = pure $ VarE fn
+  fieldType <- ForallT fieldVars [] <$>
+    [t|Field $r $a $x $y|]
+  fieldBody <-
+    [|Field $applicator $extractor|]
+  return [ SigD fieldName fieldType, ValD (VarP fieldName) (NormalB fieldBody) [] ]
+
+genCon :: [ Name ] -> Type -> Int -> TH.Con -> Q [ Dec ]
+genCon recVars recType cc
+  = \case
+    RecC cName fields -> genCon' cName fields
+    NormalC cName [] -> genCon' cName []
+    _ -> fail "Unsupported constructor."
+  where
+    genCon' cName fields = do
+      let fieldTypes = [ ft | ( _, _, ft ) <- fields ]
+          conName = mkName ("c_" ++ nameBase cName)
+          cType = foldr fun recType fieldTypes
+          conMatch
+            | cc == 1 = [|const True|]
+            | otherwise = [|\r -> $(mkConMatch 'r)|]
+          mkConMatch r = pure $ CaseE (VarE r)
+                         [ Match (RecP cName []) (NormalB (ConE 'True)) []
+                         , Match WildP (NormalB (ConE 'False)) []
+                         ]
+          fc = length fields
+      conType <- ForallT (map PlainTV recVars) [] <$> [t|F.Con $(pure recType) $(pure cType)|]
+      conBody <- [|F.Con $(pure $ ConE cName) $conMatch|]
+      fDecs <- traverse (genField recVars recType fc) $ zip [0..] fields
+      return $
+        [ SigD conName conType
+        , ValD (VarP conName) (NormalB conBody) []
+        ] ++ concat fDecs
+
+-- | Generate `Field`s for a given data type. Currently only single-constructor records are supported.
+-- Each record field @a@ will be turned into a `Field` @f_a@, and all constructors will be turned into `Con`s.
+genFields :: Name -> Q [ Dec ]
+genFields n = reify n >>= \case
+  TyConI (DataD [] _ vs cs _) -> do
+      recVars <- for vs $ \case
+        PlainTV vn -> return vn
+        KindedTV vn k | k == starK -> return vn
+        _ -> fail "Only simple type variables supported."
+      let recType = foldl' (\t v -> AppT t (VarT v)) (ConT n) recVars
+          cc = length cs
+      concat <$> traverse (genCon recVars recType cc) cs
+  _ -> fail "Unsupported record type."
diff --git a/Data/Codec/Tuple.hs b/Data/Codec/Tuple.hs
new file mode 100644
--- /dev/null
+++ b/Data/Codec/Tuple.hs
@@ -0,0 +1,32 @@
+module Data.Codec.Tuple
+  ( Field1(..), Field2(..)
+  , c_Left, c_Right, f_left, f_right
+  ) where
+
+import Data.Either
+
+import Data.Codec.Field (Field(..), Con(..), X)
+
+class Field1 r a x y | r x -> y, r y -> x, r -> a, x y -> r where
+  f_1 :: Field r a x y
+
+instance Field1 ( a, b ) a (a -> a2 -> ( a, b )) (X -> a2 -> ( a, b )) where
+  f_1 = Field (\x c _ a2 -> c x a2) fst
+
+class Field2 r a x y | r x -> y, r y -> x, r -> a, x y -> r where
+  f_2 :: Field r a x y
+
+instance Field2 ( a, b ) b (a1 -> b -> ( a, b )) (a1 -> X -> ( a, b )) where
+  f_2 = Field (\x c a1 _ -> c a1 x) snd
+
+c_Left :: Con (Either a b) (a -> Either a b)
+c_Left = Con Left (\case { Left _ -> True; _ -> False })
+
+c_Right :: Con (Either a b) (b -> Either a b)
+c_Right = Con Right (\case { Right _ -> True; _ -> False })
+
+f_left :: Field (Either a b) a (a -> Either a b) (X -> Either a b)
+f_left = Field (\x c _ -> c x) (\(Left l) -> l)
+
+f_right :: Field (Either a b) b (b -> Either a b) (X -> Either a b)
+f_right = Field (\x c _ -> c x) (\(Right l) -> l)
diff --git a/codec.cabal b/codec.cabal
--- a/codec.cabal
+++ b/codec.cabal
@@ -1,5 +1,5 @@
 name:                codec
-version:             0.1
+version:             0.1.1
 license:             BSD3
 license-file:        LICENSE
 synopsis:            First-class record construction and bidirectional serialization
@@ -87,9 +87,12 @@
 
 library
   exposed-modules:     Data.Codec,
+                       Data.Codec.Field,
+                       Data.Codec.Codec,
+                       Data.Codec.TH,
+                       Data.Codec.Tuple,
                        Data.Codec.Testing,
 
-                       Control.Lens.Codec,
                        Data.Aeson.Codec,
                        Data.Binary.Codec,
                        Data.Binary.Bits.Codec,