diff --git a/Data/Lens/TH.hs b/Data/Lens/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/Lens/TH.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE ViewPatterns, TemplateHaskell #-}
+
+module Data.Lens.TH (mkLens) where
+
+import Prelude hiding (concat, concatMap, foldr, foldl, foldl1)
+
+import Control.Applicative
+import Control.Arrow
+import Control.Category.Unicode
+import Control.Monad
+import Data.Bool (bool)
+import Data.Function (on)
+import Data.Lens
+import qualified Data.List as List
+import Data.Maybe
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Ord.Unicode
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Monoid
+import Data.Foldable
+import Data.Foldable.Unicode
+import Data.Traversable
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+reifyTyConDec :: Name -> Q ([TyVarBndr], [Con])
+reifyTyConDec =
+    fmap (\ case TyConI (DataD    _ _ bs cs _) -> (bs, cs)
+                 TyConI (NewtypeD _ _ bs c  _) -> (bs, [c])
+                 _ -> error "name of no simple type constructor") ∘ reify
+
+mkLens :: ([Char] -> [Char]) -> Name -> Q [Dec]
+mkLens name v0 =
+    reifyTyConDec v0 >>= \ (bs@(fmap binderName -> vs0), cs) ->
+    let labels :: [((Name, Type), [Name])]
+        labels =
+          (factorizeL ∘
+           concatMap
+           (\ case RecC v (fmap (\ (v, _, t) -> (v, t)) -> vts) -> flip (,) v <$> vts
+                   _ -> [])) cs
+
+        goT :: ((Name, Type), [Name]) -> Q Type
+        goT ((v, t), us) =
+          (\ vm ->
+           ForallT (liftA2 List.union id (fmap (/. vm)) bs) [] $
+           foldl1 AppT [ConT ''Data.Lens.Lens,
+                        foldl AppT (ConT v0) (VarT <$> vs0),
+                        foldl AppT (ConT v0) (VarT <$> (vs0 /. vm)),
+                        t, t /. vm]) <$>
+           foldrM (\ v m -> flip (Map.insert v) m <$> newName (nameBase v)) Map.empty
+           (Set.filter
+            (\ v ->
+             -- can not make lens polymorphic in type variable shared between multiple labels
+             (≤ 1) ∘ length $ List.filter (fst & snd & freeTypeVars & (v ∈)) labels) (freeTypeVars t))
+
+        goX :: ((Name, Type), [Name]) -> Q Exp
+        goX ((v, t), us) =
+          (\ (u, w) ->
+           foldl1 AppE
+           [VarE 'Data.Lens.lens,
+            LamCaseE ((\ u -> Match (RecP u [(v, VarP w)]) (NormalB $ VarE w) []) <$> us),
+            LamE [VarP w, VarP u] (RecUpdE (VarE u) [(v, VarE w)])]) <$> liftA2 (,) (newName "u") (newName "v")
+    in (traverse
+        ((\ l@((mkName ∘ name ∘ nameBase -> v, _), _) -> liftA3 (,,) (pure v) (goT l) (goX l)) &
+         fmap (\ (v, t, x) -> [SigD v t, ValD (VarP v) (NormalB x) []])) & fmap concat) labels
+
+freeTypeVars :: Type -> Set Name
+freeTypeVars (ForallT (fmap binderName & Set.fromList -> vs) _ t) = freeTypeVars t `Set.difference` vs
+freeTypeVars (AppT s t) = freeTypeVars s <> freeTypeVars t
+freeTypeVars (SigT t _) = freeTypeVars t
+freeTypeVars (VarT v) = Set.singleton v
+freeTypeVars _ = Set.empty
+
+binderName :: TyVarBndr -> Name
+binderName (PlainTV v) = v
+binderName (KindedTV v _) = v
+
+class Functor' b a where fmap' :: (a -> a) -> b -> b
+
+instance Functor' Type Name where
+    fmap' f (ForallT bs@(fmap binderName & Set.fromList -> vs) c t) = ForallT bs c $ fmap' (liftA3 bool f id (∈ vs)) t
+    fmap' f (AppT s t) = AppT (fmap' f s) (fmap' f t)
+    fmap' f (SigT t k) = AppT (fmap' f t) k
+    fmap' f (VarT v) = VarT (f v)
+    fmap' f t = t
+
+instance Functor' TyVarBndr Name where
+    fmap' f (PlainTV v) = PlainTV (f v)
+    fmap' f (KindedTV v k) = KindedTV (f v) k
+
+instance Functor f => Functor' (f a) a where fmap' = fmap
+
+(/.) :: (Ord a, Functor' b a) => b -> Map a a -> b
+xs /. m = liftA2 fromMaybe id (flip Map.lookup m) `fmap'` xs
+
+factorizeLBy :: (a -> a -> Bool) -> [(a, b)] -> [(a, [b])]
+factorizeLBy (==) = List.groupBy ((==) `on` fst) & fmap (unzip >>> head *** id)
+
+factorizeL :: (Eq a) => [(a, b)] -> [(a, [b])]
+factorizeL = factorizeLBy (==)
+
+infixr 9 &
+(&) = flip (∘)
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,5 @@
+© Unix year 44 (Strake = M Farkas-Dyck)
+
+Leave to use, copy, modify, and distribute this work for any purpose is hereby granted if the above copyright notice and this license are included.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/lenz-template.cabal b/lenz-template.cabal
new file mode 100644
--- /dev/null
+++ b/lenz-template.cabal
@@ -0,0 +1,15 @@
+name:		lenz-template
+version:	0.1
+synopsis:	Van Laarhoven lens templates
+license:	OtherLicense
+license-file:	LICENSE
+author:		M Farkas-Dyck
+maintainer:	strake888@gmail.com
+category:	Data, Lenses, Template Haskell
+build-type:	Simple
+cabal-version:	>=1.4
+
+library
+  exposed-modules:	Data.Lens.TH
+  build-depends:	base >= 4.8 && < 4.9, base-unicode-symbols >= 0.1 && < 0.3, template-haskell >= 2.10 && < 2.11, containers >= 0.5 && < 0.6, lenz >= 0.1 && < 0.2
+  extensions:		LambdaCase, MultiParamTypeClasses, FlexibleInstances