diff --git a/Database/Persist/TH.hs b/Database/Persist/TH.hs
--- a/Database/Persist/TH.hs
+++ b/Database/Persist/TH.hs
@@ -19,6 +19,7 @@
     , mpsGeneric
     , mpsPrefixFields
     , mpsEntityJSON
+    , mpsGenerateLenses
     , EntityJSON, entityToJSON, entityFromJSON
     , mkPersistSettings
     , sqlSettings
@@ -195,6 +196,12 @@
     --      , entityFromJSON = 'keyValueEntityFromJSON
     --      }
     -- @
+    , mpsGenerateLenses :: !Bool
+    -- ^ Instead of generating normal field accessors, generator lens-style accessors.
+    --
+    -- Default: False
+    --
+    -- Since 1.3.1
     }
 
 data EntityJSON = EntityJSON
@@ -215,6 +222,7 @@
         { entityToJSON = 'keyValueEntityToJSON
         , entityFromJSON = 'keyValueEntityFromJSON
         }
+    , mpsGenerateLenses = False
     }
 
 -- | Use the 'SqlPersist' backend.
@@ -227,11 +235,19 @@
 sqlOnlySettings :: MkPersistSettings
 sqlOnlySettings = sqlSettings { mpsGeneric = False }
 
-recName :: MkPersistSettings -> Text -> Text -> Text
-recName mps dt f
+recNameNoUnderscore :: MkPersistSettings -> Text -> Text -> Text
+recNameNoUnderscore mps dt f
   | mpsPrefixFields mps = lowerFirst dt ++ upperFirst f
   | otherwise           = lowerFirst f
 
+recName :: MkPersistSettings -> Text -> Text -> Text
+recName mps dt f =
+    addUnderscore $ recNameNoUnderscore mps dt f
+  where
+    addUnderscore
+        | mpsGenerateLenses mps = ("_" ++)
+        | otherwise = id
+
 lowerFirst :: Text -> Text
 lowerFirst t =
     case uncons t of
@@ -600,6 +616,8 @@
 
     lensClauses <- mkLensClauses mps t
 
+    lenses <- mkLenses mps t
+
     return $ addSyn $
        dataTypeDec mps t : mconcat fkc `mappend`
       ([ TySynD (mkName $ unpack $ unHaskellName (entityHaskell t) ++ "Id") [] $
@@ -634,7 +652,57 @@
         , FunD 'persistIdField [Clause [] (NormalB $ ConE $ mkName $ unpack $ unHaskellName (entityHaskell t) ++ "Id") []]
         , FunD 'fieldLens lensClauses
         ]
-      ])
+      ] `mappend` lenses)
+
+mkLenses :: MkPersistSettings -> EntityDef a -> Q [Dec]
+mkLenses mps _ | not (mpsGenerateLenses mps) = return []
+mkLenses _ ent | entitySum ent = return []
+mkLenses mps ent = fmap mconcat $ forM (entityFields ent) $ \field -> do
+    let lensName' = recNameNoUnderscore mps (unHaskellName $ entityHaskell ent) (unHaskellName $ fieldHaskell field)
+        lensName = mkName $ unpack lensName'
+        fieldName = mkName $ unpack $ "_" ++ lensName'
+    needleN <- newName "needle"
+    setterN <- newName "setter"
+    fN <- newName "f"
+    aN <- newName "a"
+    yN <- newName "y"
+    let needle = VarE needleN
+        setter = VarE setterN
+        f = VarE fN
+        a = VarE aN
+        y = VarE yN
+        fT = mkName "f"
+        -- FIXME if we want to get really fancy, then: if this field is the
+        -- *only* Id field present, then set backend1 and backend2 to different
+        -- values
+        backend1 = mkName "backend"
+        backend2 = mkName "backend"
+        aT = pairToType mps backend1 (fieldType field, nullable $ fieldAttrs field)
+        bT = pairToType mps backend2 (fieldType field, nullable $ fieldAttrs field)
+        mkST backend = genericDataType mps (unHaskellName $ entityHaskell ent) (VarT backend)
+        sT = mkST backend1
+        tT = mkST backend2
+        t1 `arrow` t2 = ArrowT `AppT` t1 `AppT` t2
+        vars = PlainTV fT
+             : (if mpsGeneric mps then [PlainTV backend1{-, PlainTV backend2-}] else [])
+    return
+        [ SigD lensName $ ForallT vars [ClassP ''Functor [VarT fT]] $
+            (aT `arrow` (VarT fT `AppT` bT)) `arrow`
+            (sT `arrow` (VarT fT `AppT` tT))
+        , FunD lensName $ return $ Clause
+            [VarP fN, VarP aN]
+            (NormalB $ VarE 'fmap
+                `AppE` setter
+                `AppE` (f `AppE` needle))
+            [ FunD needleN [Clause [] (NormalB $ VarE fieldName `AppE` a) []]
+            , FunD setterN $ return $ Clause
+                [VarP yN]
+                (NormalB $ RecUpdE a
+                    [ (fieldName, y)
+                    ])
+                []
+            ]
+        ]
 
 mkForeignKeysComposite :: MkPersistSettings -> EntityDef a -> ForeignDef -> Q [Dec]
 mkForeignKeysComposite mps t fdef = do
