diff --git a/Data/Generics/Geniplate.hs b/Data/Generics/Geniplate.hs
--- a/Data/Generics/Geniplate.hs
+++ b/Data/Generics/Geniplate.hs
@@ -1,5 +1,12 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Data.Generics.Geniplate(universeBi, universeBiT, transformBi, transformBiT, transformBiM, transformBiMT) where
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}
+module Data.Generics.Geniplate(
+    genUniverseBi, genUniverseBiT,
+    genTransformBi, genTransformBiT,
+    genTransformBiM, genTransformBiMT,
+    UniverseBi(..), universe, instanceUniverseBi, instanceUniverseBiT,
+    TransformBi(..), transform, instanceTransformBi, instanceTransformBiT,
+    TransformBiM(..), transformM, instanceTransformBiM, instanceTransformBiMT,
+    ) where
 import Control.Monad
 import Control.Exception(assert)
 import Control.Monad.State.Strict
@@ -8,16 +15,78 @@
 import Language.Haskell.TH.Syntax hiding (lift)
 import System.IO
 
+class UniverseBi s t where
+    universeBi :: s -> [t]
+
+class TransformBi s t where
+    transformBi :: (s -> s) -> t -> t
+
+class {-(Monad m) => -} TransformBiM m s t where
+    transformBiM :: (s -> m s) -> t -> m t
+
+universe :: (UniverseBi a a) => a -> [a]
+universe = universeBi
+
+transform :: (TransformBi a a) => (a -> a) -> a -> a
+transform = transformBi
+
+transformM :: (TransformBiM m a a) => (a -> m a) -> a -> m a
+transformM = transformBiM
+
+
+instanceUniverseBi :: TypeQ -> TypeQ -> Q [Dec]
+instanceUniverseBi = instanceUniverseBiT []
+
+instanceUniverseBiT :: [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
+instanceUniverseBiT stops fromq toq = do
+    from <- fromq
+    to <- toq
+    (ds, f) <- uniBiQ stops from to
+    x <- newName "_x"
+    let e = LamE [VarP x] $ LetE ds $ AppE (AppE f (VarE x)) (ListE [])
+    [d|instance UniverseBi $fromq $toq where universeBi = $(return e) |]
+
+instanceTransformBi :: TypeQ -> TypeQ -> Q [Dec]
+instanceTransformBi = instanceTransformBiT []
+
+instanceTransformBiT :: [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
+instanceTransformBiT stops ftq stq = do
+    ft <- ftq
+    st <- stq
+
+    f <- newName "_f"
+    x <- newName "_x"
+    (ds, tr) <- trBiQ raNormal stops f ft st
+    let e = LamE [VarP f, VarP x] $ LetE ds $ AppE tr (VarE x)
+
+    [d|instance TransformBi $ftq $stq where transformBi = $(return e) |]
+
+instanceTransformBiM :: TypeQ -> TypeQ -> TypeQ -> Q [Dec]
+instanceTransformBiM = instanceTransformBiMT []
+
+instanceTransformBiMT :: [TypeQ] -> TypeQ -> TypeQ -> TypeQ -> Q [Dec]
+instanceTransformBiMT stops mndq ftq stq = do
+    ft <- ftq
+    st <- stq
+
+    f <- newName "_f"
+    x <- newName "_x"
+    (ds, tr) <- trBiQ raMonad stops f ft st
+    let e = LamE [VarP f, VarP x] $ LetE ds $ AppE tr (VarE x)
+
+    [d|instance TransformBiM $mndq $ftq $stq where transformBiM = $(return e) |]
+
+
 -- | Generate TH code for a function that extracts all subparts of a certain type.
--- The argument to 'universeBi' is a name with the type @S -> [T]@, for some types
+-- The argument to 'genUniverseBi' is a name with the type @S -> [T]@, for some types
 -- @S@ and @T@.  The function will extract all subparts of type @T@ from @S@.
-universeBi :: Name -> Q Exp
-universeBi = universeBiT []
+genUniverseBi :: Name -> Q Exp
+genUniverseBi = genUniverseBiT []
 
--- | Same as 'universeBi', but does not look inside any types mention in the
+-- | Same as 'genUniverseBi', but does not look inside any types mention in the
 -- list of types.
-universeBiT :: [TypeQ] -> Name -> Q Exp
-universeBiT stops name = do
+genUniverseBiT :: [TypeQ] -> Name -> Q Exp
+genUniverseBiT stops name = do
     (_tvs, from, tos) <- getNameType name
     let to = unList tos
 --    qRunIO $ print (from, to)
@@ -27,31 +96,28 @@
 --    qRunIO $ do putStrLn $ pprint e; hFlush stdout
     return e
 
-type U = StateT (Integer, Map Type [Dec], Map Type Bool) Q
+type U = StateT (Map Type Dec, Map Type Bool) Q
 
 newNameU :: String -> U Name
-newNameU s = do
-    (n, m, c) <- get
-    put (n+1, m, c)
-    lift $ newName $ s ++ "_" ++ show n
+newNameU s = lift $ newName s
 
 uniBiQ :: [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
 uniBiQ stops from ato = do
     ss <- sequence stops
     to <- expandSyn ato
-    (f, (_, m, _)) <- runStateT (uniBi from to) (0, mEmpty, mFromList $ zip ss (repeat False))
-    return (concat $ mElems m, f)
+    (f, (m, _)) <- runStateT (uniBi from to) (mEmpty, mFromList $ zip ss (repeat False))
+    return (mElems m, f)
 
 uniBi :: Type -> Type -> U Exp
 uniBi afrom to = do
-    (n, m, c) <- get
+    (m, c) <- get
     from <- lift $ expandSyn afrom
     case mLookup from m of
-        Just (FunD n _ : _) -> return $ VarE n
+        Just (FunD n _) -> return $ VarE n
         _ -> do
             f <- newNameU "_f"
             let mkRec = do
-                    put (n, mInsert from [FunD f [Clause [] (NormalB $ TupE []) []]] m, c)   -- insert something to break recursion, will be replaced below.
+                    put (mInsert from (FunD f [Clause [] (NormalB $ TupE []) []]) m, c)   -- insert something to break recursion, will be replaced below.
                     uniBiCase from to
             cs <- if from == to then do
                       b <- contains' to from
@@ -59,9 +125,9 @@
                           -- Recursive data type, we need the current value and all values inside.
                           g <- newNameU "_g"
                           gcs <- mkRec
-                          let dg = [FunD g gcs]
+                          let dg = FunD g gcs
                           -- Insert with a dummy type, just to get the definition in the map for mElems.
-                          modify $ \ (n', m', c') -> (n', mInsert (ConT g) dg m', c')
+                          modify $ \ (m', c') -> (mInsert (ConT g) dg m', c')
                           lift $ fmap unFunD [d| f _x _r = _x : $(return (VarE g)) _x _r |]
                        else
                           -- Non-recursive type, just use this value.
@@ -75,8 +141,8 @@
                        else
                           -- No occurrences of to inside from, so add nothing.
                           lift $ fmap unFunD [d| f _ _r = _r |]
-            let d = [FunD f cs]
-            modify $ \ (n', m', c') -> (n', mInsert from d m', c')
+            let d = FunD f cs
+            modify $ \ (m', c') -> (mInsert from d m', c')
             return $ VarE f
 
 -- Check if the second type is contained anywhere in the first type.
@@ -87,7 +153,7 @@
     if from == to then
         return True
      else do
-        c <- gets (\ (_,_,c) -> c)
+        c <- gets snd
         case mLookup from c of
             Just b  -> return b
             Nothing -> contains' to from
@@ -97,15 +163,15 @@
 contains' to from = do
 --    lift $ qRunIO $ print ("contains'", to, from)
     let (con, ts) = splitTypeApp from
-    modify $ \ (n, m, c) -> (n, m, mInsert from False c)        -- To make the fixpoint of the recursion False.
+    modify $ \ (m, c) -> (m, mInsert from False c)        -- To make the fixpoint of the recursion False.
     b <- case con of
          ConT n    -> containsCon n to ts
          TupleT _  -> fmap or $ mapM (contains to) ts
          ArrowT    -> return False
-         ListT     -> contains to (head ts)
+         ListT     -> if to == from then return True else contains to (head ts)
          VarT _    -> return False
          t         -> genError $ "contains: unexpected type: " ++ pprint from ++ " (" ++ show t ++ ")"
-    modify $ \ (n, m, c) -> (n, m, mInsert from b c)
+    modify $ \ (m, c) -> (m, mInsert from b c)
     return b
 
 containsCon :: Name -> Type -> [Type] -> U Bool
@@ -225,6 +291,7 @@
 
 expandSynApp :: Type -> [Type] -> Q Type
 expandSynApp (AppT t1 t2) ts = do t2' <- expandSyn t2; expandSynApp t1 (t2':ts)
+expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl AppT ListT ts
 expandSynApp t@(ConT n) ts = do
     info <- qReify n
     case info of
@@ -244,76 +311,78 @@
 
 -- Exp has type (S -> S) -> T -> T, for some S and T
 -- | Generate TH code for a function that transforms all subparts of a certain type.
--- The argument to 'transformBi' is a name with the type @(S->S) -> T -> T@, for some types
+-- The argument to 'genTransformBi' is a name with the type @(S->S) -> T -> T@, for some types
 -- @S@ and @T@.  The function will transform all subparts of type @S@ inside @T@ using the given function.
-transformBi :: Name -> Q Exp
-transformBi = transformBiT []
+genTransformBi :: Name -> Q Exp
+genTransformBi = genTransformBiT []
 
--- | Same as 'transformBi', but does not look inside any types mention in the
+-- | Same as 'genTransformBi', but does not look inside any types mention in the
 -- list of types.
-transformBiT :: [TypeQ] -> Name -> Q Exp
-transformBiT = transformBiG (Nothing, id, AppE, AppE)
+genTransformBiT :: [TypeQ] -> Name -> Q Exp
+genTransformBiT = transformBiG raNormal
 
-transformBiM :: Name -> Q Exp
-transformBiM = transformBiMT []
+raNormal :: RetAp
+raNormal = (id, AppE, AppE)
 
-transformBiMT :: [TypeQ] -> Name -> Q Exp
-transformBiMT = transformBiG (Just undefined, eret, eap, emap)
+genTransformBiM :: Name -> Q Exp
+genTransformBiM = genTransformBiMT []
+
+genTransformBiMT :: [TypeQ] -> Name -> Q Exp
+genTransformBiMT = transformBiG raMonad
+
+raMonad :: RetAp
+raMonad = (eret, eap, emap)
   where eret e = AppE (VarE 'Control.Monad.return) e
         eap f a = AppE (AppE (VarE 'Control.Monad.ap) f) a
         emap f a = AppE (AppE (VarE '(Control.Monad.=<<)) f) a
 
-type RetAp = (Maybe Type, Exp -> Exp, Exp -> Exp -> Exp, Exp -> Exp -> Exp)
+type RetAp = (Exp -> Exp, Exp -> Exp -> Exp, Exp -> Exp -> Exp)
 
 transformBiG :: RetAp -> [TypeQ] -> Name -> Q Exp
 transformBiG ra stops name = do
     (_tvs, fcn, res) <- getNameType name
     f <- newName "_f"
     x <- newName "_x"
-    (ds, tr, fty, argty) <-
-        case (ra, fcn, res) of
-            ((Nothing,_,_,_),     AppT (AppT ArrowT s) s',          AppT (AppT ArrowT t) t') | s == s' && t == t' -> trBiQ ra stops f s t
-            ((Just _,ret, apl, rbn), AppT (AppT ArrowT s) (AppT m s'), AppT (AppT ArrowT t) (AppT m' t')) |
-                      s == s' && t == t' && m == m' -> trBiQ (Just m, ret, apl, rbn) stops f s t
+    (ds, tr) <-
+        case (fcn, res) of
+            (AppT (AppT ArrowT s) s',          AppT (AppT ArrowT t) t')           | s == s' && t == t'            -> trBiQ ra stops f s t
+            (AppT (AppT ArrowT s) (AppT m s'), AppT (AppT ArrowT t) (AppT m' t')) | s == s' && t == t' && m == m' -> trBiQ ra stops f s t
             _ -> genError $ "transformBi: malformed type: " ++ pprint (AppT (AppT ArrowT fcn) res) ++ ", should have form (S->S) -> (T->T)"
-    let e = LamE [VarP f {-`SigP` fty-}, VarP x {-`SigP` argty-}] $ LetE ds $ AppE tr (VarE x)
+    let e = LamE [VarP f, VarP x] $ LetE ds $ AppE tr (VarE x)
 --    qRunIO $ do putStrLn $ pprint e; hFlush stdout
     return e
 
-trBiQ :: RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp, Type, Type)
-trBiQ ra@(mty,_,_,_) stops f aft st = do
+trBiQ :: RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
+trBiQ ra stops f aft st = do
     ss <- sequence stops
     ft <- expandSyn aft
-    (tr, (_, m, _)) <- runStateT (trBi ra (VarE f) ft st) (0, mEmpty, mFromList $ zip ss (repeat False))
-    let fty = ft `arrow` maybe ft (flip AppT ft) mty
-    return (concat $ mElems m, tr, fty, st)
+    (tr, (m, _)) <- runStateT (trBi ra (VarE f) ft st) (mEmpty, mFromList $ zip ss (repeat False))
+    return (mElems m, tr)
 
 arrow :: Type -> Type -> Type
 arrow t1 t2 = AppT (AppT ArrowT t1) t2
 
 trBi :: RetAp -> Exp -> Type -> Type -> U Exp
-trBi ra@(mty, ret, _, rbind) f ft ast = do
-    (n, m, c) <- get
+trBi ra@(ret, _, rbind) f ft ast = do
+    (m, c) <- get
     st <- lift $ expandSyn ast
 --    lift $ qRunIO $ print (ft, st)
     case mLookup st m of
-        Just (FunD n _ : _) -> return $ VarE n
-        Just (SigD n _ : _) -> return $ VarE n
+        Just (FunD n _) -> return $ VarE n
         _ -> do
             tr <- newNameU "_tr"
             let mkRec = do
-                    put (n, mInsert st [FunD tr [Clause [] (NormalB $ TupE []) []]] m, c)  -- insert something to break recursion, will be replaced below.
+                    put (mInsert st (FunD tr [Clause [] (NormalB $ TupE []) []]) m, c)  -- insert something to break recursion, will be replaced below.
                     trBiCase ra f ft st
-                trty = st `arrow` (maybe st (flip AppT st) mty)
 
             cs <- if ft == st then do
                       b <- contains' ft st
                       if b then do
                           g <- newNameU "_g"
                           gcs <- mkRec
-                          let dg = [SigD g trty, FunD g gcs]
+                          let dg = FunD g gcs
                           -- Insert with a dummy type, just to get the definition in the map for mElems.
-                          modify $ \ (n', m', c') -> (n', mInsert (ConT g) dg m', c')
+                          modify $ \ (m', c') -> (mInsert (ConT g) dg m', c')
                           x <- newNameU "_x"
                           return [Clause [VarP x] (NormalB $ rbind f (AppE (VarE g) (VarE x))) []]
                        else do
@@ -327,8 +396,8 @@
                        else do
                           x <- newNameU "_x"
                           return [Clause [VarP x] (NormalB $ ret $ VarE x) []]
-            let d = [SigD tr trty, FunD tr cs]
-            modify $ \ (n', m', c') -> (n', mInsert st d m', c')
+            let d = FunD tr cs
+            modify $ \ (m', c') -> (mInsert st d m', c')
             return $ VarE tr
 
 trBiCase :: RetAp -> Exp -> Type -> Type -> U [Clause]
@@ -350,7 +419,7 @@
 trBiTuple :: RetAp -> Exp -> Type -> Type -> [Type] -> U [Clause]
 trBiTuple ra f ft st ts = do
     vs <- mapM (const $ newNameU "_t") ts
-    let tupE = LamE (map VarP vs) $ ListE (map VarE vs)
+    let tupE = LamE (map VarP vs) $ TupE (map VarE vs)
     c <- trMkArm ra f ft st [] TupP tupE ts
     return [c]
 
@@ -366,16 +435,15 @@
     mapM genArm cons
 
 trMkArm :: RetAp -> Exp -> Type -> Type -> Subst -> ([Pat] -> Pat) -> Exp -> [Type] -> U Clause
-trMkArm ra@(mty, ret, apl, _) f ft st s c ec ts = do
+trMkArm ra@(ret, apl, _) f ft st s c ec ts = do
     vs <- mapM (const $ newNameU "_x") ts
     let sub v t = do
             let t' = subst s t
             tr <- trBi ra f ft t'
-            return $ AppE tr (VarE v {- `SigE` t' -}) {- `SigE` mnd t' -}
-        mnd x = maybe x (flip AppT x) mty
+            return $ AppE tr (VarE v)
         conTy = foldr arrow st (map (subst s) ts)
     es <- zipWithM sub vs ts
-    let body = foldl apl (ret ec {- `SigE` mnd conTy -}) es
+    let body = foldl apl (ret ec) es
     return $ Clause [c (map VarP vs)] (NormalB body) []
 
 
diff --git a/examples/Main.hs b/examples/Main.hs
--- a/examples/Main.hs
+++ b/examples/Main.hs
@@ -1,6 +1,5 @@
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses #-}
 module Main where
---import Control.Monad
 import Data.Generics.Geniplate
 
 data T a = T { x :: Int, y :: a } deriving (Show)
@@ -9,69 +8,44 @@
 
 tree x = Bin (Bin (MT True) x True (MT False)) x False (MT True)
 
-uni :: [(Maybe Int, T Int, [Double])] -> [Int]
-uni = $(universeBi 'uni)
-
-uniT :: [(Maybe Int, T Int, [Double])] -> [Int]
-uniT = $(universeBiT [ [t|Maybe Int|] ] 'uniT)
-
-uni2 :: [B Bool] -> [Int]
-uni2 = $(universeBi 'uni2)
-
-uni3 :: [B Bool] -> [Bool]
-uni3 = $(universeBi 'uni3)
-
-uni4 :: B Char -> [B Char]
-uni4 = $(universeBi 'uni4)
-
-uni5 :: [Int] -> [[Int]]
-uni5 = $(universeBi 'uni5)
-
-trans :: (Int -> Int) -> [(Bool,T String)] -> [(Bool,T String)]
-trans = $(transformBi 'trans)
-
-trans1 :: (Bool -> Bool) -> B Char -> B Char
-trans1 = $(transformBi 'trans1)
-
-trans2 :: (Bool -> Bool) -> B Bool -> B Bool
-trans2 = $(transformBi 'trans2)
-
-trans4 :: (B Char -> B Char) -> B Char -> B Char
-trans4 = $(transformBi 'trans4)
-
-trans5 :: (Int -> Maybe Int) -> [Int] -> Maybe [Int]
-trans5 = $(transformBiM 'trans5)
-
-trans6 :: (Int -> Maybe Int) -> [(Int, Bool)] -> Maybe [(Int, Bool)]
-trans6 = $(transformBiM 'trans6)
-
-trans7 :: (Int -> IO Int) -> B Int -> IO (B Int)
-trans7 = $(transformBiM 'trans7)
+instanceUniverseBi [t| [(Maybe Int, T Int, [Double])] |] [t| Int |]
+instanceUniverseBiT [ [t|Maybe Int|] ] [t| [(Maybe Int, T Int, [Float])] |] [t| Int |]
+instanceUniverseBi [t| [B Bool] |] [t| Int |]
+instanceUniverseBi [t| [B Bool] |] [t| Bool |]
+instanceUniverseBi [t| B Char |] [t| B Char |]
+instanceUniverseBi [t| [Int] |] [t| [Int] |]
 
-trans8 :: (Bool -> IO Bool) -> B Bool -> IO (B Bool)
-trans8 = $(transformBiM 'trans8)
+instanceTransformBi [t| Int |] [t| [(Bool,T String)] |]
+instanceTransformBi [t| Bool |] [t| B Char |]
+instanceTransformBi [t| Bool |] [t| B Bool |]
+instanceTransformBi [t| B Char |] [t| B Char |]
 
-trans9 :: (B Char -> IO (B Char)) -> B Char -> IO (B Char)
-trans9 = $(transformBiM 'trans9)
+instanceTransformBiM [t| Maybe |] [t| Int |] [t| [Int] |]
+instanceTransformBiM [t| Maybe |] [t| Int |] [t| [(Int,Bool)] |]
+instanceTransformBiM [t| IO |] [t| Int |] [t| B Int |]
+instanceTransformBiM [t| IO |] [t| Bool |] [t| B Bool |]
+instanceTransformBiM [t| IO |] [t| B Char |] [t| B Char |]
 
 main :: IO ()
 main = do
-    print $ uni  [(Just 12, T 1 2, [1.1]), (Just 345, T 3 4, [2.2]), (Nothing, T 5 6, [3.3])]
-    print $ uniT [(Just 12, T 1 2, [1.1]), (Just 345, T 3 4, [2.2]), (Nothing, T 5 6, [3.3])]
-    print $ uni2 $ [tree True, tree False]
-    print $ uni3 $ [tree True, tree False]
-    print $ trans (+1) [(True,T 1 "a"), (False,T 2 "b")]
-    print $ trans1 not $ tree 'a'
-    print $ trans2 not $ tree True
-    print $ uni4 $ tree 'a'
-    let f (MT b) = MT (not b)
+    print (universeBi [(Just (12::Int), T 1 (2::Int), [1.1::Double]), (Just 345, T 3 4, [2.2]), (Nothing, T 5 6, [3.3])] :: [Int])
+    print (universeBi [(Just (12::Int), T 1 (2::Int), [1.1::Float]),  (Just 345, T 3 4, [2.2]), (Nothing, T 5 6, [3.3])] :: [Int])
+    print (universeBi [tree True, tree False] :: [Int])
+    print (universeBi [tree True, tree False] :: [Bool])
+    print (universeBi (tree 'a') :: [B Char])
+    print (universeBi [1,2::Int] :: [[Int]])
+
+    print $ transformBi ((+1) :: Int->Int) [(True,T 1 "a"), (False,T 2 "b")]
+    print $ transformBi not $ tree 'a'
+    print $ transformBi not $ tree True
+    let f (MT b) = MT b
         f (Bin t1 x b t2) = Bin t1 x (not b) t2
-    print $ trans4 f $ tree 'a'
-    print $ uni5 [1,2]
-    print $ trans5 Just [1,2,3]
-    print $ trans5 (\ x -> if x==2 then Nothing else Just x) [1,2,3]
-    print $ trans6 Just [(1, True)]
-    trans7 (\ x -> do print x; return (x+100)) (tree 3) >>= print
-    trans8 (\ x -> do print x; return (not x)) (tree True) >>= print
-    trans9 (\ x -> do print x; return x) (tree 'a') >>= print
+    print $ transformBi (f :: B Char -> B Char) $ tree 'a'
+
+    print $ transformBiM (Just :: Int -> Maybe Int) [1::Int,2,3]
+    print $ transformBiM (\ x -> if x==(2::Int) then Nothing else Just x) [1::Int,2,3]
+    print $ transformBiM (Just :: Int -> Maybe Int) [(1::Int, True)]
+    transformBiM (\ x -> do print (x::Int); return (x+100::Int)) (tree (3::Int)) >>= print
+    transformBiM (\ x -> do print (x::Bool); return (not x)) (tree True) >>= print
+    transformBiM (\ x -> do print (x::B Char); return x) (tree 'a') >>= print
 
diff --git a/geniplate.cabal b/geniplate.cabal
--- a/geniplate.cabal
+++ b/geniplate.cabal
@@ -1,6 +1,6 @@
 Name:           geniplate
 Cabal-Version:  >= 1.2
-Version:        0.4.0.1
+Version:        0.5.0.0
 License:        BSD3
 Author:         Lennart Augustsson
 Maintainer:     Lennart Augustsson