diff --git a/free.cabal b/free.cabal
--- a/free.cabal
+++ b/free.cabal
@@ -1,6 +1,6 @@
 name:          free
 category:      Control, Monads
-version:       3.2
+version:       3.3
 license:       BSD3
 cabal-version: >= 1.10
 license-file:  LICENSE
@@ -63,10 +63,12 @@
 
   exposed-modules:
     Control.Applicative.Free
+    Control.Alternative.Free
     Control.Monad.Free
     Control.Monad.Free.Church
     Control.Monad.Free.Class
     Control.Monad.Trans.Free
+    Control.MonadPlus.Free
     Control.Comonad.Cofree
     Control.Comonad.Cofree.Class
     Control.Comonad.Trans.Cofree
diff --git a/src/Control/Alternative/Free.hs b/src/Control/Alternative/Free.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Alternative/Free.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE GADTs #-}
+{-# OPTIONS_GHC -Wall #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Alternative.Free
+-- Copyright   :  (C) 2012 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  GADTs, Rank2Types
+--
+-- Left distributive 'Alternative' functors for free, based on a design
+-- by Stijn van Drongelen.
+----------------------------------------------------------------------------
+module Control.Alternative.Free
+  ( Alt(..)
+  , runAlt
+  , liftAlt
+  , hoistAlt
+  ) where
+
+import Control.Applicative
+import Data.Functor.Apply
+import Data.Semigroup
+
+#ifdef GHC_TYPEABLE
+import Data.Typeable
+#endif
+
+-- | The free 'Applicative' for a 'Functor' @f@.
+data Alt f a where
+  Pure :: a -> Alt f a
+  Ap   :: f a -> Alt f (a -> b) -> Alt f b
+  Alt  :: [Alt f a] -> Alt f a
+
+-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.
+runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
+runAlt _ (Pure x) = pure x
+runAlt u (Ap f x) = flip id <$> u f <*> runAlt u x
+runAlt u (Alt as) = foldr (\a r -> runAlt u a <|> r) empty as
+
+instance Functor (Alt f) where
+  fmap f (Pure a)   = Pure (f a)
+  fmap f (Ap x y)   = Ap x ((f .) <$> y)
+  fmap f (Alt as)   = Alt (fmap f <$> as)
+
+instance Apply (Alt f) where
+  Pure f <.> y = fmap f y
+  Ap x y <.> z = Ap x (flip <$> y <.> z)
+  Alt as <.> z = Alt (map (<.> z) as) -- This assumes 'left distribution'
+
+instance Applicative (Alt f) where
+  pure = Pure
+  Pure f <*> y = fmap f y
+  Ap x y <*> z = Ap x (flip <$> y <*> z)
+  Alt as <*> z = Alt (map (<*> z) as) -- This assumes 'left distribution'
+
+instance Alternative (Alt f) where
+  empty = Alt []
+  {-# INLINE empty #-}
+  Alt [] <|> r      = r
+  l      <|> Alt [] = l
+  Alt as <|> Alt bs = Alt (as ++ bs)
+  l      <|> r      = Alt [l, r]
+  {-# INLINE (<|>) #-}
+
+instance Semigroup (Alt f a) where
+  (<>) = (<|>)
+  {-# INLINE (<>) #-}
+
+instance Monoid (Alt f a) where
+  mempty = empty
+  {-# INLINE mempty #-}
+  mappend = (<|>)
+  {-# INLINE mappend #-}
+  mconcat as = fromList (as >>= toList)
+    where
+      toList (Alt xs) = xs
+      toList x       = [x]
+      fromList [x] = x
+      fromList xs  = Alt xs
+  {-# INLINE mconcat #-}
+
+-- | A version of 'lift' that can be used with just a 'Functor' for @f@.
+liftAlt :: f a -> Alt f a
+liftAlt x = Ap x (Pure id)
+{-# INLINE liftAlt #-}
+
+-- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.
+hoistAlt :: (forall a. f a -> g a) -> Alt f b -> Alt g b
+hoistAlt _ (Pure a) = Pure a
+hoistAlt f (Ap x y) = Ap (f x) (hoistAlt f y)
+hoistAlt f (Alt as) = Alt (map (hoistAlt f) as)
+
+#ifdef GHC_TYPEABLE
+instance Typeable1 f => Typeable1 (Alt f) where
+  typeOf1 t = mkTyConApp altTyCon [typeOf1 (f t)] where
+    f :: Alt f a -> f a
+    f = undefined
+
+altTyCon :: TyCon
+#if __GLASGOW_HASKELL__ < 704
+altTyCon = mkTyCon "Control.Alternative.Free.Alt"
+#else
+altTyCon = mkTyCon3 "free" "Control.Alternative.Free" "Alt"
+#endif
+{-# NOINLINE altTyCon #-}
+
+#endif
diff --git a/src/Control/Applicative/Free.hs b/src/Control/Applicative/Free.hs
--- a/src/Control/Applicative/Free.hs
+++ b/src/Control/Applicative/Free.hs
@@ -60,7 +60,6 @@
 hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b
 hoistAp _ (Pure a) = Pure a
 hoistAp f (Ap x y) = Ap (f x) (hoistAp f y)
-{-# INLINE hoistAp #-}
 
 #ifdef GHC_TYPEABLE
 instance Typeable1 f => Typeable1 (Ap f) where
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
@@ -23,8 +23,8 @@
   , coiter
   , unfold
   -- * Lenses into cofree comonads
-  , extracted
-  , unwrapped
+  , _extract
+  , _unwrap
   , telescoped
   ) where
 
@@ -97,6 +97,7 @@
 
 instance Functor f => ComonadCofree f (Cofree f) where
   unwrap (_ :< as) = as
+  {-# INLINE unwrap #-}
 
 instance Distributive f => Distributive (Cofree f) where
   distribute w = fmap extract w :< fmap distribute (collect unwrap w)
@@ -107,17 +108,27 @@
 
 instance Functor f => Extend (Cofree f) where
   extended = extend
+  {-# INLINE extended #-}
   duplicated = duplicate
+  {-# INLINE duplicated #-}
 
 instance Functor f => Comonad (Cofree f) where
   extend f w = f w :< fmap (extend f) (unwrap w)
   duplicate w = w :< fmap duplicate (unwrap w)
   extract (a :< _) = a
+  {-# INLINE extract #-}
 
 -- | This is not a true 'Comonad' transformer, but this instance is convenient.
 instance ComonadTrans Cofree where
   lower (_ :< as) = fmap extract as
+  {-# INLINE lower #-}
 
+instance Alternative f => Monad (Cofree f) where
+  return x = x :< empty
+  {-# INLINE return #-}
+  (a :< m) >>= k = case k a of
+                     b :< n -> b :< (n <|> fmap (>>= k) m)
+
 -- |
 --
 -- @'lower' . 'section' = 'id'@
@@ -126,19 +137,28 @@
 
 instance Apply f => Apply (Cofree f) where
   (f :< fs) <.> (a :< as) = f a :< ((<.>) <$> fs <.> as)
+  {-# INLINE (<.>) #-}
   (f :< fs) <.  (_ :< as) = f :< ((<. ) <$> fs <.> as)
+  {-# INLINE (<.) #-}
   (_ :< fs)  .> (a :< as) = a :< (( .>) <$> fs <.> as)
+  {-# INLINE (.>) #-}
 
 instance ComonadApply f => ComonadApply (Cofree f) where
   (f :< fs) <@> (a :< as) = f a :< ((<@>) <$> fs <@> as)
+  {-# INLINE (<@>) #-}
   (f :< fs) <@  (_ :< as) = f :< ((<@ ) <$> fs <@> as)
+  {-# INLINE (<@) #-}
   (_ :< 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)
+  {-# 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) $
@@ -161,16 +181,24 @@
     GT -> GT
 
 instance Foldable f => Foldable (Cofree f) where
-  foldMap f (a :< as) = f a `mappend` foldMap (foldMap f) as
+  foldMap f = go where
+    go (a :< as) = f a `mappend` foldMap go as
+  {-# INLINE foldMap #-}
 
 instance Foldable1 f => Foldable1 (Cofree f) where
-  foldMap1 f (a :< as) = f a <> foldMap1 (foldMap1 f) as
+  foldMap1 f = go where
+    go (a :< as) = f a <> foldMap1 go as
+  {-# INLINE foldMap1 #-}
 
 instance Traversable f => Traversable (Cofree f) where
-  traverse f (a :< as) = (:<) <$> f a <*> traverse (traverse f) as
+  traverse f = go where
+    go (a :< as) = (:<) <$> f a <*> traverse go as
+  {-# INLINE traverse #-}
 
 instance Traversable1 f => Traversable1 (Cofree f) where
-  traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 (traverse1 f) as
+  traverse1 f = go where
+    go (a :< as) = (:<) <$> f a <.> traverse1 go as
+  {-# INLINE traverse1 #-}
 
 #ifdef GHC_TYPEABLE
 instance (Typeable1 f) => Typeable1 (Cofree f) where
@@ -214,43 +242,51 @@
 
 instance ComonadEnv e w => ComonadEnv e (Cofree w) where
   ask = ask . lower
+  {-# INLINE ask #-}
 
 instance ComonadStore s w => ComonadStore s (Cofree w) where
   pos (_ :< as) = Class.pos as
+  {-# INLINE pos #-}
   peek s (_ :< as) = extract (Class.peek s as)
+  {-# INLINE peek #-}
 
 instance ComonadTraced m w => ComonadTraced m (Cofree w) where
   trace m = trace m . lower
+  {-# INLINE trace #-}
 
 -- | This is a lens that can be used to read or write from the target of 'extract'.
 --
--- @foo ^. 'extracted' == 'extract' foo@
+-- Using (^.) from the @lens@ package:
 --
--- For more on lenses see the 'lens' package on hackage
+-- @foo ^. '_extract' == 'extract' foo@
 --
--- @extracted :: Simple Lens (Cofree g a) a@
-extracted :: Functor f => (a -> f a) -> Cofree g a -> f (Cofree g a)
-extracted f (a :< as) = (:< as) <$> f a
-{-# INLINE extracted #-}
+-- For more on lenses see the @lens@ package on hackage
+--
+-- @'_extract' :: Lens' ('Cofree' g a) a@
+_extract :: Functor f => (a -> f a) -> Cofree g a -> f (Cofree g a)
+_extract f (a :< as) = (:< as) <$> f a
+{-# INLINE _extract #-}
 
 -- | This is a lens that can be used to read or write to the tails of a 'Cofree' 'Comonad'.
 --
--- @foo ^. 'unwrapped' == 'unwrap' foo@
+-- Using (^.) from the @lens@ package:
 --
--- For more on lenses see the 'lens' package on hackage
+-- @foo ^. '_unwrap' == 'unwrap' foo@
 --
--- @unwrapped :: Simple Lens (Cofree g a) (g (Cofree g a))@
-unwrapped :: Functor f => (g (Cofree g a) -> f (g (Cofree g a))) -> Cofree g a -> f (Cofree g a)
-unwrapped  f (a :< as) = (a :<) <$> f as
-{-# INLINE unwrapped #-}
+-- For more on lenses see the @lens@ package on hackage
+--
+-- @'_unwrap' :: Lens' ('Cofree' g a) (g ('Cofree' g a))@
+_unwrap :: Functor f => (g (Cofree g a) -> f (g (Cofree g a))) -> Cofree g a -> f (Cofree g a)
+_unwrap  f (a :< as) = (a :<) <$> f as
+{-# INLINE _unwrap #-}
 
 -- | Construct a @Lens@ into a @'Cofree' f@ given a list of lenses into the base functor.
 --
 -- For more on lenses see the 'lens' package on hackage.
 --
--- @telescoped :: Functor g => [Rep g] -> Simple Lens (Cofree g a) a@
+-- @telescoped :: 'Functor' g => [Lens' ('Cofree' g a) (g ('Cofree' g a))] -> Lens' ('Cofree' g a) a@
 telescoped :: (Functor f, Functor g) =>
              [(Cofree g a -> f (Cofree g a)) -> g (Cofree g a) -> f (g (Cofree g a))] ->
               (a -> f a) -> Cofree g a -> f (Cofree g a)
-telescoped [] = extracted
-telescoped (l:ls) = unwrapped . l . telescoped ls
+telescoped = Prelude.foldr (\l r -> _unwrap . l . r) _extract
+{-# INLINE telescoped #-}
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
@@ -118,8 +118,10 @@
              , (m, t) <- readsPrec 11 s]) r
 
 instance Functor f => Functor (Free f) where
-  fmap f (Pure a)  = Pure (f a)
-  fmap f (Free fa) = Free (fmap f <$> fa)
+  fmap f = go where
+    go (Pure a)  = Pure (f a)
+    go (Free fa) = Free (go <$> fa)
+  {-# INLINE fmap #-}
 
 instance Functor f => Apply (Free f) where
   Pure a  <.> Pure b = Pure (a b)
@@ -128,6 +130,7 @@
 
 instance Functor f => Applicative (Free f) where
   pure = Pure
+  {-# INLINE pure #-}
   Pure a <*> Pure b = Pure $ a b
   Pure a <*> Free mb = Free $ fmap a <$> mb
   Free ma <*> b = Free $ (<*> b) <$> ma
@@ -138,65 +141,91 @@
 
 instance Functor f => Monad (Free f) where
   return = Pure
+  {-# INLINE return #-}
   Pure a >>= f = f a
   Free m >>= f = Free ((>>= f) <$> m)
 
 -- | This violates the Alternative laws, handle with care.
 instance Alternative v => Alternative (Free v) where
   empty = Free empty
+  {-# INLINE empty #-}
   a <|> b = Free (pure a <|> pure b)
+  {-# INLINE (<|>) #-}
 
 -- | This violates the MonadPlus laws, handle with care.
 instance (Functor v, MonadPlus v) => MonadPlus (Free v) where
   mzero = Free mzero
+  {-# INLINE mzero #-}
   a `mplus` b = Free (return a `mplus` return b)
+  {-# INLINE mplus #-}
 
 -- | This is not a true monad transformer. It is only a monad transformer \"up to 'retract'\".
 instance MonadTrans Free where
   lift = Free . liftM Pure
+  {-# INLINE lift #-}
 
 instance Foldable f => Foldable (Free f) where
-  foldMap f (Pure a) = f a
-  foldMap f (Free fa) = foldMap (foldMap f) fa
+  foldMap f = go where
+    go (Pure a) = f a
+    go (Free fa) = foldMap go fa
+  {-# INLINE foldMap #-}
 
 instance Foldable1 f => Foldable1 (Free f) where
-  foldMap1 f (Pure a) = f a
-  foldMap1 f (Free fa) = foldMap1 (foldMap1 f) fa
+  foldMap1 f = go where
+    go (Pure a) = f a
+    go (Free fa) = foldMap1 go fa
+  {-# INLINE foldMap1 #-}
 
 instance Traversable f => Traversable (Free f) where
-  traverse f (Pure a) = Pure <$> f a
-  traverse f (Free fa) = Free <$> traverse (traverse f) fa
+  traverse f = go where
+    go (Pure a) = Pure <$> f a
+    go (Free fa) = Free <$> traverse go fa
+  {-# INLINE traverse #-}
 
 instance Traversable1 f => Traversable1 (Free f) where
-  traverse1 f (Pure a) = Pure <$> f a
-  traverse1 f (Free fa) = Free <$> traverse1 (traverse1 f) fa
+  traverse1 f = go where
+    go (Pure a) = Pure <$> f a
+    go (Free fa) = Free <$> traverse1 go fa
+  {-# INLINE traverse1 #-}
 
 instance (Functor m, MonadWriter e m) => MonadWriter e (Free m) where
   tell = lift . tell
+  {-# INLINE tell #-}
   listen = lift . listen . retract
+  {-# INLINE listen #-}
   pass = lift . pass . retract
+  {-# INLINE pass #-}
 
 instance (Functor m, MonadReader e m) => MonadReader e (Free m) where
   ask = lift ask
+  {-# INLINE ask #-}
   local f = lift . local f . retract
+  {-# INLINE local #-}
 
 instance (Functor m, MonadState s m) => MonadState s (Free m) where
   get = lift get
+  {-# INLINE get #-}
   put s = lift (put s)
+  {-# INLINE put #-}
 
 instance (Functor m, MonadError e m) => MonadError e (Free m) where
   throwError = lift . throwError
+  {-# INLINE throwError #-}
   catchError as f = lift (catchError (retract as) (retract . f))
+  {-# INLINE catchError #-}
 
 instance (Functor m, MonadCont m) => MonadCont (Free m) where
   callCC f = lift (callCC (retract . f . liftM lift))
+  {-# INLINE callCC #-}
 
 -- | A version of 'lift' that can be used with just a 'Functor' for @f@.
 liftF :: Functor f => f a -> Free f a
 liftF = Free . fmap Pure
+{-# INLINE liftF #-}
 
 instance Functor f => MonadFree f (Free f) where
   wrap = Free
+  {-# INLINE wrap #-}
 
 -- |
 -- 'retract' is the left inverse of 'lift' and 'liftF'
@@ -216,9 +245,8 @@
 
 -- | Lift a natural transformation from @f@ to @g@ into a natural transformation from @'FreeT' f@ to @'FreeT' g@.
 hoistFree :: Functor g => (forall a. f a -> g a) -> Free f b -> Free g b
-hoistFree _ (Pure a) = Pure a
+hoistFree _ (Pure a)  = Pure a
 hoistFree f (Free as) = Free (hoistFree f <$> f as)
-{-# INLINE hoistFree #-}
 
 #ifdef GHC_TYPEABLE
 instance Typeable1 f => Typeable1 (Free f) where
diff --git a/src/Control/MonadPlus/Free.hs b/src/Control/MonadPlus/Free.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/MonadPlus/Free.hs
@@ -0,0 +1,296 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE Rank2Types #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.MonadPlus.Free
+-- Copyright   :  (C) 2008-2012 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  MPTCs, fundeps
+--
+-- left-distributive MonadPlus for free.
+----------------------------------------------------------------------------
+module Control.MonadPlus.Free
+  ( MonadFree(..)
+  , Free(..)
+  , retract
+  , liftF
+  , iter
+  , hoistFree
+  ) where
+
+import Control.Applicative
+import Control.Monad (liftM, MonadPlus(..))
+import Control.Monad.Trans.Class
+import Control.Monad.Free.Class
+import Control.Monad.Reader.Class
+import Control.Monad.Writer.Class
+import Control.Monad.State.Class
+import Control.Monad.Error.Class
+import Control.Monad.Cont.Class
+import Data.Functor.Bind
+import Data.Foldable
+import Data.Traversable
+import Data.Semigroup
+
+#ifdef GHC_TYPEABLE
+import Data.Data
+#endif
+
+-- | The 'Free' 'MonadPlus' for a 'Functor' @f@.
+--
+-- /Formally/
+--
+-- A 'MonadPlus' @n@ is a free 'MonadPlus' for @f@ if every monadplus homomorphism
+-- from @n@ to another MonadPlus @m@ is equivalent to a natural transformation
+-- from @f@ to @m@.
+--
+-- We model this internally as if left-distribution holds.
+--
+-- <<http://www.haskell.org/haskellwiki/MonadPlus>>
+data Free f a
+  = Pure a
+  | Free (f (Free f a))
+  | Plus [Free f a]
+
+instance (Eq (f (Free f a)), Eq a) => Eq (Free f a) where
+  Pure a == Pure b = a == b
+  Free fa == Free fb = fa == fb
+  Plus as == Plus bs = as == bs
+  _ == _ = False
+
+instance (Ord (f (Free f a)), Ord a) => Ord (Free f a) where
+  Pure a `compare` Pure b = a `compare` b
+  Pure _ `compare` Free _ = LT
+  Pure _ `compare` Plus _ = LT
+  Free _ `compare` Pure _ = GT
+  Free fa `compare` Free fb = fa `compare` fb
+  Free _ `compare` Plus _ = LT
+  Plus _ `compare` Pure _ = GT
+  Plus _ `compare` Free _ = GT
+  Plus as `compare` Plus bs = as `compare` bs
+
+instance (Show (f (Free f a)), Show a) => Show (Free f a) where
+  showsPrec d (Pure a) = showParen (d > 10) $
+    showString "Pure " . showsPrec 11 a
+  showsPrec d (Free m) = showParen (d > 10) $
+    showString "Free " . showsPrec 11 m
+  showsPrec d (Plus as) = showParen (d > 10) $
+    showString "Plus " . showsPrec 11 as
+
+instance (Read (f (Free f a)), Read a) => Read (Free f a) where
+  readsPrec d r = readParen (d > 10)
+      (\r' -> [ (Pure m, t)
+             | ("Pure", s) <- lex r'
+             , (m, t) <- readsPrec 11 s]) r
+    ++ readParen (d > 10)
+      (\r' -> [ (Free m, t)
+             | ("Free", s) <- lex r'
+             , (m, t) <- readsPrec 11 s]) r
+    ++ readParen (d > 10)
+      (\r' -> [ (Plus as, t)
+             | ("Plus", s) <- lex r'
+             , (as, t) <- readsPrec 11 s]) r
+
+instance Functor f => Functor (Free f) where
+  fmap f = go where
+    go (Pure a)  = Pure (f a)
+    go (Free fa) = Free (go <$> fa)
+    go (Plus as) = Plus (map go as)
+  {-# INLINE fmap #-}
+
+instance Functor f => Apply (Free f) where
+  Pure f  <.> Pure b = Pure (f b)
+  Pure f  <.> Plus bs = Plus $ fmap f <$> bs
+  Pure f  <.> Free fb = Free $ fmap f <$> fb
+  Free ff <.> b = Free $ (<.> b) <$> ff
+  Plus fs <.> b = Plus $ (<.> b) <$> fs -- left distribution ???
+
+instance Functor f => Applicative (Free f) where
+  pure = Pure
+  {-# INLINE pure #-}
+  Pure f  <*> Pure b  = Pure (f b)
+  Pure f  <*> Free mb = Free $ fmap f <$> mb
+  Pure f  <*> Plus bs = Plus $ fmap f <$> bs
+  Free ff <*> b = Free $ (<*> b) <$> ff
+  Plus fs <*> b = Plus $ (<*> b) <$> fs -- left distribution
+
+instance Functor f => Bind (Free f) where
+  Pure a >>- f = f a
+  Free m >>- f = Free ((>>- f) <$> m)
+  Plus m >>- f = Plus ((>>- f) <$> m)
+
+instance Functor f => Monad (Free f) where
+  return = Pure
+  {-# INLINE return #-}
+  Pure a >>= f = f a
+  Free m >>= f = Free ((>>= f) <$> m)
+  Plus m >>= f = Plus (map (>>= f) m) -- left distribution law
+
+instance Functor f => Alternative (Free f) where
+  empty = Plus []
+  {-# INLINE empty #-}
+  Plus [] <|> r       = r
+  l       <|> Plus [] = l
+  Plus as <|> Plus bs = Plus (as ++ bs)
+  a       <|> b       = Plus [a, b]
+  {-# INLINE (<|>) #-}
+
+instance Functor f => MonadPlus (Free f) where
+  mzero = empty
+  {-# INLINE mzero #-}
+  mplus = (<|>)
+  {-# INLINE mplus #-}
+
+instance Functor f => Semigroup (Free f a) where
+  (<>) = (<|>)
+  {-# INLINE (<>) #-}
+
+instance Functor f => Monoid (Free f a) where
+  mempty = empty
+  {-# INLINE mempty #-}
+  mappend = (<|>)
+  {-# INLINE mappend #-}
+  mconcat as = from (as >>= to)
+    where
+      to (Plus xs) = xs
+      to x       = [x]
+      from [x] = x
+      from xs  = Plus xs
+  {-# INLINE mconcat #-}
+
+-- | This is not a true monad transformer. It is only a monad transformer \"up to 'retract'\".
+instance MonadTrans Free where
+  lift = Free . liftM Pure
+  {-# INLINE lift #-}
+
+instance Foldable f => Foldable (Free f) where
+  foldMap f = go where
+    go (Pure a) = f a
+    go (Free fa) = foldMap go fa
+    go (Plus as) = foldMap go as
+  {-# INLINE foldMap #-}
+
+instance Traversable f => Traversable (Free f) where
+  traverse f = go where
+    go (Pure a) = Pure <$> f a
+    go (Free fa) = Free <$> traverse go fa
+    go (Plus as) = Plus <$> traverse go as
+  {-# INLINE traverse #-}
+
+instance (Functor m, MonadPlus m, MonadWriter e m) => MonadWriter e (Free m) where
+  tell = lift . tell
+  {-# INLINE tell #-}
+  listen = lift . listen . retract
+  {-# INLINE listen #-}
+  pass = lift . pass . retract
+  {-# INLINE pass #-}
+
+instance (Functor m, MonadPlus m, MonadReader e m) => MonadReader e (Free m) where
+  ask = lift ask
+  {-# INLINE ask #-}
+  local f = lift . local f . retract
+  {-# INLINE local #-}
+
+instance (Functor m, MonadState s m) => MonadState s (Free m) where
+  get = lift get
+  {-# INLINE get #-}
+  put s = lift (put s)
+  {-# INLINE put #-}
+
+instance (Functor m, MonadPlus m, MonadError e m) => MonadError e (Free m) where
+  throwError = lift . throwError
+  {-# INLINE throwError #-}
+  catchError as f = lift (catchError (retract as) (retract . f))
+  {-# INLINE catchError #-}
+
+instance (Functor m, MonadPlus m, MonadCont m) => MonadCont (Free m) where
+  callCC f = lift (callCC (retract . f . liftM lift))
+  {-# INLINE callCC #-}
+
+-- | A version of 'lift' that can be used with just a 'Functor' for @f@.
+liftF :: Functor f => f a -> Free f a
+liftF = Free . fmap Pure
+{-# INLINE liftF #-}
+
+instance Functor f => MonadFree f (Free f) where
+  wrap = Free
+  {-# INLINE wrap #-}
+
+-- |
+-- 'retract' is the left inverse of 'lift' and 'liftF'
+--
+-- @
+-- 'retract' . 'lift' = 'id'
+-- 'retract' . 'liftF' = 'id'
+-- @
+retract :: MonadPlus f => Free f a -> f a
+retract (Pure a) = return a
+retract (Free as) = as >>= retract
+retract (Plus as) = Prelude.foldr (mplus . retract) mzero as
+
+-- | Tear down a 'Free' 'Monad' using iteration.
+iter :: Functor f => (f a -> a) -> ([a] -> a) -> Free f a -> a
+iter phi psi = go where
+  go (Pure a) = a
+  go (Free as) = phi (go <$> as)
+  go (Plus as) = psi (go <$> as)
+{-# INLINE iter #-}
+
+-- | Lift a natural transformation from @f@ to @g@ into a natural transformation from @'FreeT' f@ to @'FreeT' g@.
+hoistFree :: Functor g => (forall a. f a -> g a) -> Free f b -> Free g b
+hoistFree f = go where
+  go (Pure a)  = Pure a
+  go (Free as) = Free (go <$> f as)
+  go (Plus as) = Plus (map go as)
+
+#ifdef GHC_TYPEABLE
+instance Typeable1 f => Typeable1 (Free f) where
+  typeOf1 t = mkTyConApp freeTyCon [typeOf1 (f t)] where
+    f :: Free f a -> f a
+    f = undefined
+
+freeTyCon :: TyCon
+#if __GLASGOW_HASKELL__ < 704
+freeTyCon = mkTyCon "Control.MonadPlus.Free.Free"
+#else
+freeTyCon = mkTyCon3 "free" "Control.MonadPlus.Free" "Free"
+#endif
+{-# NOINLINE freeTyCon #-}
+
+instance
+  ( Typeable1 f, Typeable a
+  , Data a, Data (f (Free f a))
+  ) => Data (Free f a) where
+    gfoldl f z (Pure a) = z Pure `f` a
+    gfoldl f z (Free as) = z Free `f` as
+    gfoldl f z (Plus as) = z Plus `f` as
+    toConstr Pure{} = pureConstr
+    toConstr Free{} = freeConstr
+    toConstr Plus{} = plusConstr
+    gunfold k z c = case constrIndex c of
+        1 -> k (z Pure)
+        2 -> k (z Free)
+        3 -> k (z Plus)
+        _ -> error "gunfold"
+    dataTypeOf _ = freeDataType
+    dataCast1 f = gcast1 f
+
+pureConstr, freeConstr, plusConstr :: Constr
+pureConstr = mkConstr freeDataType "Pure" [] Prefix
+freeConstr = mkConstr freeDataType "Free" [] Prefix
+plusConstr = mkConstr freeDataType "Plus" [] Prefix
+{-# NOINLINE pureConstr #-}
+{-# NOINLINE freeConstr #-}
+
+freeDataType :: DataType
+freeDataType = mkDataType "Control.MonadPlus.Free.Free" [pureConstr, freeConstr, plusConstr]
+{-# NOINLINE freeDataType #-}
+
+#endif