diff --git a/Control/Monad/Free.hs b/Control/Monad/Free.hs
--- a/Control/Monad/Free.hs
+++ b/Control/Monad/Free.hs
@@ -8,8 +8,11 @@
 -- * Free Monads
    MonadFree(..),
    Free(..), isPure, isImpure,
-   foldFree, foldFreeM,
-   evalFree, mapFree, mapFreeM,
+   foldFree,
+   evalFree, mapFree, mapFreeM, mapFreeM',
+-- * Monad Morphisms
+   foldFreeM,
+   induce,
 -- * Free Monad Transformers
    FreeT(..),
    foldFreeT, foldFreeT', mapFreeT,
@@ -72,15 +75,22 @@
 foldFreeM pure _    (Pure   x) = pure x
 foldFreeM pure imp  (Impure x) = imp =<< T.mapM (foldFreeM pure imp) x
 
+induce :: (Functor f, Monad m) => (forall a. f a -> m a) -> Free f a -> m a
+induce f = foldFree return (join . f)
+
 evalFree :: (a -> b) -> (f(Free f a) -> b) -> Free f a -> b
 evalFree p _ (Pure x)   = p x
 evalFree _ i (Impure x) = i x
 
-mapFree :: (Functor f, Functor g) => (forall a. f a -> g a) -> Free f a -> Free g a
+mapFree :: (Functor f, Functor g) => (f (Free g a) -> g (Free g a)) -> Free f a -> Free g a
 mapFree eta = foldFree Pure (Impure . eta)
 
-mapFreeM :: (Traversable f, Functor g, Monad m) => (forall a. f a -> m(g a)) -> Free f a -> m(Free g a)
+mapFreeM  :: (Traversable f, Functor g, Monad m) => (f (Free g a) -> m(g (Free g a))) -> Free f a -> m(Free g a)
 mapFreeM eta = foldFreeM (return . Pure) (liftM Impure . eta)
+
+mapFreeM' :: (Functor f, Traversable g, Monad m) => (forall a. f a -> m(g a)) -> Free f a -> m(Free g a)
+mapFreeM' eta = foldFree (return . Pure)
+                         (liftM Impure . join . liftM T.sequence . eta)
 
 -- * Monad Transformer
 --   (built upon Luke Palmer control-monad-free hackage package)
diff --git a/control-monad-free.cabal b/control-monad-free.cabal
--- a/control-monad-free.cabal
+++ b/control-monad-free.cabal
@@ -1,5 +1,5 @@
 name: control-monad-free
-version: 0.5.2
+version: 0.5.3
 Cabal-Version:  >= 1.6
 build-type: Simple
 license: PublicDomain