diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,8 @@
+4.5
+-----
+* Added `Control.Monad.Free.TH` with `makeFree` to make it easier to write free monads.
+* Added missing instances for `MonadFix` and `MonadCont` where appropriate.
+
 4.2
 -----
 * Added `Control.Monad.Trans.Iter` and `Control.Comonad.Trans.Coiter`.
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.4
+version:       4.5
 license:       BSD3
 cabal-version: >= 1.10
 license-file:  LICENSE
@@ -60,7 +60,8 @@
     profunctors          == 4.*,
     semigroupoids        == 4.*,
     semigroups           >= 0.8.3.1 && < 1,
-    transformers         >= 0.2.0   && < 0.4
+    transformers         >= 0.2.0   && < 0.4,
+    template-haskell     >= 2.7.0.0 && < 3
 
   if impl(ghc)
     cpp-options: -DGHC_TYPEABLE
@@ -75,7 +76,9 @@
     Control.Monad.Free
     Control.Monad.Free.Church
     Control.Monad.Free.Class
+    Control.Monad.Free.TH
     Control.Monad.Trans.Free
+    Control.Monad.Trans.Free.Church
     Control.Monad.Trans.Iter
     Control.MonadPlus.Free
 
diff --git a/src/Control/Comonad/Cofree.hs b/src/Control/Comonad/Cofree.hs
--- a/src/Control/Comonad/Cofree.hs
+++ b/src/Control/Comonad/Cofree.hs
@@ -39,6 +39,8 @@
 import Control.Comonad.Store.Class as Class
 import Control.Comonad.Traced.Class
 import Control.Category
+import Control.Monad(ap)
+import Control.Monad.Zip
 import Data.Functor.Bind
 import Data.Functor.Extend
 import Data.Distributive
@@ -135,6 +137,9 @@
   (a :< m) >>= k = case k a of
                      b :< n -> b :< (n <|> fmap (>>= k) m)
 
+instance (Alternative f, MonadZip f) => MonadZip (Cofree f) where
+  mzip (a :< as) (b :< bs) = (a, b) :< fmap (uncurry mzip) (mzip as bs)
+
 -- |
 --
 -- @'lower' . 'section' = 'id'@
