diff --git a/Control/Reference.hs b/Control/Reference.hs
--- a/Control/Reference.hs
+++ b/Control/Reference.hs
@@ -3,7 +3,7 @@
 module Control.Reference
 ( module Control.Reference.InternalInterface
 , module Control.Reference.TH.Monad
-, module Control.Reference.TH.Generate
+, module Control.Reference.TH.Records
 , module Control.Reference.TH.MonadInstances
 , module Control.Reference.TupleInstances
 ) where
@@ -12,7 +12,7 @@
 
 -- generator modules
 import Control.Reference.TH.Monad
-import Control.Reference.TH.Generate
+import Control.Reference.TH.Records
 
 -- generated classes and instances
 import Control.Reference.TH.MonadInstances
diff --git a/Control/Reference/Predefined.hs b/Control/Reference/Predefined.hs
--- a/Control/Reference/Predefined.hs
+++ b/Control/Reference/Predefined.hs
@@ -7,7 +7,7 @@
 #endif
 
 
--- | Predefined references for commonly used data structures.
+-- | Predefined references for commonly used data structures and reference generators.
 --
 -- When defining lenses one should use the more general types. For instance 'Lens' instead of the more strict 'Lens''. This way references with different @m1@ and @m2@ monads can be combined if there is a monad @m'@ for @MMorph m1 m'@ and @MMorph m2 m'@.
 module Control.Reference.Predefined where
