diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,13 @@
+4.11
+-----
+* Pass Monad[FreeT].fail into underlying monad
+* Add `retractT`.
+* Added `cutoff` for the church encoded free monad.
+* `cutoff` now accepts negative numbers.
+* Added `intersperseT` and `intercalateT`.
+* Added `foldFree` and `foldF`.
+* Added some new `template-haskell` toys.
+
 4.10.0.1
 ------
 * Fix for very old `cabal` versions where the `MIN_VERSION_foo` macros aren't negation friendly.
diff --git a/examples/RetryTH.hs b/examples/RetryTH.hs
--- a/examples/RetryTH.hs
+++ b/examples/RetryTH.hs
@@ -13,13 +13,9 @@
 
 -- | A data type representing basic commands for a retriable eDSL.
 data RetryF next where
-  -- | Simple output command.
   Output    :: String -> next -> RetryF next
-  -- | Get anything readable from input.
   Input     :: Read a => (a -> next) -> RetryF next
-  -- | Declare a retriable block.
   WithRetry :: Retry a -> (a -> next) -> RetryF next
-  -- | Force retry command (retries innermost retriable block).
   Retry     :: RetryF next
 
 -- | Unfortunately this Functor instance cannot yet be derived
@@ -33,8 +29,20 @@
 -- | The monad for a retriable eDSL.
 type Retry = Free RetryF
 
--- automacally generate convenience functions
-makeFree ''RetryF
+-- | Simple output command.
+makeFreeCon 'Output
+
+-- | Get anything readable from input.
+makeFreeCon 'Input
+
+-- | Force retry command (retries innermost retriable block).
+makeFreeCon 'Retry
+
+makeFreeCon_ 'WithRetry
+-- | Run a retryable block.
+withRetry :: MonadFree RetryF m =>
+             Retry a  -- ^ Computation to retry.
+          -> m a      -- ^ Computation that retries until succeeds.
 
 -- The following functions have been made available:
 --
diff --git a/free.cabal b/free.cabal
--- a/free.cabal
+++ b/free.cabal
@@ -1,6 +1,6 @@
 name:          free
 category:      Control, Monads
-version:       4.10.0.1
+version:       4.11
 license:       BSD3
 cabal-version: >= 1.10
 license-file:  LICENSE
diff --git a/src/Control/Monad/Free.hs b/src/Control/Monad/Free.hs
--- a/src/Control/Monad/Free.hs
+++ b/src/Control/Monad/Free.hs
@@ -13,7 +13,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Monad.Free
--- Copyright   :  (C) 2008-2014 Edward Kmett
+-- Copyright   :  (C) 2008-2015 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
@@ -30,6 +30,7 @@
   , iter
   , iterM
   , hoistFree
+  , foldFree
   , toFreeT
   , cutoff
   , _Pure, _Free
@@ -309,6 +310,11 @@
 hoistFree _ (Pure a)  = Pure a
 hoistFree f (Free as) = Free (hoistFree f <$> f as)
 
+-- | The very definition of a free monoid is that given a natural transformation you get a monoid homomorphism.
+foldFree :: (Functor m, Monad m) => (forall x . f x -> m x) -> Free f a -> m a
+foldFree _ (Pure a)  = return a
+foldFree f (Free as) = f as >>= foldFree f
+
 -- | Convert a 'Free' monad from "Control.Monad.Free" to a 'FreeT.FreeT' monad
 -- from "Control.Monad.Trans.Free".
 toFreeT :: (Functor f, Monad m) => Free f a -> FreeT.FreeT f m a
@@ -329,7 +335,7 @@
 -- Calling 'retract . cutoff n' is always terminating, provided each of the
 -- steps in the iteration is terminating.
 cutoff :: (Functor f) => Integer -> Free f a -> Free f (Maybe a)
-cutoff 0 _ = return Nothing
+cutoff n _ | n <= 0 = return Nothing
 cutoff n (Free f) = Free $ fmap (cutoff (n - 1)) f
 cutoff _ m = Just <$> m
 
diff --git a/src/Control/Monad/Free/Church.hs b/src/Control/Monad/Free/Church.hs
--- a/src/Control/Monad/Free/Church.hs
+++ b/src/Control/Monad/Free/Church.hs
@@ -10,7 +10,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Monad.Free.Church
--- Copyright   :  (C) 2011-2012 Edward Kmett
+-- Copyright   :  (C) 2011-2015 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
@@ -60,14 +60,17 @@
   , toF
   , retract
   , hoistF