@@ -157,14 +162,11 @@
   (_ :< fs)  @> (a :< as) = a :< (( @>) <$> fs <@> as)
   {-# INLINE (@>) #-}
 
-instance Applicative f => Applicative (Cofree f) where
-  pure a = as where as = a :< pure as
-  (f :< fs) <*> (a :< as) = f a :< ((<*>) <$> fs <*> as)
+instance Alternative f => Applicative (Cofree f) where
+  pure = return
+  {-# INLINE pure #-}
+  (<*>) = ap
   {-# INLINE (<*>) #-}
-  (f :< fs) <*  (_ :< as) = f :< ((<* ) <$> fs <*> as)
-  {-# INLINE (<*) #-}
-  (_ :< fs)  *> (a :< as) = a :< (( *>) <$> fs <*> as)
-  {-# INLINE (*>) #-}
 
 instance (Show (f (Cofree f a)), Show a) => Show (Cofree f a) where
   showsPrec d (a :< as) = showParen (d > 5) $
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
@@ -32,6 +32,7 @@
 
 import Control.Applicative
 import Control.Monad as Monad
+import Control.Monad.Fix
 import Control.Monad.Free hiding (retract, iterM)
 import Control.Monad.Reader.Class
 import Control.Monad.Writer.Class
@@ -71,6 +72,11 @@
 instance Monad (F f) where
   return a = F (\kp _ -> kp a)
   F m >>= f = F (\kp kf -> m (\a -> runF (f a) kp kf) kf)
+
+instance MonadFix (F f) where
+  mfix f = a where
+    a = f (impure a)
+    impure (F x) = x id (error "MonadFix (F f): wrap")
 
 instance MonadPlus f => MonadPlus (F f) where
   mzero = F (\_ kf -> kf mzero)
diff --git a/src/Control/Monad/Free/TH.hs b/src/Control/Monad/Free/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Free/TH.hs
@@ -0,0 +1,186 @@
+{-# LANGUAGE TemplateHaskell #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.TH
+-- Copyright   :  (C) 2008-2013 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  MPTCs, fundeps
+--
+-- Automatic generation of free monadic actions.
+--
+----------------------------------------------------------------------------
+module Control.Monad.Free.TH
+  ( makeFree
+  ) where
+
+import Control.Arrow
+import Control.Applicative
+import Control.Monad
+import Data.Char (toLower)
+import Language.Haskell.TH
+
+data Arg
+  = Captured Type Exp
+  | Param    Type
+  deriving (Show)
+
+params :: [Arg] -> [Type]
+params [] = []
+params (Param t : xs) = t : params xs
+params (_ : xs) = params xs
+
+captured :: [Arg] -> [(Type, Exp)]
+captured [] = []
+captured (Captured t e : xs) = (t, e) : captured xs
+captured (_ : xs) = captured xs
+
+zipExprs :: [Exp] -> [Exp] -> [Arg] -> [Exp]
+zipExprs (p:ps) cs (Param    _   : as) = p : zipExprs ps cs as
+zipExprs ps (c:cs) (Captured _ _ : as) = c : zipExprs ps cs as
+zipExprs _ _ _ = []
+
+tyVarBndrName :: TyVarBndr -> Name
+tyVarBndrName (PlainTV  name)   = name
+tyVarBndrName (KindedTV name _) = name
+
+findTypeOrFail :: String -> Q Name
+findTypeOrFail s = lookupTypeName s >>= maybe (fail $ s ++ " is not in scope") return
+
+findValueOrFail :: String -> Q Name
+findValueOrFail s = lookupValueName s >>= maybe (fail $ s ++ "is not in scope") return
+
+-- | Pick a name for an operation.
+-- For normal constructors it lowers first letter.
+-- For infix ones it omits the first @:@.
+mkOpName :: String -> Q String
+mkOpName (':':name) = return name
+mkOpName ( c :name) = return $ toLower c : name
+mkOpName _ = fail "null constructor name"
+
+-- | Check if parameter is used in type.
+usesTV :: Name -> Type -> Bool
+usesTV n (VarT name)  = n == name
+usesTV n (AppT t1 t2) = any (usesTV n) [t1, t2]
+usesTV n (SigT t  _ ) = usesTV n t
+usesTV n (ForallT bs _ t) = usesTV n t && n `notElem` map tyVarBndrName bs
+usesTV _ _ = False
+
+-- | Analyze constructor argument.
+mkArg :: Name -> Type -> Q Arg
+mkArg n t
+  | usesTV n t =
+      case t of
+        -- if parameter is used as is, the return type should be ()
+        -- as well as the corresponding expression
+        VarT _ -> return $ Captured (TupleT 0) (TupE [])
+        -- if argument is of type (a1 -> ... -> aN -> param) then the
+        -- return type is N-tuple (a1, ..., aN) and the corresponding
+        -- expression is an N-tuple secion (,...,).
+        AppT (AppT ArrowT _) _ -> do
+          (ts, name) <- arrowsToTuple t
+          when (name /= n) $ fail "return type is not the parameter"
+          let tup = foldl AppT (TupleT $ length ts) ts
+          xs <- mapM (const $ newName "x") ts
+          return $ Captured tup (LamE (map VarP xs) (TupE (map VarE xs)))
+        _ -> fail "don't know how to make Arg"
+  | otherwise = return $ Param t
+  where
+    arrowsToTuple (AppT (AppT ArrowT t1) (VarT name)) = return ([t1], name)
+    arrowsToTuple (AppT (AppT ArrowT t1) t2) = do
+      (ts, name) <- arrowsToTuple t2
+      return (t1:ts, name)
+    arrowsToTuple _ = fail "return type is not a variable"
+
+-- | Apply transformation to the return value independently of how many
+-- parameters does @e@ have.
+-- E.g. @mapRet Just (\x y z -> x + y * z)@ goes to
+-- @\x y z -> Just (x + y * z)@
+mapRet :: (Exp -> Exp) -> Exp -> Exp
+mapRet f (LamE ps e) = LamE ps $ mapRet f e
+mapRet f e = f e
+
+-- | Unification of two types.
+-- @next@ with @a -> next@ gives @Maybe a@ return type
+-- @a -> next@ with @b -> next@ gives @Either a b@ return type
+unifyT :: (Type, Exp) -> (Type, Exp) -> Q (Type, [Exp])
+unifyT (TupleT 0, _) (TupleT 0, _) = fail "can't accept 2 mere parameters"
+unifyT (TupleT 0, _) (t, e) = do
+  maybe'   <- ConT <$> findTypeOrFail  "Maybe"
+  nothing' <- ConE <$> findValueOrFail "Nothing"
+  just'    <- ConE <$> findValueOrFail "Just"
+  return $ (AppT maybe' t, [nothing', mapRet (AppE just') e])
+unifyT x y@(TupleT 0, _) = second reverse <$> unifyT y x
+unifyT (t1, e1) (t2, e2) = do
+  either' <- ConT <$> findTypeOrFail  "Either"
+  left'   <- ConE <$> findValueOrFail "Left"
+  right'  <- ConE <$> findValueOrFail "Right"
+  return $ (AppT (AppT either' t1) t2, [mapRet (AppE left') e1, mapRet (AppE right') e2])
+
+-- | Unifying a list of types (possibly refining expressions).
+-- Name is used when the return type is supposed to be arbitrary.
+unifyCaptured :: Name -> [(Type, Exp)] -> Q (Type, [Exp])
+unifyCaptured a []       = return (VarT a, [])
+unifyCaptured _ [(t, e)] = return (t, [e])
+unifyCaptured _ [x, y]   = unifyT x y
+unifyCaptured _ _ = fail "can't unify more than 2 arguments that use type parameter"
+
+liftCon' :: Type -> Name -> [Name] -> Name -> [Type] -> Q [Dec]
+liftCon' f n ns cn ts = do
+  -- prepare some names
+  opName <- mkName <$> mkOpName (nameBase cn)
+  m      <- newName "m"
+  a      <- newName "a"
+  monadFree <- findTypeOrFail  "MonadFree"
+  liftF     <- findValueOrFail "liftF"
+  -- look at the constructor parameters
+  args <- mapM (mkArg n) ts
+  let ps = params args    -- these are not using type parameter
+      cs = captured args  -- these capture it somehow
+  -- based on cs we get return type and refined expressions
+  -- (e.g. with Nothing/Just or Left/Right tags)
+  (retType, es) <- unifyCaptured a cs
+  -- operation type is (a1 -> a2 -> ... -> aN -> m r)
+  let opType  = foldr (AppT . AppT ArrowT) (AppT (VarT m) retType) ps
+  -- picking names for the implementation
+  xs  <- mapM (const $ newName "p") ps
+  let pat  = map VarP xs                      -- this is LHS
+      exprs = zipExprs (map VarE xs) es args  -- this is what ctor would be applied to
+      fval = foldl AppE (ConE cn) exprs       -- this is RHS without liftF
+      q = map PlainTV $ qa ++ m : ns
+      qa = case retType of VarT b | a == b -> [a]; _ -> []
+      f' = foldl AppT f (map VarT ns)
+  return $
+    [ SigD opName (ForallT q [ClassP monadFree [f', VarT m]] opType)
+    , FunD opName [ Clause pat (NormalB $ AppE (VarE liftF) fval) [] ] ]
+
+-- | Provide free monadic actions for a single value constructor.
+liftCon :: Type -> Name -> [Name] -> Con -> Q [Dec]
+liftCon f n ns con =
+  case con of
+    NormalC cName fields -> liftCon' f n ns cName $ map snd fields
+    RecC    cName fields -> liftCon' f n ns cName $ map (\(_, _, ty) -> ty) fields
+    _ -> fail $ "liftCon: Don't know how to lift " ++ show con
+
+-- | Provide free monadic actions for a type declaration.
+liftDec :: Dec -> Q [Dec]
+liftDec (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
+    where
+      tyNames    = map tyVarBndrName tyVarBndrs
+      nextTyName = last tyNames
+      con        = ConT tyName
+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
+  info <- reify tyCon
+  case info of
+    TyConI dec -> liftDec dec
+    _ -> fail "makeFree expects a type constructor"
+
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
@@ -34,6 +34,10 @@
   , iterT
   , hoistFreeT
   , transFreeT
+  -- * Operations of free monad
+  , retract
+  , iter
+  , iterM
   -- * Free Monads With Class
   , MonadFree(..)
   ) where
@@ -43,6 +47,10 @@
 import Control.Monad.Trans.Class
 import Control.Monad.Free.Class
 import Control.Monad.IO.Class
+import Control.Monad.Reader.Class
+import Control.Monad.State.Class
+import Control.Monad.Error.Class
+import Control.Monad.Cont.Class
 import Data.Monoid
 import Data.Foldable
 import Data.Functor.Identity
@@ -148,6 +156,30 @@
   liftIO = lift . liftIO
   {-# INLINE liftIO #-}
 
+instance (Functor f, MonadReader r m) => MonadReader r (FreeT f m) where
+  ask = lift ask
+  {-# INLINE ask #-}
+  local f = hoistFreeT (local f)
+  {-# INLINE local #-}
+
+instance (Functor f, MonadState s m) => MonadState s (FreeT f m) where
+  get = lift get
+  {-# INLINE get #-}
+  put = lift . put
+  {-# INLINE put #-}
+#if MIN_VERSION_mtl(2,1,1)
+  state f = lift (state f)
+  {-# INLINE state #-}
+#endif
+
+instance (Functor f, MonadError e m) => MonadError e (FreeT f m) where
+  throwError = lift . throwError
+  {-# INLINE throwError #-}
+  FreeT m `catchError` f = FreeT $ (liftM (fmap (`catchError` f)) m) `catchError` (runFreeT . f)
+
+instance (Functor f, MonadCont m) => MonadCont (FreeT f m) where
+  callCC f = FreeT $ callCC (\k -> runFreeT $ f (lift . k . Pure))
+
 instance (Functor f, MonadPlus m) => Alternative (FreeT f m) where
   empty = FreeT mzero
   FreeT ma <|> FreeT mb = FreeT (mplus ma mb)
@@ -186,6 +218,26 @@
 -- | Lift a natural transformation from @f@ to @g@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' g n@
 transFreeT :: (Monad m, Functor g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
 transFreeT nt = FreeT . liftM (fmap (transFreeT nt) . transFreeF nt) . runFreeT
+
+-- |
+-- 'retract' is the left inverse of 'liftF'
+--
+-- @
+-- 'retract' . 'liftF' = 'id'
+-- @
+retract :: Monad f => Free f a -> f a
+retract m =
+  case runIdentity (runFreeT m) of
+    Pure a  -> return a
+    Free as -> as >>= retract
+
+-- | Tear down a 'Free' 'Monad' using iteration.
+iter :: Functor f => (f a -> a) -> Free f a -> a
+iter phi = runIdentity . iterT (Identity . phi . fmap runIdentity)
+
+-- | Like 'iter' for monadic values.
+iterM :: (Functor f, Monad m) => (f (m a) -> m a) -> Free f a -> m a
+iterM phi = iterT phi . hoistFreeT (return . runIdentity)
 
 #if defined(GHC_TYPEABLE) && __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
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Trans/Free/Church.hs
@@ -0,0 +1,201 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Control.Monad.Trans.Free.Church
+  (
+  -- * The free monad transformer
+    FT(..)
+  -- * The free monad
+  , F, free, runF
+  -- * Operations
+  , toFT, fromFT
+  , iterT
+  , hoistFT
+  , transFT
+  -- * Operations of free monad
+  , improve
+  , fromF, toF
+  , retract
+  , iter
+  , iterM
+  -- * Free Monads With Class
+  , MonadFree(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Identity
+import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
+import Control.Monad.Reader.Class
+import Control.Monad.State.Class
+import Control.Monad.Error.Class
+import Control.Monad.Cont.Class
+import Control.Monad.Free.Class
+import Control.Monad.Trans.Free (FreeT(..), FreeF(..), Free)
+import Data.Foldable (Foldable)
+import qualified Data.Foldable as F
+import Data.Traversable (Traversable)
+import qualified Data.Traversable as T
+import Data.Monoid
+import Data.Functor.Bind hiding (join)
+import Data.Function
+
+-- | The \"free monad transformer\" for a functor @f@
+newtype FT f m a = FT {runFT :: forall r. (a -> m r) -> (f (m r) -> m r) -> m r}
+
+instance (Functor f, Monad m, Eq (FreeT f m a)) => Eq (FT f m a) where
+  (==) = (==) `on` fromFT
+
+instance (Functor f, Monad m, Ord (FreeT f m a)) => Ord (FT f m a) where
+  compare = compare `on` fromFT
+
+instance Functor (FT f m) where
+  fmap f (FT k) = FT $ \a fr -> k (a . f) fr
+
+instance Apply (FT f m) where
+  (<.>) = (<*>)
+
+instance Applicative (FT f m) where
+  pure a = FT $ \k _ -> k a
+  FT fk <*> FT ak = FT $ \b fr -> ak (\d -> fk (\e -> b (e d)) fr) fr
+
+instance Bind (FT f m) where
+  (>>-) = (>>=)
+
+instance Monad (FT f m) where
+  return = pure
+  FT fk >>= f = FT $ \b fr -> fk (\d -> runFT (f d) b fr) fr
+
+instance (Functor f) => MonadFree f (FT f m) where
+  wrap f = FT (\kp kf -> kf (fmap (\(FT m) -> m kp kf) f))
+
+instance MonadTrans (FT f) where
+  lift m = FT (\a _ -> m >>= a)
+
+instance Alternative m => Alternative (FT f m) where
+  empty = FT (\_ _ -> empty)
+  FT k1 <|> FT k2 = FT $ \a fr -> k1 a fr <|> k2 a fr
+
+instance MonadPlus m => MonadPlus (FT f m) where
+  mzero = FT (\_ _ -> mzero)
+  mplus (FT k1) (FT k2) = FT $ \a fr -> k1 a fr `mplus` k2 a fr
+
+instance (Foldable f, Foldable m, Monad m) => Foldable (FT f m) where
+  foldMap f (FT k) = F.fold $ k (return . f) (F.foldr (liftM2 mappend) (return mempty))
+
+instance (Monad m, Traversable m, Traversable f) => Traversable (FT f m) where
+  traverse f (FT k) = fmap (join . lift) . T.sequenceA $ k traversePure traverseFree
+    where
+      traversePure = return . fmap return . f
+      traverseFree = return . fmap (wrap . fmap (join . lift)) . T.sequenceA . fmap T.sequenceA
+
+instance (MonadIO m) => MonadIO (FT f m) where
+  liftIO = lift . liftIO
+  {-# INLINE liftIO #-}
+
+instance (Functor f, MonadError e m) => MonadError e (FT f m) where
+  throwError = lift . throwError
+  {-# INLINE throwError #-}
+  m `catchError` f = toFT $ fromFT m `catchError` (fromFT . f)
+
+instance (MonadCont m) => MonadCont (FT f m) where
+  callCC f = join . lift $ callCC (\k -> return $ f (lift . k . return))
+
+instance (Functor f, MonadReader r m) => MonadReader r (FT f m) where
+  ask = lift ask
+  {-# INLINE ask #-}
+  local f = hoistFT (local f)
+  {-# INLINE local #-}
+
+instance (Functor f, MonadState s m) => MonadState s (FT f m) where
+  get = lift get
+  {-# INLINE get #-}
+  put = lift . put
+  {-# INLINE put #-}
+#if MIN_VERSION_mtl(2,1,1)
+  state f = lift (state f)
+  {-# INLINE state #-}
+#endif
+
+-- | Generate a Church-encoded free monad transformer from a 'FreeT' monad
+-- transformer.
+toFT :: (Monad m, Functor f) => FreeT f m a -> FT f m a
+toFT (FreeT f) = FT $ \ka kfr -> do
+  freef <- f
+  case freef of
+    Pure a -> ka a
+    Free fb -> kfr $ fmap (($ kfr) . ($ ka) . runFT . toFT) fb
+
+-- | Convert to a 'FreeT' free monad representation.
+fromFT :: (Monad m, Functor f) => FT f m a -> FreeT f m a
+fromFT (FT k) = FreeT $ k (return . Pure) (runFreeT . wrap . fmap FreeT)
+
+-- | The \"free monad\" for a functor @f@.
+type F f = FT f Identity
+
+runF :: Functor f => F f a -> (forall r. (a -> r) -> (f r -> r) -> r)
+runF (FT m) = \kp kf -> runIdentity $ m (return . kp) (return . kf . fmap runIdentity)
+
+free :: Functor f => (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
+free f = FT (\kp kf -> return $ f (runIdentity . kp) (runIdentity . kf . fmap return))
+
+-- | Tear down a free monad transformer using iteration.
+iterT :: (Functor f, Monad m) => (f (m a) -> m a) -> FT f m a -> m a
+iterT phi (FT m) = m return phi
+{-# INLINE iterT #-}
+
+-- | Lift a monad homomorphism from @m@ to @n@ into a monad homomorphism from @'FT' f m@ to @'FT' f n@
+--
+-- @'hoistFT' :: ('Monad' m, 'Monad' n, 'Functor' f) => (m ~> n) -> 'FT' f m ~> 'FT' f n@
+hoistFT :: (Monad m, Monad n, Functor f) => (forall a. m a -> n a) -> FT f m b -> FT f n b
+hoistFT phi (FT m) = FT (\kp kf -> join . phi $ m (return . kp) (return . kf . fmap (join . phi)))
+
+-- | Lift a natural transformation from @f@ to @g@ into a monad homomorphism from @'FT' f m@ to @'FT' g n@
+transFT :: (Monad m, Functor g) => (forall a. f a -> g a) -> FT f m b -> FT g m b
+transFT phi (FT m) = FT (\kp kf -> m kp (kf . phi))
+
+-- |
+-- 'retract' is the left inverse of 'liftF'
+--
+-- @
+-- 'retract' . 'liftF' = 'id'
+-- @
+retract :: (Functor f, Monad f) => F f a -> f a
+retract m = runF m return join
+{-# INLINE retract #-}
+
+-- | Tear down an 'F' 'Monad' using iteration.
+iter :: Functor f => (f a -> a) -> F f a -> a
+iter phi = runIdentity . iterT (Identity . phi . fmap runIdentity)
+{-# INLINE iter #-}
+
+-- | Like 'iter' for monadic values.
+iterM :: (Functor f, Monad m) => (f (m a) -> m a) -> F f a -> m a
+iterM phi = iterT phi . hoistFT (return . runIdentity)
+
+-- | Convert to another free monad representation.
+fromF :: (Functor f, MonadFree f m) => F f a -> m a
+fromF m = runF m return wrap
+{-# INLINE fromF #-}
+
+-- | Generate a Church-encoded free monad from a 'Free' monad.
+toF :: (Functor f) => Free f a -> F f a
+toF = toFT
+{-# INLINE toF #-}
+
+-- | Improve the asymptotic performance of code that builds a free monad with only binds and returns by using 'F' behind the scenes.
+--
+-- This is based on the \"Free Monads for Less\" series of articles by Edward Kmett:
+--
+-- <http://comonad.com/reader/2011/free-monads-for-less/>
+-- <http://comonad.com/reader/2011/free-monads-for-less-2/>
+--
+-- and \"Asymptotic Improvement of Computations over Free Monads\" by Janis Voightländer:
+--
+-- <http://www.iai.uni-bonn.de/~jv/mpc08.pdf>
+improve :: Functor f => (forall m. MonadFree f m => m a) -> Free f a
+improve m = fromF m
+{-# INLINE improve #-}
+
diff --git a/src/Control/Monad/Trans/Iter.hs b/src/Control/Monad/Trans/Iter.hs
--- a/src/Control/Monad/Trans/Iter.hs
+++ b/src/Control/Monad/Trans/Iter.hs
@@ -37,6 +37,7 @@
   -- * Consuming iterative monads
   , retract
   , fold
+  , foldM
   -- * IterT ~ FreeT Identity
   , MonadFree(..)
   ) where
@@ -47,7 +48,10 @@
 import Control.Monad.Trans.Class
 import Control.Monad.Free.Class
 import Control.Monad.State.Class
+import Control.Monad.Error.Class
 import Control.Monad.Reader.Class
+import Control.Monad.Cont.Class
+import Control.Monad.IO.Class
 import Data.Bifunctor
 import Data.Bitraversable
 import Data.Functor.Bind
@@ -176,6 +180,17 @@
   {-# INLINE state #-}
 #endif
 
+instance (Functor m, MonadError e m) => MonadError e (IterT m) where
+  throwError = lift . throwError
+  {-# INLINE throwError #-}
+  IterT m `catchError` f = IterT $ (liftM (fmap (`catchError` f)) m) `catchError` (runIterT . f)
+
+instance (Functor m, MonadIO m) => MonadIO (IterT m) where
+  liftIO = lift . liftIO
+
+instance (MonadCont m) => MonadCont (IterT m) where
+  callCC f = IterT $ callCC (\k -> runIterT $ f (lift . k . Left))
+
 instance Monad m => MonadFree Identity (IterT m) where
   wrap = IterT . return . Right . runIdentity
   {-# INLINE wrap #-}
@@ -196,6 +211,10 @@
 -- | Tear down a 'Free' 'Monad' using iteration.
 fold :: Monad m => (m a -> a) -> IterT m a -> a
 fold phi (IterT m) = phi (either id (fold phi) `liftM` m)
+
+-- | Like 'fold' with monadic result.
+foldM :: (Monad m, Monad n) => (m (n a) -> n a) -> IterT m a -> n a
+foldM phi (IterT m) = phi (either return (foldM phi) `liftM` m)
 
 -- | Lift a monad homomorphism from @m@ to @n@ into a Monad homomorphism from @'IterT' m@ to @'IterT' n@.
 hoistIterT :: Monad n => (forall a. m a -> n a) -> IterT m b -> IterT n b