diff --git a/Control/Reference/Representation.hs b/Control/Reference/Representation.hs
--- a/Control/Reference/Representation.hs
+++ b/Control/Reference/Representation.hs
@@ -1,7 +1,8 @@
 {- LANGUAGE CPP -}
 {-# LANGUAGE KindSignatures, TypeOperators #-}
 {-# LANGUAGE ScopedTypeVariables, RankNTypes #-}
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances
+           , MultiParamTypeClasses, TypeFamilies #-}
 
 
 -- | This module declares the representation and basic classes of references.
@@ -21,6 +22,7 @@
 import Control.Monad.Identity (Identity(..))
 import Control.Monad.List (ListT(..))
 import Control.Monad.Trans.Maybe (MaybeT(..))
+import Control.Monad.Trans.Control (MonadBaseControl)
 
 -- | A reference is an accessor to a part or different view of some data. 
 -- The referenc has a separate getter, setter and updater. In some cases,
@@ -172,9 +174,15 @@
 
 -- * References for 'IO'
 
+class ( MMorph IO w, MMorph IO r
+      , MonadBaseControl IO w, MonadBaseControl IO r ) => IOMonads w r where
+    
+instance ( MMorph IO w, MMorph IO r
+         , MonadBaseControl IO w, MonadBaseControl IO r ) => IOMonads w r where
+
 -- | A reference that can access mutable data.
 type IOLens s t a b
-  = forall w r . ( RefMonads w r, MMorph IO w, MMorph IO r )
+  = forall w r . ( RefMonads w r, IOMonads w r )
     => Reference w r s t a b
 
 -- | A reference that must access mutable data that is available in the context.
@@ -182,14 +190,14 @@
 
 -- | A reference that can access mutable data that may not exist in the context.
 type IOPartial s t a b
-  = forall w r . (RefMonads w r, MMorph IO w, MonadPlus r, MMorph IO r, MMorph Maybe r )
+  = forall w r . (RefMonads w r, IOMonads w r, MonadPlus r, MMorph Maybe r )
     => Reference w r s t a b
 
 -- | A reference that must access mutable data that may not exist in the context.
 type IOPartial' = Reference IO (MaybeT IO)
     
 type IOTraversal s t a b
-  = forall w r . ( RefMonads w r, MMorph IO w, MonadPlus r, MMorph IO r, MMorph [] r )
+  = forall w r . ( RefMonads w r, IOMonads w r, MonadPlus r, MMorph [] r )
     => Reference w r s t a b
 
 -- | A reference that can access mutable data that is available in a number of
diff --git a/Control/Reference/TH/Generate.hs b/Control/Reference/TH/Generate.hs
deleted file mode 100644
--- a/Control/Reference/TH/Generate.hs
+++ /dev/null
@@ -1,210 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE LambdaCase, TypeOperators #-}
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-
-{-|
-This module can be used to generate references for record fields.
-If the field surely exists, a 'Lens' will be generated.
-If the field may not exist, it will be a 'Partial' lens.
-
-It will have the maximum amount of polymorphism it can create.
-
-If the name of the field starts with "_", the name of the field will be the same with "_" removed. 
-If not, the reference name will be the field name with "_" added te the start.
-
-The following code sample:
-
-@
-data Maybe' a = Just' { _fromJust' :: a }
-              | Nothing'
-$(makeReferences ''Maybe)
-
-data Tuple a b = Tuple { _fst' :: a, _snd' :: b }
-$(makeReferences ''Tuple)
-@
-
-Is equivalent to:
-
-@
-data Maybe' a = Just' { _fromJust' :: a }
-              | Nothing'
-              
-fromJust' :: 'Partial' (Maybe' a) (Maybe' b) a b
-fromJust' = 'partial' (\case Just' x -> Right (x, \y -> return (Just' y))
-                           Nothing' -> Left (return Nothing'))
-
-data Tuple a b = Tuple { _fst' :: a, _snd' :: b }
-fst' :: 'Lens' (Tuple a c) (Tuple b c) a b
-fst' = 'lens' _fst' (\b tup -> tup { _fst' = b })
-snd' :: 'Lens' (Tuple a c) (Tuple a d) c d
-snd' = 'lens' _snd' (\b tup -> tup { _snd' = b })
-@
--}
-module Control.Reference.TH.Generate (makeReferences, debugTH) where
-
-import Language.Haskell.TH hiding (ListT)
-import qualified Data.Map as M
-import Data.List
-import Data.Maybe
-import Control.Monad
-import Control.Monad.Writer
-import Control.Monad.Trans
-import Control.Monad.Trans.List
-import Control.Monad.Trans.State
-import Control.Applicative
-
-import Control.Reference.Representation
-import Control.Reference.Predefined
-import Control.Reference.Operators
-import Control.Reference.Examples.TH
-import Control.Reference.TH.MonadInstances
-import Control.Reference.TupleInstances
-
--- | Shows the generated declarations instead of using them.
-debugTH :: Q [Dec] -> Q [Dec]
-debugTH d = d >>= runIO . putStrLn . pprint >> return []
-
--- | Creates references for fields of a data structure.
-makeReferences :: Name -> Q [Dec]
-makeReferences n 
-  = do inf <- reify n
-       case inf of
-         TyConI decl -> case newtypeToData decl of
-           DataD ctx tyConName args cons _ -> case cons of
-             [con] -> makeLensesForCon tyConName args con 
-             _ -> liftM concat $ mapM (makePartialLensesForCon tyConName args cons) cons
-           _ -> fail "makeReferences: Unsupported data type"
-         _ -> fail "makeReferences: Expected the name of a data type or newtype"
-                
-
-makeLensesForCon :: Name -> [TyVarBndr] -> Con -> Q [Dec]
-makeLensesForCon tyName tyVars (RecC conName conFields) 
-  = liftM concat $ mapM (\(n, _, t) -> createLensForField tyName tyVars conName n t) conFields
-makeLensesForCon _ _ _ = return []
-             
-createLensForField :: Name -> [TyVarBndr] -> Name -> Name -> Type -> Q [Dec]
-createLensForField typName typArgs conName fldName fldTyp 
-  = do lTyp <- referenceType (ConT ''Lens) typName typArgs fldTyp  
-       lensBody <- genLensBody
-       return [ SigD lensName lTyp
-              , ValD (VarP lensName) (NormalB $ lensBody) []
-              ] 
-   where lensName = refName fldName
-   
-         genLensBody :: Q Exp
-         genLensBody 
-           = do setVar <- newName "b"
-                origVar <- newName "s"
-                return $ VarE 'lens 
-                           `AppE` VarE fldName 
-                           `AppE` LamE [VarP setVar, AsP origVar (RecP conName [])] 
-                                       (RecUpdE (VarE origVar) [(fldName,VarE setVar)])
-           
-           
-makePartialLensesForCon :: Name -> [TyVarBndr] -> [Con] -> Con -> Q [Dec]
-makePartialLensesForCon tyName tyVars cons (RecC conName conFields) 
-  = liftM concat $ mapM (\(n, _, t) -> createPartialLensForField tyName tyVars conName cons n t) conFields
-makePartialLensesForCon _ _ _ _ = return []
-           
-createPartialLensForField :: Name -> [TyVarBndr] -> Name -> [Con] -> Name -> Type -> Q [Dec]
-createPartialLensForField  typName typArgs conName cons fldName fldTyp 
-  = do lTyp <- referenceType (ConT ''Partial) typName typArgs fldTyp  
-       lensBody <- genLensBody
-       return [ SigD lensName lTyp
-              , ValD (VarP lensName) (NormalB $ lensBody) []
-              ] 
-   where lensName = refName fldName
-   
-         genLensBody :: Q Exp
-         genLensBody 
-           = do matchesWithField <- mapM matchWithField consWithField 
-                matchesWithoutField <- mapM matchWithoutField consWithoutField
-                name <- newName "x"
-                return $ VarE 'partial 
-                           `AppE` LamE [VarP name]
-                                       (CaseE (VarE name)
-                                              ( matchesWithField ++ matchesWithoutField ))
-                           
-         (consWithField, consWithoutField) 
-           = partition (hasField fldName) cons
-           
-         matchWithField :: Con -> Q Match
-         matchWithField con 
-           = do (bind, rebuild, vars) <- bindAndRebuild con
-                setVar <- newName "b"
-                let Just bindInd = fieldIndex fldName con
-                    bindRight 
-                      = ConE 'Right 
-                          `AppE` TupE [ VarE (vars !! bindInd)
-                                      , LamE [VarP setVar] 
-                                             (funApplication & element (bindInd+1)
-                                                 ?= VarE setVar $ rebuild)
-                                      ]
-                return $ Match bind (NormalB bindRight) []
-                         
-         matchWithoutField :: Con -> Q Match
-         matchWithoutField con 
-           = do (bind, rebuild, _) <- bindAndRebuild con
-                return $ Match bind (NormalB (ConE 'Left `AppE` rebuild)) []
-                                       
-           
-referenceType :: Type -> Name -> [TyVarBndr] -> Type -> Q Type
-referenceType refType name args fldTyp 
-  = do let argTypes = args ^* traverse&typeVarName
-       (fldTyp',mapping) <- makePoly argTypes fldTyp
-       let args' = traverse&typeVarName *- (\a -> fromMaybe a (mapping ^? element a)) $ args
-       return $ ForallT (map PlainTV (sort (nub (M.elems mapping ++ argTypes)))) [] 
-                        (refType `AppT` addTypeArgs name args 
-                                 `AppT` addTypeArgs name args' 
-                                 `AppT` fldTyp 
-                                 `AppT` fldTyp') 
-           
--- | Creates a new field type with changing the type variables that are bound outside
-makePoly :: [Name] -> Type -> Q (Type, M.Map Name Name)
-makePoly typArgs fldTyp 
-  = runStateT (typVarsBounded #~ updateName $ fldTyp) M.empty           
-  where typVarsBounded :: Simple (StateTraversal' (M.Map Name Name) Q) Type Name
-        typVarsBounded = typeVariables & filtered (`elem` typArgs)
-        updateName name = do name' <- lift (newName (nameBase name ++ "'")) 
-                             modify (M.insert name name')
-                             return name'
-                             
-
--- | Dictates what reference names should be generated from field names
-refName :: Name -> Name
-refName = nameBaseStr .- \case '_':xs -> xs; xs -> '_':xs
-
--- * Helper functions 
-
-hasField :: Name -> Con -> Bool
-hasField n = not . null . (^* recFields & traverse & _1 & filtered (==n))
-         
-fieldIndex :: Name -> Con -> Maybe Int
-fieldIndex n con = (con ^? recFields) >>= findIndex (\f -> (f ^. _1) == n)
-         
--- | Creates a type from applying binded type variables to a type function
-addTypeArgs :: Name -> [TyVarBndr] -> Type
-addTypeArgs n = foldl AppT (ConT n) 
-                  . map (VarT . (^. typeVarName))
- 
-newtypeToData :: Dec -> Dec
-newtypeToData (NewtypeD ctx name tvars con derives) 
-  = DataD ctx name tvars [con] derives
-newtypeToData d = d
-
-bindAndRebuild :: Con -> Q (Pat, Exp, [Name])
-bindAndRebuild con 
-  = do let name = con ^. conName
-           fields = con ^. conFields
-       bindVars <- replicateM (length fields) (newName "fld")
-       return ( ConP name (map VarP bindVars)
-              , -- TODO : use funApplication isomorphisms
-                foldl AppE (ConE name) (map VarE bindVars)
-              , bindVars
-              )
-
-instance MMorph [] (ListT (StateT s Q)) where
-  morph = ListT . return
-
-instance Monad m => MMorph (StateT s m) (ListT (StateT s m)) where
-  morph = lift
diff --git a/Control/Reference/TH/Records.hs b/Control/Reference/TH/Records.hs
new file mode 100644
--- /dev/null
+++ b/Control/Reference/TH/Records.hs
@@ -0,0 +1,210 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase, TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+{-|
+This module can be used to generate references for record fields.
+If the field surely exists, a 'Lens' will be generated.
+If the field may not exist, it will be a 'Partial' lens.
+
+It will have the maximum amount of polymorphism it can create.
+
+If the name of the field starts with "_", the name of the field will be the same with "_" removed. 
+If not, the reference name will be the field name with "_" added te the start.
+
+The following code sample:
+
+@
+data Maybe' a = Just' { _fromJust' :: a }
+              | Nothing'
+$(makeReferences ''Maybe)
+
+data Tuple a b = Tuple { _fst' :: a, _snd' :: b }
+$(makeReferences ''Tuple)
+@
+
+Is equivalent to:
+
+@
+data Maybe' a = Just' { _fromJust' :: a }
+              | Nothing'
+              
+fromJust' :: 'Partial' (Maybe' a) (Maybe' b) a b
+fromJust' = 'partial' (\case Just' x -> Right (x, \y -> return (Just' y))
+                           Nothing' -> Left (return Nothing'))
+
+data Tuple a b = Tuple { _fst' :: a, _snd' :: b }
+fst' :: 'Lens' (Tuple a c) (Tuple b c) a b
+fst' = 'lens' _fst' (\b tup -> tup { _fst' = b })
+snd' :: 'Lens' (Tuple a c) (Tuple a d) c d
+snd' = 'lens' _snd' (\b tup -> tup { _snd' = b })
+@
+-}
+module Control.Reference.TH.Records (makeReferences, debugTH) where
+
+import Language.Haskell.TH hiding (ListT)
+import qualified Data.Map as M
+import Data.List
+import Data.Maybe
+import Control.Monad
+import Control.Monad.Writer
+import Control.Monad.Trans
+import Control.Monad.Trans.List
+import Control.Monad.Trans.State
+import Control.Applicative
+
+import Control.Reference.Representation
+import Control.Reference.Predefined
+import Control.Reference.Operators
+import Control.Reference.Examples.TH
+import Control.Reference.TH.MonadInstances
+import Control.Reference.TupleInstances
+
+-- | Shows the generated declarations instead of using them.
+debugTH :: Q [Dec] -> Q [Dec]
+debugTH d = d >>= runIO . putStrLn . pprint >> return []
+
+-- | Creates references for fields of a data structure.
+makeReferences :: Name -> Q [Dec]
+makeReferences n 
+  = do inf <- reify n
+       case inf of
+         TyConI decl -> case newtypeToData decl of
+           DataD ctx tyConName args cons _ -> case cons of
+             [con] -> makeLensesForCon tyConName args con 
+             _ -> liftM concat $ mapM (makePartialLensesForCon tyConName args cons) cons
+           _ -> fail "makeReferences: Unsupported data type"
+         _ -> fail "makeReferences: Expected the name of a data type or newtype"
+                
+
+makeLensesForCon :: Name -> [TyVarBndr] -> Con -> Q [Dec]
+makeLensesForCon tyName tyVars (RecC conName conFields) 
+  = liftM concat $ mapM (\(n, _, t) -> createLensForField tyName tyVars conName n t) conFields
+makeLensesForCon _ _ _ = return []
+             
+createLensForField :: Name -> [TyVarBndr] -> Name -> Name -> Type -> Q [Dec]
+createLensForField typName typArgs conName fldName fldTyp 
+  = do lTyp <- referenceType (ConT ''Lens) typName typArgs fldTyp  
+       lensBody <- genLensBody
+       return [ SigD lensName lTyp
+              , ValD (VarP lensName) (NormalB $ lensBody) []
+              ] 
+   where lensName = refName fldName
+   
+         genLensBody :: Q Exp
+         genLensBody 
+           = do setVar <- newName "b"
+                origVar <- newName "s"
+                return $ VarE 'lens 
+                           `AppE` VarE fldName 
+                           `AppE` LamE [VarP setVar, AsP origVar (RecP conName [])] 
+                                       (RecUpdE (VarE origVar) [(fldName,VarE setVar)])
+           
+           
+makePartialLensesForCon :: Name -> [TyVarBndr] -> [Con] -> Con -> Q [Dec]
+makePartialLensesForCon tyName tyVars cons (RecC conName conFields) 
+  = liftM concat $ mapM (\(n, _, t) -> createPartialLensForField tyName tyVars conName cons n t) conFields
+makePartialLensesForCon _ _ _ _ = return []
+           
+createPartialLensForField :: Name -> [TyVarBndr] -> Name -> [Con] -> Name -> Type -> Q [Dec]
+createPartialLensForField  typName typArgs conName cons fldName fldTyp 
+  = do lTyp <- referenceType (ConT ''Partial) typName typArgs fldTyp  
+       lensBody <- genLensBody
+       return [ SigD lensName lTyp
+              , ValD (VarP lensName) (NormalB $ lensBody) []
+              ] 
+   where lensName = refName fldName
+   
+         genLensBody :: Q Exp
+         genLensBody 
+           = do matchesWithField <- mapM matchWithField consWithField 
+                matchesWithoutField <- mapM matchWithoutField consWithoutField
+                name <- newName "x"
+                return $ VarE 'partial 
+                           `AppE` LamE [VarP name]
+                                       (CaseE (VarE name)
+                                              ( matchesWithField ++ matchesWithoutField ))
+                           
+         (consWithField, consWithoutField) 
+           = partition (hasField fldName) cons
+           
+         matchWithField :: Con -> Q Match
+         matchWithField con 
+           = do (bind, rebuild, vars) <- bindAndRebuild con
+                setVar <- newName "b"
+                let Just bindInd = fieldIndex fldName con
+                    bindRight 
+                      = ConE 'Right 
+                          `AppE` TupE [ VarE (vars !! bindInd)
+                                      , LamE [VarP setVar] 
+                                             (funApplication & element (bindInd+1)
+                                                 ?= VarE setVar $ rebuild)
+                                      ]
+                return $ Match bind (NormalB bindRight) []
+                         
+         matchWithoutField :: Con -> Q Match
+         matchWithoutField con 
+           = do (bind, rebuild, _) <- bindAndRebuild con
+                return $ Match bind (NormalB (ConE 'Left `AppE` rebuild)) []
+                                       
+           
+referenceType :: Type -> Name -> [TyVarBndr] -> Type -> Q Type
+referenceType refType name args fldTyp 
+  = do let argTypes = args ^* traverse&typeVarName
+       (fldTyp',mapping) <- makePoly argTypes fldTyp
+       let args' = traverse&typeVarName *- (\a -> fromMaybe a (mapping ^? element a)) $ args
+       return $ ForallT (map PlainTV (sort (nub (M.elems mapping ++ argTypes)))) [] 
+                        (refType `AppT` addTypeArgs name args 
+                                 `AppT` addTypeArgs name args' 
+                                 `AppT` fldTyp 
+                                 `AppT` fldTyp') 
+           
+-- | Creates a new field type with changing the type variables that are bound outside
+makePoly :: [Name] -> Type -> Q (Type, M.Map Name Name)
+makePoly typArgs fldTyp 
+  = runStateT (typVarsBounded #~ updateName $ fldTyp) M.empty           
+  where typVarsBounded :: Simple (StateTraversal' (M.Map Name Name) Q) Type Name
+        typVarsBounded = typeVariables & filtered (`elem` typArgs)
+        updateName name = do name' <- lift (newName (nameBase name ++ "'")) 
+                             modify (M.insert name name')
+                             return name'
+                             
+
+-- | Dictates what reference names should be generated from field names
+refName :: Name -> Name
+refName = nameBaseStr .- \case '_':xs -> xs; xs -> '_':xs
+
+-- * Helper functions 
+
+hasField :: Name -> Con -> Bool
+hasField n = not . null . (^* recFields & traverse & _1 & filtered (==n))
+         
+fieldIndex :: Name -> Con -> Maybe Int
+fieldIndex n con = (con ^? recFields) >>= findIndex (\f -> (f ^. _1) == n)
+         
+-- | Creates a type from applying binded type variables to a type function
+addTypeArgs :: Name -> [TyVarBndr] -> Type
+addTypeArgs n = foldl AppT (ConT n) 
+                  . map (VarT . (^. typeVarName))
+ 
+newtypeToData :: Dec -> Dec
+newtypeToData (NewtypeD ctx name tvars con derives) 
+  = DataD ctx name tvars [con] derives
+newtypeToData d = d
+
+bindAndRebuild :: Con -> Q (Pat, Exp, [Name])
+bindAndRebuild con 
+  = do let name = con ^. conName
+           fields = con ^. conFields
+       bindVars <- replicateM (length fields) (newName "fld")
+       return ( ConP name (map VarP bindVars)
+              , -- TODO : use funApplication isomorphisms
+                foldl AppE (ConE name) (map VarE bindVars)
+              , bindVars
+              )
+
+instance MMorph [] (ListT (StateT s Q)) where
+  morph = ListT . return
+
+instance Monad m => MMorph (StateT s m) (ListT (StateT s m)) where
+  morph = lift
diff --git a/Control/Reference/TH/Tuple.hs b/Control/Reference/TH/Tuple.hs
--- a/Control/Reference/TH/Tuple.hs
+++ b/Control/Reference/TH/Tuple.hs
@@ -1,66 +1,96 @@
 {-# LANGUAGE TemplateHaskell #-}
--- | A module for making connections between different monads.
-module Control.Reference.TH.Tuple (makeTupleRefs) where
+-- | A module for creating lenses to fields of simple, tuple data structures 
+-- like pairs, triplets, and so on.
+module Control.Reference.TH.Tuple (TupleConf(..), hsTupConf, makeTupleRefs) where
 
 import Language.Haskell.TH
 import Control.Monad
+import Control.Applicative
+import Data.Maybe
 
-import Control.Reference.Representation
+import Control.Reference.InternalInterface
 
--- | Creates @_1@ ... @_n@ classes, and instances for tuples up to m
-makeTupleRefs :: Int -> Int -> Q [Dec]
-makeTupleRefs n m 
-  = liftM2 (++) (genClass `mapM` [0..(n-1)]) 
-                (genInstance `mapM` [ (x, y) | x <- [0..(n-1)], y <- [(max 2 (x+1))..m] ])
-      -- >>= runIO . putStrLn . pprint >> return []
-             
-     
+-- | Creates @Lens_1@ ... @Lens_n@ classes, and instances for tuples up to 'm'.
+-- 
+-- Classes and instances look like the following:
+-- 
+-- @
+-- class Lens_1 s t a b | s -> a, t -> b
+--                      , a t -> s, b s -> t where 
+--   _1 :: Lens s t a b
+--
+-- instance Lens_1 (a,b) (a',b) a a' where 
+--   _1 = lens (\(a,b) -> a) (\a' (a,b) -> (a',b))
+-- @
+--
+makeTupleRefs :: TupleConf -> Int -> Int -> Q [Dec]
+makeTupleRefs conf n m 
+  = (++) <$> (catMaybes <$> genClass `mapM` [0..(n-1)]) 
+         <*> (genInstance conf 
+                  `mapM` [ (x, y) | x <- [0..(n-1)]
+                                  , y <- [(max 2 (x+1))..m] ])             
 
-genClass :: Int -> Q Dec
+genClass :: Int -> Q (Maybe Dec)
 genClass i 
-  = do s <- newName "s"
-       t <- newName "t"
-       a <- newName "a"
-       b <- newName "b1"
-       let tvars = map PlainTV [s,t,a,b]
-       return $ ClassD [] (mkName ("Lens_" ++ show (i+1))) tvars
-                       [ FunDep [s] [a], FunDep [t] [b]
-                       , FunDep [a,t] [s], FunDep [b,s] [t]] 
-                       [ SigD normalLens 
-                              ( ForallT [] [] (foldl AppT (ConT ''Lens) (map VarT [s,t,a,b])) )               
-                       ]    
-  where normalLens = mkName ("_" ++ show (i+1))
-        
+  = do declared <- classDeclared i
+       if declared then return Nothing
+                   else Just <$> genClass' i
+  where genClass' i = 
+          do s <- newName "s"
+             t <- newName "t"
+             a <- newName "a"
+             b <- newName "b1"
+             let tvars = map PlainTV [s,t,a,b]
+             return $ ClassD [] (lensClass i) tvars
+                             [ FunDep [s] [a], FunDep [t] [b]
+                             , FunDep [a,t] [s], FunDep [b,s] [t]] 
+                             [ SigD (lensFun i) 
+                                    (foldl AppT (ConT ''Lens) (map VarT [s,t,a,b]))         
+                             ]    
 
-genInstance :: (Int,Int) -> Q Dec
-genInstance (n,m)
+lensClass i = mkName ("Lens_" ++ show (i+1))
+lensFun i = mkName ("_" ++ show (i+1))
+  
+classDeclared :: Int -> Q Bool 
+classDeclared i = isJust <$> lookupTypeName (nameBase $ lensClass i)
+
+genInstance :: TupleConf -> (Int,Int) -> Q Dec
+genInstance (TupleConf typGen patGen expGen) (n,m)
   = do names <- replicateM m (newName "a")
        name <- newName "b2"
        genBody <- generateBody
-       return $ InstanceD [] (ConT (mkName ("Lens_" ++ show (n+1))) 
-                                `AppT` foldl AppT (TupleT m) (map VarT names)
-                                `AppT` foldl AppT (TupleT m) (map VarT (replace n name names))
+       return $ InstanceD [] (ConT (lensClass n) 
+                                `AppT` typGen names
+                                `AppT` typGen (replace n name names)
                                 `AppT` VarT (names !! n)
                                 `AppT` VarT name
                              ) 
-                             [ ValD (VarP (mkName ("_" ++ show (n+1)))) 
+                             [ ValD (VarP (lensFun n) ) 
                                     (NormalB genBody) [] ]
 
   where generateBody :: Q Exp
-        generateBody 
+        generateBody
           = do names <- replicateM m (newName "a")
                name <- newName "b3"
-               trf <- newName "trf"
-               return $ VarE 'reference 
-                          `AppE` LamE [TupP (map VarP names)] 
-                                      (VarE 'return `AppE` VarE (names !! n))
-                          `AppE` LamE [VarP name, TupP (map VarP names)] 
-                                      (VarE 'return `AppE` TupE (map VarE (replace n name names)))
-                          `AppE` LamE [VarP trf, TupP (map VarP names)] 
-                                      (VarE 'liftM 
-                                        `AppE` LamE [VarP name] (TupE (map VarE (replace n name names))) 
-                                        `AppE` (VarE trf `AppE` VarE (names !! n)))
-                                    
+               return $ VarE 'lens 
+                          `AppE` LamE [patGen names] 
+                                      (VarE (names !! n))
+                          `AppE` LamE [VarP name, patGen names] 
+                                      (expGen (replace n name names))
+
+-- | A tuple configuration is a scheme for tuple-like data structures.
+data TupleConf = TupleConf { tupleType      :: [Name] -> Type
+                           , tuplePattern   :: [Name] -> Pat
+                           , tupleExpr      :: [Name] -> Exp
+                           }
+        
+-- | Generates the normal haskell tuples (@(a,b), (a,b,c), (a,b,c,d)@)        
+hsTupConf 
+  = TupleConf (\names -> foldl AppT (TupleT (length names)) . map VarT $ names) 
+              (TupP . map VarP) 
+              (TupE . map VarE)
+                  
+-- | Utility function to replace the N'th element of a list                         
 replace :: Int -> a -> [a] -> [a]
 replace i e ls 
   = let (before,after) = splitAt i ls 
diff --git a/Control/Reference/TupleInstances.hs b/Control/Reference/TupleInstances.hs
--- a/Control/Reference/TupleInstances.hs
+++ b/Control/Reference/TupleInstances.hs
@@ -8,5 +8,5 @@
 
 import Control.Reference.TH.Tuple
 
-$(makeTupleRefs 16 16)
+$(makeTupleRefs hsTupConf 16 16)
 
diff --git a/references.cabal b/references.cabal
--- a/references.cabal
+++ b/references.cabal
@@ -1,5 +1,5 @@
 name:                references
-version:             0.2.0.0
+version:             0.2.1.0
 synopsis:            Generalization of lenses, folds and traversals to handle monads and addition.
 description:         References can read, write or update parts of the data.
 		     They are first-class values, can be passed in functions, transformed, combined.
@@ -34,10 +34,14 @@
 		     New references can be created in several ways:
 		     .
 		      * From getter, setter and updater, using the @reference@ function.
-		      * From getter and setter, using one of the simplified functions (@lens@, @simplePartial@, @partial@, ...).
+		     .
+              * From getter and setter, using one of the simplified functions (@lens@, @simplePartial@, @partial@, ...).
+		     .
 		      * Using the `Data.Traversal` instance on a datatype to generate a traversal of each element.
+		     .
 		      * Using lenses from `Control.Lens` package. There are a lot of packages defining lenses, folds and traversals
 		        for various data structures, so it is very useful that all of them can simply be converted into a reference.
+		     .
 		      * Generating references for newly defined records using the `makeReferences` Template Haskell function.
 		     .
 
@@ -57,7 +61,7 @@
   exposed-modules:     Control.Reference
                      , Control.Reference.TH.MonadInstances
                      , Control.Reference.TH.Monad
-                     , Control.Reference.TH.Generate
+                     , Control.Reference.TH.Records
                      , Control.Reference.TH.Tuple
                      , Control.Reference.Examples.TH
                      , Control.Reference.Representation
