diff --git a/Lens/Family/TH.hs b/Lens/Family/TH.hs
deleted file mode 100644
--- a/Lens/Family/TH.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- | Derive lenses for "Lens.Family".
--- 
--- Example usage:
--- 
--- 
--- > {-# LANGUAGE TemplateHaskell #-}
--- > 
--- > import Lens.Family
--- > import Lens.Family.TH
--- > 
--- > data Foo a = Foo { _bar :: Int, _baz :: a }
--- >            deriving (Show, Read, Eq, Ord)
--- > $(makeLenses ''Foo)
--- 
-module Lens.Family.TH (
-    makeLenses
-  , makeLensesBy
-  , makeLensesFor
-
-  , makeTraversals
-
-  , mkLenses
-  , mkLensesBy
-  , mkLensesFor
-  ) where
-
-import Language.Haskell.TH
-import Lens.Family.THCore
-
-
--- | Derive lenses for the record selectors in 
--- a single-constructor data declaration,
--- or for the record selector in a newtype declaration.
--- Lenses will only be generated for record fields which
--- are prefixed with an underscore.
--- 
--- Example usage:
--- 
--- > $(makeLenses ''Foo)
-makeLenses :: Name -> Q [Dec]
-makeLenses = makeLensesBy defaultNameTransform
-
-{-# DEPRECATED mkLenses "Use makeLenses instead." #-}
-mkLenses :: Name -> Q [Dec]
-mkLenses = makeLenses
-
-
--- | Derive lenses with the provided name transformation
--- and filtering function. Produce @Just lensName@ to generate a lens
--- of the resultant name, or @Nothing@ to not generate a lens
--- for the input record name.
--- 
--- Example usage:
--- 
--- > $(makeLensesBy (\n -> Just (n ++ "L")) ''Foo)
-makeLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
-makeLensesBy = deriveLenses deriveLensSig
-
-{-# DEPRECATED mkLensesBy "Use makeLensesBy instead." #-}
-mkLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
-mkLensesBy = makeLensesBy
-
-
--- | Derive lenses, specifying explicit pairings of @(fieldName, lensName)@.
--- 
--- Example usage:
--- 
--- > $(makeLensesFor [("_foo", "fooLens"), ("bar", "lbar")] ''Foo)
-makeLensesFor :: [(String, String)] -> Name -> Q [Dec]
-makeLensesFor fields = makeLensesBy (`lookup` fields)
-
-{-# DEPRECATED mkLensesFor "Use makeLensesFor instead." #-}
-mkLensesFor :: [(String, String)] -> Name -> Q [Dec]
-mkLensesFor = makeLensesFor
-
-
--- TODO
-deriveLensSig :: Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]
-deriveLensSig _ _ _ = return []
diff --git a/Lens/Family/THCore.hs b/Lens/Family/THCore.hs
deleted file mode 100644
--- a/Lens/Family/THCore.hs
+++ /dev/null
@@ -1,219 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- | The shared functionality behind Lens.Family.TH and Lens.Family2.TH.
-module Lens.Family.THCore (
-   defaultNameTransform
-  , LensTypeInfo
-  , ConstructorFieldInfo
-  , deriveLenses
-  , makeTraversals
-  ) where
-
-import Language.Haskell.TH
-import Control.Applicative (pure)
-import Data.Char (toLower)
-
--- | By default, if the field name begins with an underscore,
--- then the underscore will simply be removed (and the new first character
--- lowercased if necessary).
-defaultNameTransform :: String -> Maybe String
-defaultNameTransform ('_':c:rest) = Just $ toLower c : rest
-defaultNameTransform _ = Nothing
-
-
--- | Information about the larger type the lens will operate on.
-type LensTypeInfo = (Name, [TyVarBndr])
-
--- | Information about the smaller type the lens will operate on.
-type ConstructorFieldInfo = (Name, Strict, Type)
-
-
--- | The true workhorse of lens derivation. This macro is parameterized
--- by a macro that derives signatures, as well as a function that
--- filters and transforms names. Producing Nothing means that
--- a lens should not be generated for the provided name.
-deriveLenses ::
-     (Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec])
-     -- ^ the signature deriver
-  -> (String -> Maybe String)
-     -- ^ the name transformer
-  -> Name -> Q [Dec]
-deriveLenses sigDeriver nameTransform datatype = do
-  typeInfo          <- extractLensTypeInfo datatype
-  let derive1 = deriveLens sigDeriver nameTransform typeInfo
-  constructorFields <- extractConstructorFields datatype
-  concat `fmap` mapM derive1 constructorFields
-
-
-extractLensTypeInfo :: Name -> Q LensTypeInfo
-extractLensTypeInfo datatype = do
-  let datatypeStr = nameBase datatype
-  i <- reify datatype
-  return $ case i of
-    TyConI (DataD    _ n ts _ _ _) -> (n, ts)
-    TyConI (NewtypeD _ n ts _ _ _) -> (n, ts)
-    _ -> error $ "Can't derive Lens for: "  ++ datatypeStr
-              ++ ", type name required."
-
-
-extractConstructorFields :: Name -> Q [ConstructorFieldInfo]
-extractConstructorFields datatype = do
-  let datatypeStr = nameBase datatype
-  i <- reify datatype
-  return $ case i of
-    TyConI (DataD    _ _ _ _ [RecC _ fs] _) -> fs
-    TyConI (NewtypeD _ _ _ _ (RecC _ fs) _) -> fs
-    TyConI (DataD    _ _ _ _ [_]         _) ->
-      error $ "Can't derive Lens without record selectors: " ++ datatypeStr
-    TyConI NewtypeD{} ->
-      error $ "Can't derive Lens without record selectors: " ++ datatypeStr
-    TyConI TySynD{} ->
-      error $ "Can't derive Lens for type synonym: " ++ datatypeStr
-    TyConI DataD{} ->
-      error $ "Can't derive Lens for tagged union: " ++ datatypeStr
-    _ ->
-      error $ "Can't derive Lens for: "  ++ datatypeStr
-           ++ ", type name required."
-
-
--- Derive a lens for the given record selector
--- using the given name transformation function.
-deriveLens :: (Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec])
-           -> (String -> Maybe String)
-           -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]
-deriveLens sigDeriver nameTransform ty field = do
-  let (fieldName, _fieldStrict, _fieldType) = field
-      (_tyName, _tyVars) = ty  -- just to clarify what's here
-  case nameTransform (nameBase fieldName) of
-    Nothing       -> return []
-    Just lensNameStr -> do
-      let lensName = mkName lensNameStr
-      sig  <- sigDeriver lensName ty field
-      body <- deriveLensBody lensName fieldName
-      return $ sig ++ [body]
-
-
--- Given a record field name,
--- produces a single function declaration:
--- lensName f a = (\x -> a { field = x }) `fmap` f (field a)
-deriveLensBody :: Name -> Name -> Q Dec
-deriveLensBody lensName fieldName = funD lensName [defLine]
-  where
-    a = mkName "a"
-    f = mkName "f"
-    defLine = clause pats (normalB body) []
-    pats = [varP f, varP a]
-    body = [| (\x -> $(record a fieldName [|x|]))
-              `fmap` $(appE (varE f) (appE (varE fieldName) (varE a)))
-            |]
-    record rec fld val = val >>= \v -> recUpdE (varE rec) [return (fld, v)]
-
--- | Derive traversals for each constructor in
--- a data or newtype declaration,
--- Traversals will be named by prefixing the
--- constructor name with an underscore.
---
--- Example usage:
---
--- > $(makeTraversals ''Foo)
-makeTraversals :: Name -> Q [Dec]
-makeTraversals = deriveTraversals (\s -> Just ('_':s))
-
-deriveTraversals :: (String -> Maybe String) -> Name -> Q [Dec]
-deriveTraversals nameTransform name = do
-  typeInfo <- extractLensTypeInfo name
-  constructors <- extractConstructorInfo name
-  let derive1 = deriveTraversal nameTransform typeInfo constructors
-  concat `fmap` mapM derive1 constructors
-
-
-extractConstructorInfo :: Name -> Q [Con]
-extractConstructorInfo datatype = do
-  let datatypeStr = nameBase datatype
-  i <- reify datatype
-  return $ case i of
-    TyConI (DataD    _ _ _ _ fs _) -> fs
-    TyConI (NewtypeD _ _ _ _ f  _) -> [f]
-    _ -> error $ "Can't derive traversal for: " ++ datatypeStr
-
-
-deriveTraversal :: (String -> Maybe String) -> LensTypeInfo -> [Con] -> Con -> Q [Dec]
-deriveTraversal nameTransform ty cs con = do
-  let (tyName, _tyVars) = ty
-      (conN, nArgs) = getConInfo con
-  case nameTransform (nameBase conN) of
-    Nothing       -> return []
-    Just lensNameStr -> do
-      let lensName = mkName lensNameStr
-      sig  <- return [] -- TODO
-      body <- deriveTraversalBody lensName conN nArgs cs
-      return $ sig ++ [body]
-
-
-deconstructReconstruct :: Con -> String -> (Pat, Exp)
-deconstructReconstruct c nameBase = (pat, expr) where
-  pat = ConP conN (map VarP argNames)
-  expr = foldl AppE (ConE conN) (map VarE argNames)
-  (conN, nArgs) = getConInfo c
-  argNames = mkArgNames nArgs nameBase
-
-getConInfo :: Con -> (Name, Int)
-getConInfo con = case con of
-  NormalC n tys -> (n, length tys)
-  RecC n tys -> (n, length tys)
-  InfixC t1 n t2 -> (n, 2)
-  ForallC _ _ c
-    -> error $ "Traversal derivation not supported: "
-       ++ "forall'd constructor: " ++ nameBase (fst $ getConInfo c)
-
-deriveTraversalBody :: Name -> Name -> Int -> [Con] -> Q Dec
-deriveTraversalBody lensName constructorName nArgs cs =
-  funD lensName (defLine:fallbacks) where
-    argNames = mkArgNames nArgs "x"
-    newArgNames = mkArgNames nArgs "x'"
-    argTup = argTupFrom argNames
-    newArgPat = TildeP $ argPatFrom newArgNames
-    newArgVars = argVarsFrom newArgNames
-    t = mkName "t"
-    k = mkName "k"
-    constructorUncurried =
-      constructorUncurriedFrom constructorName newArgPat newArgVars
-    kApplied = AppE (VarE k) argTup
-    defLine = clause defPats (normalB defBody) []
-    defPats = [varP k, conP constructorName (map varP argNames)]
-    defBody = [| $(return constructorUncurried)
-                 `fmap` $(return kApplied)
-               |]
-    fallbacks = map fallbackFor $ filter (\c -> fst (getConInfo c) /= constructorName) cs
-    fallbackFor con = clause fallbackPats (normalB fallbackBody) [] where
-      (conPat, conApp) = deconstructReconstruct con "a"
-      fallbackPats = [wildP, pure conPat]
-      fallbackBody = [| pure $(pure conApp) |]
-
-constructorUncurriedFrom :: Name -> Pat -> [Exp] -> Exp
-constructorUncurriedFrom conN pat = LamE [pat] . mkBody where
-  mkBody = foldl AppE (ConE conN)
-
-unitPat :: Pat
-unitPat = TupP []
-
-unitExp :: Exp
-unitExp = TupE []
-
-argPatFrom :: [Name] -> Pat
-argPatFrom [] = unitPat
-argPatFrom [x] = VarP x
-argPatFrom xs = TupP (map VarP xs)
-
-argTupFrom :: [Name] -> Exp
-argTupFrom [] = unitExp
-argTupFrom [x] = VarE x
-argTupFrom xs = TupE (map VarE xs)
-
-argVarsFrom :: [Name] -> [Exp]
-argVarsFrom = map VarE
-
-mkArgNames :: Int -> String -> [Name]
-mkArgNames nArgs base = take nArgs . map toName $ [1 :: Int ..] where
-  toName 1 = mkName base
-  toName n = mkName (base ++ show n)
diff --git a/Lens/Family2/TH.hs b/Lens/Family2/TH.hs
deleted file mode 100644
--- a/Lens/Family2/TH.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# LANGUAGE TemplateHaskell, Rank2Types #-}
-
--- | Derive lenses for "Lens.Family2".
--- 
--- Example usage:
--- 
--- 
--- > {-# LANGUAGE TemplateHaskell, Rank2Types #-}
--- > 
--- > import Lens.Family2
--- > import Lens.Family2.TH
--- > 
--- > data Foo a = Foo { _bar :: Int, _baz :: a }
--- >            deriving (Show, Read, Eq, Ord)
--- > $(makeLenses ''Foo)
--- 
-module Lens.Family2.TH (
-    makeLenses
-  , makeLensesBy
-  , makeLensesFor
-
-  , makeTraversals
-
-  , mkLenses
-  , mkLensesBy
-  , mkLensesFor
-  ) where
-
-import Language.Haskell.TH
-import Lens.Family.THCore
-
-
--- | Derive lenses for the record selectors in 
--- a single-constructor data declaration,
--- or for the record selector in a newtype declaration.
--- Lenses will only be generated for record fields which
--- are prefixed with an underscore.
--- 
--- Example usage:
--- 
--- > $(makeLenses ''Foo)
-makeLenses :: Name -> Q [Dec]
-makeLenses = makeLensesBy defaultNameTransform
-
-{-# DEPRECATED mkLenses "Use makeLenses instead." #-}
-mkLenses :: Name -> Q [Dec]
-mkLenses = makeLenses
-
-
--- | Derive lenses with the provided name transformation
--- and filtering function. Produce @Just lensName@ to generate a lens
--- of the resultant name, or @Nothing@ to not generate a lens
--- for the input record name.
--- 
--- Example usage:
--- 
--- > $(makeLensesBy (\n -> Just (n ++ "L")) ''Foo)
-makeLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
-makeLensesBy = deriveLenses deriveLensSig
-
-{-# DEPRECATED mkLensesBy "Use makeLensesBy instead." #-}
-mkLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
-mkLensesBy = makeLensesBy
-
-
--- | Derive lenses, specifying explicit pairings of @(fieldName, lensName)@.
--- 
--- Example usage:
--- 
--- > $(makeLensesFor [("_foo", "fooLens"), ("bar", "lbar")] ''Foo)
-makeLensesFor :: [(String, String)] -> Name -> Q [Dec]
-makeLensesFor fields = makeLensesBy (`lookup` fields)
-
-{-# DEPRECATED mkLensesFor "Use makeLensesFor instead." #-}
-mkLensesFor :: [(String, String)] -> Name -> Q [Dec]
-mkLensesFor = makeLensesFor
-
-
--- TODO
-deriveLensSig :: Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]
-deriveLensSig _ _ _ = return []
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,58 @@
+lens-family-th
+==============
+
+![build status](https://api.travis-ci.org/DanBurton/lens-family-th.svg?branch=master)
+
+Template Haskell to generate lenses for lens-family and lens-family-core.
+
+Usage:
+
+    {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+
+    import Lens.Family2
+    import Lens.Family2.TH
+
+    data Foo a = Foo { _bar :: Int, _baz :: a }
+             deriving (Show, Read, Eq, Ord)
+    $(makeLenses ''Foo)
+
+This will create lenses `bar` and `baz`.
+
+You can instead create these lenses by hand
+as explained by documentation at [Lens.Family.Unchecked](http://hackage.haskell.org/packages/archive/lens-family-core/latest/doc/html/Lens-Family-Unchecked.html).
+
+`makeLenses` merely generates the following definition
+for each field, making use of Haskell's record update syntax:
+
+    lensName f a = (\x -> a { fieldName = x }) `fmap` f (fieldName a)
+
+`makeLenses` will refuse to create lenses for data declarations
+with more than 1 constructor.
+
+----
+
+For data types with multiple constructors,
+you can use `makeTraversals`. For example:
+
+    {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+
+    import Lens.Family2
+    import Lens.Family2.TH
+
+    data T a c d = A a | B | CD c d Int
+    $(makeTraversals ''T)
+    
+Will create traversals `_A`, `_B`, and `_C` in this fashion:
+
+    _A k (A a) = fmap (\a -> A a) (k a)
+    _A _  B    = pure B
+    _A _ (C c d i) = pure (C c d i)
+
+    _B _ (A a) = pure (A a)
+    _B k B = fmap (\() -> B) (k ())
+    _B _ (C c d i) = pure (C c d i)
+    
+    _C _ (A a) = pure (A a)
+    _C _ B = pure B
+    _C k (C c d i) = fmap (\(c',d',i') -> C c' d' i') (k (c,d,i))
+    
diff --git a/examples/test.lhs b/examples/test.lhs
new file mode 100644
--- /dev/null
+++ b/examples/test.lhs
@@ -0,0 +1,23 @@
+To see the results of these ghci interactions on your own machine, run:
+
+    [bash]
+    BlogLiterately -g examples/test.lhs > test.html && firefox test.html
+
+> {-# LANGUAGE TemplateHaskell #-}
+
+> import Lens.Family2
+> import Lens.Family2.TH
+
+> data Pair a b = Pair { _pairL :: a, _pairR :: b }
+>               deriving (Eq, Show, Read, Ord)
+> $(makeLenses ''Pair)
+
+    [ghci]
+    let p = Pair '1' 1 :: Pair Char Int
+    p ^. pairL
+    p ^. pairR
+    :m +Data.Char
+    (pairL %~ digitToInt) p
+    (pairR %~ intToDigit) p
+    (pairL .~ "foo") p
+    (pairR .~ "bar") p
diff --git a/examples/traversal-test.lhs b/examples/traversal-test.lhs
new file mode 100644
--- /dev/null
+++ b/examples/traversal-test.lhs
@@ -0,0 +1,23 @@
+To verify the results of these ghci interactions on your own machine, run:
+
+    [bash]
+    BlogLiterately -g examples/traversal-test.lhs > test.html && firefox test.html
+
+(Make sure you have the lens-family package installed.)
+
+> {-# LANGUAGE TemplateHaskell #-}
+
+> import Lens.Family2
+> import Lens.Family2.TH
+
+> data Opt b c d = A | B b | CD c d Int
+>                deriving (Eq, Show, Read, Ord)
+> $(makeTraversals ''Opt)
+
+    [ghci]
+    _B %~ (+1) $ A
+      A
+    _B %~ (+1) $ B 3
+      B 4
+    _B %~ (+1) $ CD 3 4 5
+      CD 3 4 5
diff --git a/lens-family-th.cabal b/lens-family-th.cabal
--- a/lens-family-th.cabal
+++ b/lens-family-th.cabal
@@ -1,5 +1,5 @@
 name:                lens-family-th
-version:             0.5.0.0
+version:             0.5.0.1
 synopsis:            Generate lens-family style lenses
 
 description:
@@ -14,21 +14,37 @@
 license:             BSD3
 license-file:        LICENSE
 author:              Dan Burton
-copyright:           (c) Dan Burton 2012-2016
+copyright:           (c) Dan Burton 2012-2017
 
 homepage:            http://github.com/DanBurton/lens-family-th#readme
 bug-reports:         http://github.com/DanBurton/lens-family-th/issues
 maintainer:          danburton.email@gmail.com
 
-
 category:            Data
 build-type:          Simple
 cabal-version:       >=1.8
 
+extra-source-files:  README.md
+                   , stack.yaml
+                   , examples/*.lhs
+
 library
-  exposed-modules:     Lens.Family.TH, Lens.Family2.TH, Lens.Family.THCore
-  build-depends:       base ==4.9.*, template-haskell == 2.11.*
+  hs-source-dirs:    src
+  exposed-modules:   Lens.Family.TH
+                   , Lens.Family2.TH
+                   , Lens.Family.THCore
+  build-depends:     base >= 4.9 && < 4.11
+                   , template-haskell >= 2.11 && < 2.13
 
+test-suite lens-family-th-test
+  type:              exitcode-stdio-1.0
+  hs-source-dirs:    test
+  main-is:           Test.hs
+  build-depends:     base
+                   , hspec
+                   , lens-family
+                   , lens-family-th
+                   , template-haskell
 
 source-repository head
   type:      git
@@ -37,4 +53,4 @@
 source-repository this
   type:      git
   location:  git://github.com/DanBurton/lens-family-th.git
-  tag:       lens-family-th-0.5.0.0
+  tag:       lens-family-th-0.5.0.1
diff --git a/src/Lens/Family/TH.hs b/src/Lens/Family/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Lens/Family/TH.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Derive lenses for "Lens.Family".
+-- 
+-- Example usage:
+-- 
+-- 
+-- > {-# LANGUAGE TemplateHaskell #-}
+-- > 
+-- > import Lens.Family
+-- > import Lens.Family.TH
+-- > 
+-- > data Foo a = Foo { _bar :: Int, _baz :: a }
+-- >            deriving (Show, Read, Eq, Ord)
+-- > $(makeLenses ''Foo)
+-- 
+module Lens.Family.TH (
+    makeLenses
+  , makeLensesBy
+  , makeLensesFor
+
+  , makeTraversals
+
+  , mkLenses
+  , mkLensesBy
+  , mkLensesFor
+  ) where
+
+import Language.Haskell.TH
+import Lens.Family.THCore
+
+
+-- | Derive lenses for the record selectors in 
+-- a single-constructor data declaration,
+-- or for the record selector in a newtype declaration.
+-- Lenses will only be generated for record fields which
+-- are prefixed with an underscore.
+-- 
+-- Example usage:
+-- 
+-- > $(makeLenses ''Foo)
+makeLenses :: Name -> Q [Dec]
+makeLenses = makeLensesBy defaultNameTransform
+
+{-# DEPRECATED mkLenses "Use makeLenses instead." #-}
+mkLenses :: Name -> Q [Dec]
+mkLenses = makeLenses
+
+
+-- | Derive lenses with the provided name transformation
+-- and filtering function. Produce @Just lensName@ to generate a lens
+-- of the resultant name, or @Nothing@ to not generate a lens
+-- for the input record name.
+-- 
+-- Example usage:
+-- 
+-- > $(makeLensesBy (\n -> Just (n ++ "L")) ''Foo)
+makeLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
+makeLensesBy = deriveLenses deriveLensSig
+
+{-# DEPRECATED mkLensesBy "Use makeLensesBy instead." #-}
+mkLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
+mkLensesBy = makeLensesBy
+
+
+-- | Derive lenses, specifying explicit pairings of @(fieldName, lensName)@.
+-- 
+-- Example usage:
+-- 
+-- > $(makeLensesFor [("_foo", "fooLens"), ("bar", "lbar")] ''Foo)
+makeLensesFor :: [(String, String)] -> Name -> Q [Dec]
+makeLensesFor fields = makeLensesBy (`lookup` fields)
+
+{-# DEPRECATED mkLensesFor "Use makeLensesFor instead." #-}
+mkLensesFor :: [(String, String)] -> Name -> Q [Dec]
+mkLensesFor = makeLensesFor
+
+
+-- TODO
+deriveLensSig :: Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]
+deriveLensSig _ _ _ = return []
diff --git a/src/Lens/Family/THCore.hs b/src/Lens/Family/THCore.hs
new file mode 100644
--- /dev/null
+++ b/src/Lens/Family/THCore.hs
@@ -0,0 +1,219 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | The shared functionality behind Lens.Family.TH and Lens.Family2.TH.
+module Lens.Family.THCore (
+   defaultNameTransform
+  , LensTypeInfo
+  , ConstructorFieldInfo
+  , deriveLenses
+  , makeTraversals
+  ) where
+
+import Language.Haskell.TH
+import Control.Applicative (pure)
+import Data.Char (toLower)
+
+-- | By default, if the field name begins with an underscore,
+-- then the underscore will simply be removed (and the new first character
+-- lowercased if necessary).
+defaultNameTransform :: String -> Maybe String
+defaultNameTransform ('_':c:rest) = Just $ toLower c : rest
+defaultNameTransform _ = Nothing
+
+
+-- | Information about the larger type the lens will operate on.
+type LensTypeInfo = (Name, [TyVarBndr])
+
+-- | Information about the smaller type the lens will operate on.
+type ConstructorFieldInfo = (Name, Strict, Type)
+
+
+-- | The true workhorse of lens derivation. This macro is parameterized
+-- by a macro that derives signatures, as well as a function that
+-- filters and transforms names. Producing Nothing means that
+-- a lens should not be generated for the provided name.
+deriveLenses ::
+     (Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec])
+     -- ^ the signature deriver
+  -> (String -> Maybe String)
+     -- ^ the name transformer
+  -> Name -> Q [Dec]
+deriveLenses sigDeriver nameTransform datatype = do
+  typeInfo          <- extractLensTypeInfo datatype
+  let derive1 = deriveLens sigDeriver nameTransform typeInfo
+  constructorFields <- extractConstructorFields datatype
+  concat `fmap` mapM derive1 constructorFields
+
+
+extractLensTypeInfo :: Name -> Q LensTypeInfo
+extractLensTypeInfo datatype = do
+  let datatypeStr = nameBase datatype
+  i <- reify datatype
+  return $ case i of
+    TyConI (DataD    _ n ts _ _ _) -> (n, ts)
+    TyConI (NewtypeD _ n ts _ _ _) -> (n, ts)
+    _ -> error $ "Can't derive Lens for: "  ++ datatypeStr
+              ++ ", type name required."
+
+
+extractConstructorFields :: Name -> Q [ConstructorFieldInfo]
+extractConstructorFields datatype = do
+  let datatypeStr = nameBase datatype
+  i <- reify datatype
+  return $ case i of
+    TyConI (DataD    _ _ _ _ [RecC _ fs] _) -> fs
+    TyConI (NewtypeD _ _ _ _ (RecC _ fs) _) -> fs
+    TyConI (DataD    _ _ _ _ [_]         _) ->
+      error $ "Can't derive Lens without record selectors: " ++ datatypeStr
+    TyConI NewtypeD{} ->
+      error $ "Can't derive Lens without record selectors: " ++ datatypeStr
+    TyConI TySynD{} ->
+      error $ "Can't derive Lens for type synonym: " ++ datatypeStr
+    TyConI DataD{} ->
+      error $ "Can't derive Lens for tagged union: " ++ datatypeStr
+    _ ->
+      error $ "Can't derive Lens for: "  ++ datatypeStr
+           ++ ", type name required."
+
+
+-- Derive a lens for the given record selector
+-- using the given name transformation function.
+deriveLens :: (Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec])
+           -> (String -> Maybe String)
+           -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]
+deriveLens sigDeriver nameTransform ty field = do
+  let (fieldName, _fieldStrict, _fieldType) = field
+      (_tyName, _tyVars) = ty  -- just to clarify what's here
+  case nameTransform (nameBase fieldName) of
+    Nothing       -> return []
+    Just lensNameStr -> do
+      let lensName = mkName lensNameStr
+      sig  <- sigDeriver lensName ty field
+      body <- deriveLensBody lensName fieldName
+      return $ sig ++ [body]
+
+
+-- Given a record field name,
+-- produces a single function declaration:
+-- lensName f a = (\x -> a { field = x }) `fmap` f (field a)
+deriveLensBody :: Name -> Name -> Q Dec
+deriveLensBody lensName fieldName = funD lensName [defLine]
+  where
+    a = mkName "a"
+    f = mkName "f"
+    defLine = clause pats (normalB body) []
+    pats = [varP f, varP a]
+    body = [| (\x -> $(record a fieldName [|x|]))
+              `fmap` $(appE (varE f) (appE (varE fieldName) (varE a)))
+            |]
+    record rec fld val = val >>= \v -> recUpdE (varE rec) [return (fld, v)]
+
+-- | Derive traversals for each constructor in
+-- a data or newtype declaration,
+-- Traversals will be named by prefixing the
+-- constructor name with an underscore.
+--
+-- Example usage:
+--
+-- > $(makeTraversals ''Foo)
+makeTraversals :: Name -> Q [Dec]
+makeTraversals = deriveTraversals (\s -> Just ('_':s))
+
+deriveTraversals :: (String -> Maybe String) -> Name -> Q [Dec]
+deriveTraversals nameTransform name = do
+  typeInfo <- extractLensTypeInfo name
+  constructors <- extractConstructorInfo name
+  let derive1 = deriveTraversal nameTransform typeInfo constructors
+  concat `fmap` mapM derive1 constructors
+
+
+extractConstructorInfo :: Name -> Q [Con]
+extractConstructorInfo datatype = do
+  let datatypeStr = nameBase datatype
+  i <- reify datatype
+  return $ case i of
+    TyConI (DataD    _ _ _ _ fs _) -> fs
+    TyConI (NewtypeD _ _ _ _ f  _) -> [f]
+    _ -> error $ "Can't derive traversal for: " ++ datatypeStr
+
+
+deriveTraversal :: (String -> Maybe String) -> LensTypeInfo -> [Con] -> Con -> Q [Dec]
+deriveTraversal nameTransform ty cs con = do
+  let (tyName, _tyVars) = ty
+      (conN, nArgs) = getConInfo con
+  case nameTransform (nameBase conN) of
+    Nothing       -> return []
+    Just lensNameStr -> do
+      let lensName = mkName lensNameStr
+      sig  <- return [] -- TODO
+      body <- deriveTraversalBody lensName conN nArgs cs
+      return $ sig ++ [body]
+
+
+deconstructReconstruct :: Con -> String -> (Pat, Exp)
+deconstructReconstruct c nameBase = (pat, expr) where
+  pat = ConP conN (map VarP argNames)
+  expr = foldl AppE (ConE conN) (map VarE argNames)
+  (conN, nArgs) = getConInfo c
+  argNames = mkArgNames nArgs nameBase
+
+getConInfo :: Con -> (Name, Int)
+getConInfo con = case con of
+  NormalC n tys -> (n, length tys)
+  RecC n tys -> (n, length tys)
+  InfixC t1 n t2 -> (n, 2)
+  ForallC _ _ c
+    -> error $ "Traversal derivation not supported: "
+       ++ "forall'd constructor: " ++ nameBase (fst $ getConInfo c)
+
+deriveTraversalBody :: Name -> Name -> Int -> [Con] -> Q Dec
+deriveTraversalBody lensName constructorName nArgs cs =
+  funD lensName (defLine:fallbacks) where
+    argNames = mkArgNames nArgs "x"
+    newArgNames = mkArgNames nArgs "x'"
+    argTup = argTupFrom argNames
+    newArgPat = TildeP $ argPatFrom newArgNames
+    newArgVars = argVarsFrom newArgNames
+    t = mkName "t"
+    k = mkName "k"
+    constructorUncurried =
+      constructorUncurriedFrom constructorName newArgPat newArgVars
+    kApplied = AppE (VarE k) argTup
+    defLine = clause defPats (normalB defBody) []
+    defPats = [varP k, conP constructorName (map varP argNames)]
+    defBody = [| $(return constructorUncurried)
+                 `fmap` $(return kApplied)
+               |]
+    fallbacks = map fallbackFor $ filter (\c -> fst (getConInfo c) /= constructorName) cs
+    fallbackFor con = clause fallbackPats (normalB fallbackBody) [] where
+      (conPat, conApp) = deconstructReconstruct con "a"
+      fallbackPats = [wildP, pure conPat]
+      fallbackBody = [| pure $(pure conApp) |]
+
+constructorUncurriedFrom :: Name -> Pat -> [Exp] -> Exp
+constructorUncurriedFrom conN pat = LamE [pat] . mkBody where
+  mkBody = foldl AppE (ConE conN)
+
+unitPat :: Pat
+unitPat = TupP []
+
+unitExp :: Exp
+unitExp = TupE []
+
+argPatFrom :: [Name] -> Pat
+argPatFrom [] = unitPat
+argPatFrom [x] = VarP x
+argPatFrom xs = TupP (map VarP xs)
+
+argTupFrom :: [Name] -> Exp
+argTupFrom [] = unitExp
+argTupFrom [x] = VarE x
+argTupFrom xs = TupE (map VarE xs)
+
+argVarsFrom :: [Name] -> [Exp]
+argVarsFrom = map VarE
+
+mkArgNames :: Int -> String -> [Name]
+mkArgNames nArgs base = take nArgs . map toName $ [1 :: Int ..] where
+  toName 1 = mkName base
+  toName n = mkName (base ++ show n)
diff --git a/src/Lens/Family2/TH.hs b/src/Lens/Family2/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Lens/Family2/TH.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE TemplateHaskell, Rank2Types #-}
+
+-- | Derive lenses for "Lens.Family2".
+-- 
+-- Example usage:
+-- 
+-- 
+-- > {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+-- > 
+-- > import Lens.Family2
+-- > import Lens.Family2.TH
+-- > 
+-- > data Foo a = Foo { _bar :: Int, _baz :: a }
+-- >            deriving (Show, Read, Eq, Ord)
+-- > $(makeLenses ''Foo)
+-- 
+module Lens.Family2.TH (
+    makeLenses
+  , makeLensesBy
+  , makeLensesFor
+
+  , makeTraversals
+
+  , mkLenses
+  , mkLensesBy
+  , mkLensesFor
+  ) where
+
+import Language.Haskell.TH
+import Lens.Family.THCore
+
+
+-- | Derive lenses for the record selectors in 
+-- a single-constructor data declaration,
+-- or for the record selector in a newtype declaration.
+-- Lenses will only be generated for record fields which
+-- are prefixed with an underscore.
+-- 
+-- Example usage:
+-- 
+-- > $(makeLenses ''Foo)
+makeLenses :: Name -> Q [Dec]
+makeLenses = makeLensesBy defaultNameTransform
+
+{-# DEPRECATED mkLenses "Use makeLenses instead." #-}
+mkLenses :: Name -> Q [Dec]
+mkLenses = makeLenses
+
+
+-- | Derive lenses with the provided name transformation
+-- and filtering function. Produce @Just lensName@ to generate a lens
+-- of the resultant name, or @Nothing@ to not generate a lens
+-- for the input record name.
+-- 
+-- Example usage:
+-- 
+-- > $(makeLensesBy (\n -> Just (n ++ "L")) ''Foo)
+makeLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
+makeLensesBy = deriveLenses deriveLensSig
+
+{-# DEPRECATED mkLensesBy "Use makeLensesBy instead." #-}
+mkLensesBy :: (String -> Maybe String) -> Name -> Q [Dec]
+mkLensesBy = makeLensesBy
+
+
+-- | Derive lenses, specifying explicit pairings of @(fieldName, lensName)@.
+-- 
+-- Example usage:
+-- 
+-- > $(makeLensesFor [("_foo", "fooLens"), ("bar", "lbar")] ''Foo)
+makeLensesFor :: [(String, String)] -> Name -> Q [Dec]
+makeLensesFor fields = makeLensesBy (`lookup` fields)
+
+{-# DEPRECATED mkLensesFor "Use makeLensesFor instead." #-}
+mkLensesFor :: [(String, String)] -> Name -> Q [Dec]
+mkLensesFor = makeLensesFor
+
+
+-- TODO
+deriveLensSig :: Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]
+deriveLensSig _ _ _ = return []
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,4 @@
+# http://docs.haskellstack.org/en/stable/yaml_configuration/
+resolver: nightly-2017-07-31
+packages:
+- '.'
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+import qualified Data.Char as Char
+import Lens.Family2 ((^.), (%~), (.~))
+import qualified Lens.Family2.TH as LFTH
+
+import Test.Hspec (hspec, describe, it, shouldBe)
+
+data Pair a b = Pair { _pairL :: a, _pairR :: b }
+              deriving (Eq, Show, Read, Ord)
+$(LFTH.makeLenses ''Pair)
+
+data Opt b c d = A | B b | CD c d Int
+               deriving (Eq, Show, Read, Ord)
+$(LFTH.makeTraversals ''Opt)
+
+type OptInts = Opt Int Int Int
+
+p :: Pair Char Int
+p = Pair '1' 1
+
+main = hspec $ do
+  describe "makeLenses" $ do
+    it "makes lenses that function with lens-family operators" $ do
+      (p ^. pairL) `shouldBe` '1'
+      (p ^. pairR) `shouldBe` (1 :: Int)
+      ((pairL %~ Char.digitToInt) p) `shouldBe` (Pair 1 1 :: Pair Int Int)
+      ((pairR %~ Char.intToDigit) p) `shouldBe` Pair '1' '1'
+      ((pairL .~ "foo") p) `shouldBe` Pair "foo" (1 :: Int)
+      ((pairR .~ "bar") p) `shouldBe` Pair '1' "bar"
+  describe "makeTraversals" $ do
+    it "makes traversals that function with lens-family operators" $ do
+      (_B %~ (+ (1 :: Int)) $ (A :: OptInts)) `shouldBe` (A :: OptInts)
+      (_B %~ (+ (1 :: Int)) $ (B 3 :: OptInts)) `shouldBe` (B 4 :: OptInts)
+      (_B %~ (+ (1 :: Int)) $ (CD 3 4 5 :: OptInts))
+        `shouldBe`  (CD 3 4 5 :: OptInts)