+  , foldF
   , MonadFree(..)
   , liftF
+  , cutoff
   ) where
 
 import Control.Applicative
 import Control.Monad as Monad
 import Control.Monad.Fix
-import Control.Monad.Free hiding (retract, iterM)
+import Control.Monad.Free hiding (retract, iterM, cutoff)
+import qualified Control.Monad.Free as Free
 import Control.Monad.Reader.Class
 import Control.Monad.Writer.Class
 import Control.Monad.Cont.Class
@@ -98,6 +101,7 @@
   pure a = F (\kp _ -> kp a)
   F f <*> F g = F (\kp kf -> f (\a -> g (kp . a) kf) kf)
 
+-- | This violates the Alternative laws, handle with care.
 instance Alternative f => Alternative (F f) where
   empty = F (\_ kf -> kf empty)
   F f <|> F g = F (\kp kf -> kf (pure (f kp kf) <|> pure (g kp kf)))
@@ -123,6 +127,7 @@
     {-# INLINE foldl' #-}
 #endif
 
+-- | This violates the MonadPlus laws, handle with care.
 instance MonadPlus f => MonadPlus (F f) where
   mzero = F (\_ kf -> kf mzero)
   F f `mplus` F g = F (\kp kf -> kf (return (f kp kf) `mplus` return (g kp kf)))
@@ -164,6 +169,10 @@
 hoistF :: (forall x. f x -> g x) -> F f a -> F g a
 hoistF t (F m) = F (\p f -> m p (f . t))
 
+-- | The very definition of a free monoid is that given a natural transformation you get a monoid homomorphism.
+foldF :: Monad m => (forall x. f x -> m x) -> F f a -> m a
+foldF f (F m) = m return (Monad.join . f)
+
 -- | Convert to another free monad representation.
 fromF :: MonadFree f m => F f a -> m a
 fromF (F m) = m return wrap
@@ -187,3 +196,21 @@
 improve :: Functor f => (forall m. MonadFree f m => m a) -> Free f a
 improve m = fromF m
 {-# INLINE improve #-}
+
+
+-- | Cuts off a tree of computations at a given depth.
+-- If the depth is 0 or less, no computation nor
+-- monadic effects will take place.
+--
+-- Some examples (@n ≥ 0@):
+--
+-- prop> cutoff 0     _        == return Nothing
+-- prop> cutoff (n+1) . return == return . Just
+-- prop> cutoff (n+1) . lift   == lift . liftM Just
+-- prop> cutoff (n+1) . wrap   == wrap . fmap (cutoff n)
+--
+-- Calling @'retract' . 'cutoff' n@ is always terminating, provided each of the
+-- steps in the iteration is terminating.
+cutoff :: (Functor f) => Integer -> F f a -> F f (Maybe a)
+cutoff n = toF . Free.cutoff n . fromF
+
diff --git a/src/Control/Monad/Free/Class.hs b/src/Control/Monad/Free/Class.hs
--- a/src/Control/Monad/Free/Class.hs
+++ b/src/Control/Monad/Free/Class.hs
@@ -6,10 +6,11 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE TypeFamilies #-}
 #endif
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Monad.Free.Class
--- Copyright   :  (C) 2008-2011 Edward Kmett
+-- Copyright   :  (C) 2008-2015 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 --
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
diff --git a/src/Control/Monad/Free/TH.hs b/src/Control/Monad/Free/TH.hs
--- a/src/Control/Monad/Free/TH.hs
+++ b/src/Control/Monad/Free/TH.hs
@@ -14,10 +14,15 @@
 module Control.Monad.Free.TH
   (
    -- * Free monadic actions
-   makeFree
+   makeFree,
+   makeFree_,
+   makeFreeCon,
+   makeFreeCon_,
+
+   -- * Documentation
    -- $doc
 
-   -- ** Examples
+   -- * Examples
    -- $examples
   ) where
 
@@ -132,8 +137,8 @@
 unifyCaptured _ [x, y]   = unifyT x y
 unifyCaptured _ _ = fail "can't unify more than 2 arguments that use type parameter"
 
-liftCon' :: [TyVarBndr] -> Cxt -> Type -> Name -> [Name] -> Name -> [Type] -> Q [Dec]
-liftCon' tvbs cx f n ns cn ts = do
+liftCon' :: Bool -> [TyVarBndr] -> Cxt -> Type -> Name -> [Name] -> Name -> [Type] -> Q [Dec]
+liftCon' typeSig tvbs cx f n ns cn ts = do
   -- prepare some names
   opName <- mkName <$> mkOpName (nameBase cn)
   m      <- newName "m"
@@ -157,43 +162,124 @@
       q = tvbs ++ map PlainTV (qa ++ m : ns)
       qa = case retType of VarT b | a == b -> [a]; _ -> []
       f' = foldl AppT f (map VarT ns)
-  return
+  return $ concat
+    [ if typeSig
 #if MIN_VERSION_template_haskell(2,10,0)
-    [ SigD opName (ForallT q (cx ++ [ConT monadFree `AppT` f' `AppT` VarT m]) opType)
+        then [ SigD opName (ForallT q (cx ++ [ConT monadFree `AppT` f' `AppT` VarT m]) opType) ]
 #else
-    [ SigD opName (ForallT q (cx ++ [ClassP monadFree [f', VarT m]]) opType)
+        then [ SigD opName (ForallT q (cx ++ [ClassP monadFree [f', VarT m]]) opType) ]
 #endif
-    , FunD opName [ Clause pat (NormalB $ AppE (VarE liftF) fval) [] ] ]
+        else []
+    , [ FunD opName [ Clause pat (NormalB $ AppE (VarE liftF) fval) [] ] ] ]
 
 -- | Provide free monadic actions for a single value constructor.
-liftCon :: [TyVarBndr] -> Cxt -> Type -> Name -> [Name] -> Con -> Q [Dec]
-liftCon ts cx f n ns con =
+liftCon :: Bool -> [TyVarBndr] -> Cxt -> Type -> Name -> [Name] -> Con -> Q [Dec]
+liftCon typeSig ts cx f n ns con =
   case con of
-    NormalC cName fields -> liftCon' ts cx f n ns cName $ map snd fields
-    RecC    cName fields -> liftCon' ts cx f n ns cName $ map (\(_, _, ty) -> ty) fields
-    InfixC  (_,t1) cName (_,t2) -> liftCon' ts cx f n ns cName [t1, t2]
-    ForallC ts' cx' con' -> liftCon (ts ++ ts') (cx ++ cx') f n ns con'
+    NormalC cName fields -> liftCon' typeSig ts cx f n ns cName $ map snd fields
+    RecC    cName fields -> liftCon' typeSig ts cx f n ns cName $ map (\(_, _, ty) -> ty) fields
+    InfixC  (_,t1) cName (_,t2) -> liftCon' typeSig ts cx f n ns cName [t1, t2]
+    ForallC ts' cx' con' -> liftCon typeSig (ts ++ ts') (cx ++ cx') f n ns con'
 
 -- | Provide free monadic actions for a type declaration.
-liftDec :: Dec -> Q [Dec]
-liftDec (DataD _ tyName tyVarBndrs cons _)
+liftDec :: Bool             -- ^ Include type signature?
+        -> Maybe [Name]     -- ^ Include only mentioned constructor names. Use all constructors when @Nothing@.
+        -> Dec              -- ^ Data type declaration.
+        -> Q [Dec]
+liftDec typeSig onlyCons (DataD _ tyName tyVarBndrs cons _)
   | null tyVarBndrs = fail $ "Type " ++ show tyName ++ " needs at least one free variable"
-  | otherwise = concat <$> mapM (liftCon [] [] con nextTyName (init tyNames)) cons
+  | otherwise = concat <$> mapM (liftCon typeSig [] [] con nextTyName (init tyNames)) cons'
     where
+      cons' = case onlyCons of
+                Nothing -> cons
+                Just ns -> filter (\c -> constructorName c `elem` ns) cons
       tyNames    = map tyVarBndrName tyVarBndrs
       nextTyName = last tyNames
       con        = ConT tyName
-liftDec dec = fail $ "liftDec: Don't know how to lift " ++ show dec
+liftDec _ _ dec = fail $ "liftDec: Don't know how to lift " ++ show dec
 
--- | @$(makeFree ''Type)@ provides free monadic actions for the
--- constructors of the given type.
-makeFree :: Name -> Q [Dec]
-makeFree tyCon = do
+-- | Get construstor name.
+constructorName :: Con -> Name
+constructorName (NormalC  name _)   = name
+constructorName (RecC     name _)   = name
+constructorName (InfixC   _ name _) = name
+constructorName (ForallC  _ _ c)    = constructorName c
+
+-- | Generate monadic actions for a data type.
+genFree :: Bool         -- ^ Include type signature?
+        -> Maybe [Name] -- ^ Include only mentioned constructor names. Use all constructors when @Nothing@.
+        -> Name         -- ^ Type name.
+        -> Q [Dec]      -- ^ Generated declarations.
+genFree typeSig cnames tyCon = do
   info <- reify tyCon
   case info of
-    TyConI dec -> liftDec dec
+    TyConI dec -> liftDec typeSig cnames dec
     _ -> fail "makeFree expects a type constructor"
 
+-- | Generate monadic action for a single constructor of a data type.
+genFreeCon :: Bool         -- ^ Include type signature?
+           -> Name         -- ^ Constructor name.
+           -> Q [Dec]      -- ^ Generated declarations.
+genFreeCon typeSig cname = do
+  info <- reify cname
+  case info of
+    DataConI _ _ tname _ -> genFree typeSig (Just [cname]) tname
+    _ -> fail "makeFreeCon expects a data constructor"
+
+-- | @$('makeFree' ''T)@ provides free monadic actions for the
+-- constructors of the given data type @T@.
+makeFree :: Name -> Q [Dec]
+makeFree = genFree True Nothing
+
+-- | Like 'makeFreeCon', but does not provide type signatures.
+-- This can be used to attach Haddock comments to individual arguments
+-- for each generated function.
+--
+-- @
+-- data LangF x = Output String x
+--
+-- makeFree_ 'LangF
+--
+-- -- | Output a string.
+-- output :: MonadFree LangF m =>
+--           String   -- ^ String to output.
+--        -> m ()     -- ^ No result.
+-- @
+--
+-- 'makeFree_' must be called *before* the explicit type signatures.
+makeFree_ :: Name -> Q [Dec]
+makeFree_ = genFree False Nothing
+
+-- | @$('makeFreeCon' 'Con)@ provides free monadic action for a data
+-- constructor @Con@. Note that you can attach Haddock comment to the
+-- generated function by placing it before the top-level invocation of
+-- 'makeFreeCon':
+--
+-- @
+-- -- | Output a string.
+-- makeFreeCon 'Output
+-- @
+makeFreeCon :: Name -> Q [Dec]
+makeFreeCon = genFreeCon True
+
+-- | Like 'makeFreeCon', but does not provide a type signature.
+-- This can be used to attach Haddock comments to individual arguments.
+--
+-- @
+-- data LangF x = Output String x
+--
+-- makeFreeCon_ 'Output
+--
+-- -- | Output a string.
+-- output :: MonadFree LangF m =>
+--           String   -- ^ String to output.
+--        -> m ()     -- ^ No result.
+-- @
+--
+-- 'makeFreeCon_' must be called *before* the explicit type signature.
+makeFreeCon_ :: Name -> Q [Dec]
+makeFreeCon_ = genFreeCon False
+
 {- $doc
  To generate free monadic actions from a @Type@, it must be a @data@
  declaration (maybe GADT) with at least one free variable. For each constructor of the type, a
@@ -247,7 +333,7 @@
        @a@ is a fresh type variable.
 
      2. If only one argument in the constructor depends on @param@, then
-       @ret ≡ (s1, …, sM)@. In particular, f @M == 0@, then @ret ≡ ()@; if @M == 1@, @ret ≡ s1@.
+       @ret ≡ (s1, …, sM)@. In particular, if @M == 0@, then @ret ≡ ()@; if @M == 1@, @ret ≡ s1@.
 
      3. If two arguments depend on @param@, (e.g. @u1 -> … -> uL -> param@ and
        @v1 -> … -> vM -> param@, then @ret ≡ Either (u1, …, uL) (v1, …, vM)@.
diff --git a/src/Control/Monad/Trans/Free.hs b/src/Control/Monad/Trans/Free.hs
--- a/src/Control/Monad/Trans/Free.hs
+++ b/src/Control/Monad/Trans/Free.hs
@@ -40,6 +40,10 @@
   , hoistFreeT
   , transFreeT
   , cutoff
+  , partialIterT
+  , intersperseT
+  , intercalateT
+  , retractT
   -- * Operations of free monad
   , retract
   , iter
@@ -210,6 +214,7 @@
   (>>-) = (>>=)
 
 instance (Functor f, Monad m) => Monad (FreeT f m) where
+  fail e = FreeT (fail e)
   return a = FreeT (return (Pure a))
   {-# INLINE return #-}
   FreeT m >>= f = FreeT $ m >>= \v -> case v of
@@ -349,8 +354,64 @@
 -- Calling @'retract' '.' 'cutoff' n@ is always terminating, provided each of the
 -- steps in the iteration is terminating.
 cutoff :: (Functor f, Monad m) => Integer -> FreeT f m a -> FreeT f m (Maybe a)
-cutoff 0 _ = return Nothing
+cutoff n _ | n <= 0 = return Nothing
 cutoff n (FreeT m) = FreeT $ bimap Just (cutoff (n - 1)) `liftM` m
+
+-- | @partialIterT n phi m@ interprets first @n@ layers of @m@ using @phi@.
+-- This is sort of the opposite for @'cutoff'@.
+--
+-- Some examples (@n ≥ 0@):
+--
+-- @
+-- 'partialIterT' 0 _ m              ≡ m
+-- 'partialIterT' (n+1) phi '.' 'return' ≡ 'return'
+-- 'partialIterT' (n+1) phi '.' 'lift'   ≡ 'lift'
+-- 'partialIterT' (n+1) phi '.' 'wrap'   ≡ 'join' . 'lift' . phi
+-- @
+partialIterT :: Monad m => Integer -> (forall a. f a -> m a) -> FreeT f m b -> FreeT f m b
+partialIterT n phi m
+  | n <= 0 = m
+  | otherwise = FreeT $ do
+      val <- runFreeT m
+      case val of
+        Pure a -> return (Pure a)
+        Free f -> phi f >>= runFreeT . partialIterT (n - 1) phi
+
+-- | @intersperseT f m@ inserts a layer @f@ between every two layers in
+-- @m@.
+--
+-- @
+-- 'intersperseT' f '.' 'return' ≡ 'return'
+-- 'intersperseT' f '.' 'lift'   ≡ 'lift'
+-- 'intersperseT' f '.' 'wrap'   ≡ 'wrap' '.' 'fmap' ('iterTM' ('wrap' '.' ('<$' f) '.' 'wrap'))
+-- @
+intersperseT :: (Monad m, Functor f) => f a -> FreeT f m b -> FreeT f m b
+intersperseT f (FreeT m) = FreeT $ do
+  val <- m
+  case val of
+    Pure x -> return $ Pure x
+    Free y -> return . Free $ fmap (iterTM (wrap . (<$ f) . wrap)) y
+
+-- | Tear down a free monad transformer using Monad instance for @t m@.
+retractT :: (MonadTrans t, Monad (t m), Monad m) => FreeT (t m) m a -> t m a
+retractT (FreeT m) = do
+  val <- lift m
+  case val of
+    Pure x -> return x
+    Free y -> y >>= retractT
+
+-- | @intercalateT f m@ inserts a layer @f@ between every two layers in
+-- @m@ and then retracts the result.
+--
+-- @
+-- 'intercalateT' f ≡ 'retractT' . 'intersperseT' f
+-- @
+intercalateT :: (Monad m, MonadTrans t, Monad (t m), Functor (t m)) => t m a -> FreeT (t m) m b -> t m b
+intercalateT f (FreeT m) = do
+  val <- lift m
+  case val of
+    Pure x -> return x
+    Free y -> y >>= iterTM (\x -> f >> join x)
 
 #if __GLASGOW_HASKELL__ < 707
 instance Typeable1 f => Typeable2 (FreeF f) where
diff --git a/src/Control/Monad/Trans/Free/Church.hs b/src/Control/Monad/Trans/Free/Church.hs
--- a/src/Control/Monad/Trans/Free/Church.hs
+++ b/src/Control/Monad/Trans/Free/Church.hs
@@ -38,6 +38,7 @@
   , improve
   , fromF, toF
   , retract
+  , retractT
   , iter
   , iterM
   -- * Free Monads With Class
@@ -232,6 +233,10 @@
 retract :: (Functor f, Monad f) => F f a -> f a
 retract m = runF m return join
 {-# INLINE retract #-}
+
+-- | Tear down a free monad transformer using iteration over a transformer.
+retractT :: (MonadTrans t, Monad (t m), Monad m) => FT (t m) m a -> t m a
+retractT (FT m) = join . lift $ m (return . return) $ \x -> return $ x >>= join . lift
 
 -- | Tear down an 'F' 'Monad' using iteration.
 iter :: Functor f => (f a -> a) -> F f a -> a