diff --git a/Data/Generics/Geniplate.hs b/Data/Generics/Geniplate.hs
--- a/Data/Generics/Geniplate.hs
+++ b/Data/Generics/Geniplate.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE TemplateHaskell #-}
-module Data.Generics.Geniplate(universeBi, universeBiT, transformBi, transformBiT) where
+module Data.Generics.Geniplate(universeBi, universeBiT, transformBi, transformBiT, transformBiM, transformBiMT) where
+import Control.Monad
 import Control.Exception(assert)
 import Control.Monad.State.Strict
 import Data.Maybe
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax hiding (lift)
+import System.IO
 
 -- | 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
@@ -22,7 +24,7 @@
     (ds, f) <- uniBiQ stops from to
     x <- newName "_x"
     let e = LamE [VarP x] $ LetE ds $ AppE (AppE f (VarE x)) (ListE [])
---    qRunIO $ putStrLn $ pprint e
+    qRunIO $ do putStrLn $ pprint e; hFlush stdout
     return e
 
 type U = StateT (Map Type Dec, Map Type Bool) Q
@@ -95,6 +97,7 @@
          TupleT _  -> fmap or $ mapM (contains to) ts
          ArrowT    -> return False
          ListT     -> contains to (head ts)
+         VarT _    -> return False
          t         -> genError $ "contains: unexpected type: " ++ pprint from ++ " (" ++ show t ++ ")"
     modify $ \ (m, c) -> (m, mInsert from b c)
     return b
@@ -184,6 +187,7 @@
     info <- qReify con
     case info of
         TyConI (DataD _ _ tvs cs _) -> return (tvs, cs)
+        TyConI (NewtypeD _ _ tvs c _) -> return (tvs, [c])
         PrimTyConI{} -> return ([], [])
         i -> genError $ "unexpected TyCon: " ++ show i
 
@@ -242,27 +246,41 @@
 -- | Same as 'transformBi', but does not look inside any types mention in the
 -- list of types.
 transformBiT :: [TypeQ] -> Name -> Q Exp