diff --git a/persistent-template.cabal b/persistent-template.cabal
--- a/persistent-template.cabal
+++ b/persistent-template.cabal
@@ -1,5 +1,5 @@
 name:            persistent-template
-version:         1.3.0
+version:         1.3.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -42,6 +42,7 @@
                    , persistent
                    , bytestring
                    , QuickCheck
+                   , transformers
 
 source-repository head
   type:     git
diff --git a/test/main.hs b/test/main.hs
--- a/test/main.hs
+++ b/test/main.hs
@@ -5,7 +5,8 @@
 import Test.Hspec.QuickCheck
 import Data.ByteString.Lazy.Char8 ()
 import Test.QuickCheck.Arbitrary
-import Control.Applicative ((<$>), (<*>))
+import Control.Applicative ((<$>), (<*>), Const (..))
+import Data.Functor.Identity (Identity (..))
 
 import Database.Persist
 import Database.Persist.TH
@@ -29,6 +30,27 @@
     deriving Show Eq
 |]
 
+share [mkPersist sqlSettings { mpsGeneric = False, mpsGenerateLenses = True }] [persistLowerCase|
+Lperson json
+    name Text
+    age Int Maybe
+    address Laddress
+    deriving Show Eq
+Laddress json
+    street Text
+    city Text
+    zip Int Maybe
+    deriving Show Eq
+|]
+
+share [mkPersist sqlSettings { mpsGeneric = True , mpsGenerateLenses = True }] [persistLowerCase|
+Foo
+    bar Text Maybe
+    baz BazId
+Baz
+    bin Int
+|]
+
 -- ensure no-json works
 instance ToJSON NoJson where
     toJSON = undefined
@@ -57,3 +79,30 @@
         it "decode" $
             decode "{\"key\": 0, \"value\": {\"name\":\"Michael\",\"age\":27,\"address\":{\"street\":\"Narkis\",\"city\":\"Maalot\"}}}" `shouldBe` Just
                 (Entity key (Person "Michael" (Just 27) $ Address "Narkis" "Maalot" Nothing))
+    it "lens operations" $ do
+        let street1 = "street1"
+            city1 = "city1"
+            city2 = "city2"
+            zip1 = Just 12345
+            address1 = Laddress street1 city1 zip1
+            address2 = Laddress street1 city2 zip1
+            name1 = "name1"
+            age1 = Just 27
+            person1 = Lperson name1 age1 address1
+            person2 = Lperson name1 age1 address2
+        (person1 ^. lpersonAddress) `shouldBe` address1
+        (person1 ^. (lpersonAddress . laddressCity)) `shouldBe` city1
+        (person1 & ((lpersonAddress . laddressCity) .~ city2)) `shouldBe` person2
+
+x & f = f x
+
+(^.) :: s
+     -> ((a -> Const a b) -> (s -> Const a t))
+     -> a
+x ^. lens = getConst $ lens Const x
+
+(.~) :: ((a -> Identity b) -> (s -> Identity t))
+     -> b
+     -> s
+     -> t
+lens .~ val = runIdentity . lens (\_ -> Identity val)