diff --git a/src/Control/Monad/Trans/Free.hs b/src/Control/Monad/Trans/Free.hs
index 19cf606..1cc2b64 100644
--- a/src/Control/Monad/Trans/Free.hs
+++ b/src/Control/Monad/Trans/Free.hs
@@ -43,6 +43,9 @@ module Control.Monad.Trans.Free
   , intersperseT
   , intercalateT
   , retractT
+  , copy
+  , copy'
+  , expand
   -- * Operations of free monad
   , retract
   , iter
@@ -52,6 +55,7 @@ module Control.Monad.Trans.Free
   ) where
 
 import Control.Applicative
+import Control.Comonad (Comonad (..))
 import Control.Monad (liftM, MonadPlus(..), ap, join)
 import Control.Monad.Base (MonadBase(..))
 import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
@@ -66,6 +70,7 @@ import Control.Monad.Error.Class
 import Control.Monad.Cont.Class
 import Data.Functor.Bind hiding (join)
 import Data.Functor.Classes.Compat
+import Data.Functor.Extend (Extend (..))
 import Data.Monoid
 import Data.Functor.Identity
 import Data.Traversable
@@ -403,6 +408,21 @@ iterTM f (FreeT m) = do
         Pure x -> return x
         Free y -> f y
 
+expand :: (Applicative m, Functor f)
+        => (forall a b. (g a -> b) -> f a -> h b)
+        -> FreeT f m r -> FreeT g (FreeT h m) r
+expand g = loop where
+  loop (FreeT t) = FreeT $ FreeT $ flip fmap t $
+    \str -> case str of
+      Pure r -> Pure (Pure r)
+      Free f -> Free $ g (FreeT . pure . Pure . Free) (fmap loop f)
+
+copy :: (Applicative m, Comonad f) => FreeT f m r -> FreeT f (FreeT f m) r
+copy = expand extend
+
+copy' :: (Applicative m, Extend f) => FreeT f m r -> FreeT f (FreeT f m) r
+copy' = expand extended
+
 instance (Foldable m, Foldable f) => Foldable (FreeT f m) where
   foldMap f (FreeT m) = foldMap (bifoldMap f (foldMap f)) m