-transformBiT stops name = do
+transformBiT = transformBiG False (id, AppE)
+
+transformBiM :: Name -> Q Exp
+transformBiM = transformBiMT []
+
+transformBiMT :: [TypeQ] -> Name -> Q Exp
+transformBiMT = transformBiG True (eret, eap)
+  where eret e = AppE (VarE 'Control.Monad.return) e
+        eap f a = AppE (AppE (VarE 'Control.Monad.ap) f) a
+
+type RetAp = (Exp -> Exp, Exp -> Exp -> Exp)
+
+transformBiG :: Bool -> RetAp -> [TypeQ] -> Name -> Q Exp
+transformBiG monad ra stops name = do
     (_tvs, fcn, res) <- getNameType name
     f <- newName "_f"
     (ds, tr) <-
         case (fcn, res) of
-            (AppT (AppT ArrowT s) s', AppT (AppT ArrowT t) t') | s == s' && t == t' -> trBiQ stops f s t
+            (AppT (AppT ArrowT s) s', AppT (AppT ArrowT t) t') | not monad && s == s' && t == t' -> trBiQ ra stops f s t
+            (AppT (AppT ArrowT s) (AppT m s'), AppT (AppT ArrowT t) (AppT m' t')) | monad && 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)"
     x <- newName "_x"
     let e = LamE [VarP f, VarP x] $ LetE ds $ AppE tr (VarE x)
---    qRunIO $ putStrLn $ pprint e
+    qRunIO $ do putStrLn $ pprint e; hFlush stdout
     return e
 
-trBiQ :: [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
-trBiQ 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 (VarE f) ft st) (mEmpty, mFromList $ zip ss (repeat False))
+    (tr, (m, _)) <- runStateT (trBi ra (VarE f) ft st) (mEmpty, mFromList $ zip ss (repeat False))
     return (mElems m, tr)
 
-trBi :: Exp -> Type -> Type -> U Exp
-trBi f ft ast = do
+trBi :: RetAp -> Exp -> Type -> Type -> U Exp
+trBi ra f ft ast = do
     (m, c) <- get
     st <- lift $ expandSyn ast
 --    lift $ qRunIO $ print (ft, st)
@@ -272,7 +290,7 @@
             tr <- lift $ newName "_tr"
             let mkRec = do
                     put (mInsert st (FunD tr [Clause [] (NormalB $ TupE []) []]) m, c)  -- insert something to break recursion, will be replaced below.
-                    trBiCase f ft st
+                    trBiCase ra f ft st
 
             cs <- if ft == st then do
                       b <- contains' ft st
@@ -296,45 +314,54 @@
             modify $ \ (m', c') -> (mInsert st d m', c')
             return $ VarE tr
 
-trBiCase :: Exp -> Type -> Type -> U [Clause]
-trBiCase f ft st = do
+trBiCase :: RetAp -> Exp -> Type -> Type -> U [Clause]
+trBiCase ra f ft st = do
     let (con, ts) = splitTypeApp st
     case con of
-        ConT n    -> trBiCon f n ft ts
-        TupleT _  -> trBiTuple f ft ts
+        ConT n    -> trBiCon ra f n ft ts
+        TupleT _  -> trBiTuple ra f ft ts
 --        ArrowT    -> lift $ fmap unFunD [d| f _ _r = _r |]           -- Stop at functions
-        ListT     -> trBiList f ft (head ts)
+        ListT     -> trBiList ra f ft (head ts)
         _         -> genError $ "trBiCase: unexpected type: " ++ pprint st ++ " (" ++ show st ++ ")"
 
-trBiList :: Exp -> Type -> Type -> U [Clause]
-trBiList f ft st = do
-    tr <- trBi f ft st
-    rec <- trBi f ft (AppT ListT st)
+trBiList :: RetAp -> Exp -> Type -> Type -> U [Clause]
+trBiList ra f ft st = do
+    nil <- trMkArm ra f ft [] (const $ ListP []) (ListE []) []
+    cons <- trMkArm ra f ft [] (ConP '(:)) (ConE '(:)) [st, AppT ListT st]
+    return [nil, cons]
+{-
+    tr <- trBi ra f ft st
+    rec <- trBi ra f ft (AppT ListT st)
     lift $ fmap unFunD [d| _f [] = []; _f (_x:_xs) = ($(return tr) _x) : ($(return rec) _xs) |]
+-}
 
-trBiTuple :: Exp -> Type -> [Type] -> U [Clause]
-trBiTuple f ft ts = fmap (:[]) $ trMkArm f ft [] TupP TupE ts
+trBiTuple :: RetAp -> Exp -> Type -> [Type] -> U [Clause]
+trBiTuple ra f ft ts = do
+    vs <- mapM (const $ lift $ newName "t") ts
+    let tupE = LamE (map VarP vs) $ ListE (map VarE vs)
+    c <- trMkArm ra f ft [] TupP tupE ts
+    return [c]
 
-trBiCon :: Exp -> Name -> Type -> [Type] -> U [Clause]
-trBiCon f con ft ts = do
+trBiCon :: RetAp -> Exp -> Name -> Type -> [Type] -> U [Clause]
+trBiCon ra f con ft ts = do
     (tvs, cons) <- lift $ getTyConInfo con
-    let genArm (NormalC c xs) = arm (ConP c) (foldl AppE $ ConE c) xs
-        genArm (InfixC x1 c x2) = arm (\ [p1, p2] -> InfixP p1 c p2) (\ [e1, e2] -> InfixE (Just e1) (ConE c) (Just e2)) [x1, x2]
-        genArm (RecC c xs) = arm (ConP c) (foldl AppE $ ConE c) [ (b,t) | (_,b,t) <- xs ]
+    let genArm (NormalC c xs) = arm (ConP c) (ConE c) xs
+        genArm (InfixC x1 c x2) = arm (\ [p1, p2] -> InfixP p1 c p2) (ConE c) [x1, x2]
+        genArm (RecC c xs) = arm (ConP c) (ConE c) [ (b,t) | (_,b,t) <- xs ]
         genArm c = genError $ "trBiCon: " ++ show c
         s = mkSubst tvs ts
-        arm c ec xs = trMkArm f ft s c ec $ map snd xs
+        arm c ec xs = trMkArm ra f ft s c ec $ map snd xs
     mapM genArm cons
 
-trMkArm :: Exp -> Type -> Subst -> ([Pat] -> Pat) -> ([Exp] -> Exp) -> [Type] -> U Clause
-trMkArm f ft s c ec ts = do
+trMkArm :: RetAp -> Exp -> Type -> Subst -> ([Pat] -> Pat) -> Exp -> [Type] -> U Clause
+trMkArm ra@(ret, apl) f ft s c ec ts = do
     vs <- mapM (const $ lift $ newName "_x") ts
     let sub v t = do
             let t' = subst s t
-            tr <- trBi f ft t'
+            tr <- trBi ra f ft t'
             return $ AppE tr (VarE v)
     es <- zipWithM sub vs ts
-    let body = ec 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,5 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Main where
+--import Control.Monad
 import Data.Generics.Geniplate
 
 data T a = T { x :: Int, y :: a } deriving (Show)
@@ -38,6 +39,8 @@
 trans4 :: (B Char -> B Char) -> B Char -> B Char
 trans4 = $(transformBi 'trans4)
 
+trans5 :: (Int -> Maybe Int) -> [Int] -> Maybe [Int]
+trans5 = $(transformBiM 'trans5)
 
 main :: IO ()
 main = do
@@ -53,3 +56,5 @@
         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]
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.3.0.0
+Version:        0.4.0.0
 License:        BSD3
 Author:         Lennart Augustsson
 Maintainer:     Lennart Augustsson