diff --git a/Lens/Family/TH.hs b/Lens/Family/TH.hs
--- a/Lens/Family/TH.hs
+++ b/Lens/Family/TH.hs
@@ -38,7 +38,7 @@
 -- 
 -- Example usage:
 -- 
--- $(makeLenses ''Foo)
+-- > $(makeLenses ''Foo)
 makeLenses :: Name -> Q [Dec]
 makeLenses = makeLensesBy defaultNameTransform
 
diff --git a/Lens/Family/THCore.hs b/Lens/Family/THCore.hs
--- a/Lens/Family/THCore.hs
+++ b/Lens/Family/THCore.hs
@@ -108,14 +108,22 @@
             |]
     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
-  let derive1 = deriveTraversal nameTransform typeInfo
   constructors <- extractConstructorInfo name
+  let derive1 = deriveTraversal nameTransform typeInfo constructors
   concat `fmap` mapM derive1 constructors
 
 
@@ -124,34 +132,43 @@
   let datatypeStr = nameBase datatype
   i <- reify datatype
   return $ case i of
-    TyConI (DataD    _ _ _ [] _) -> []
     TyConI (DataD    _ _ _ fs _) -> fs
     TyConI (NewtypeD _ _ _ f  _) -> [f]
     _ -> error $ "Can't derive traversal for: " ++ datatypeStr
 
 
-deriveTraversal :: (String -> Maybe String) -> LensTypeInfo -> Con -> Q [Dec]
-deriveTraversal nameTransform ty con = do
+deriveTraversal :: (String -> Maybe String) -> LensTypeInfo -> [Con] -> Con -> Q [Dec]
+deriveTraversal nameTransform ty cs con = do
   let (tyName, _tyVars) = ty
-      (cName, cTys) = case con of
-        NormalC n tys -> (n, tys)
-        RecC n tys -> (n, map (\(_n, s, t) -> (s, t)) tys)
-        InfixC t1 n t2 -> (n, [t1, t2])
-        ForallC _ _ _
-          -> error $ "Traversal derivation not supported: "
-             ++ "forall'd constructor in: " ++ nameBase tyName
-  case nameTransform (nameBase cName) of
+      (conN, nArgs) = getConInfo con
+  case nameTransform (nameBase conN) of
     Nothing       -> return []
     Just lensNameStr -> do
       let lensName = mkName lensNameStr
       sig  <- return [] -- TODO
-      body <- deriveTraversalBody lensName cName (length cTys)
+      body <- deriveTraversalBody lensName conN nArgs cs
       return $ sig ++ [body]
 
 
-deriveTraversalBody :: Name -> Name -> Int -> Q Dec
-deriveTraversalBody lensName constructorName nArgs =
-  funD lensName [defLine, fallback] where
+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
@@ -167,9 +184,11 @@
     defBody = [| $(return constructorUncurried)
                  `fmap` $(return kApplied)
                |]
-    fallback = clause fallbackPats (normalB fallbackBody) []
-    fallbackPats = [wildP, varP t]
-    fallbackBody = [| pure $(varE t) |]
+    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
diff --git a/Lens/Family2/TH.hs b/Lens/Family2/TH.hs
--- a/Lens/Family2/TH.hs
+++ b/Lens/Family2/TH.hs
@@ -38,7 +38,7 @@
 -- 
 -- Example usage:
 -- 
--- $(makeLenses ''Foo)
+-- > $(makeLenses ''Foo)
 makeLenses :: Name -> Q [Dec]
 makeLenses = makeLensesBy defaultNameTransform
 
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.4.0.0
+version:             0.4.1.0
 synopsis:            Generate lens-family style lenses
 
 description:
@@ -14,7 +14,7 @@
 license:             BSD3
 license-file:        LICENSE
 author:              Dan Burton
-copyright:           (c) Dan Burton 2012-2014
+copyright:           (c) Dan Burton 2012-2015
 
 homepage:            http://github.com/DanBurton/lens-family-th#readme
 bug-reports:         http://github.com/DanBurton/lens-family-th/issues
@@ -37,4 +37,4 @@
 source-repository this
   type:      git
   location:  git://github.com/DanBurton/lens-family-th.git
-  tag:       lens-family-th-0.4.0.0
+  tag:       lens-family-th-0.4.1.0