diff --git a/examples/FreeNum.hs b/examples/FreeNum.hs
--- a/examples/FreeNum.hs
+++ b/examples/FreeNum.hs
@@ -1,18 +1,12 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 module FreeNum where
 
 import Data.Functor.Free
+import Data.Algebra
 
-import Control.Applicative
 
-instance Num (Free Num a) where
-  Free l + Free r = Free $ (+) <$> l <*> r
-  Free l * Free r = Free $ (*) <$> l <*> r
-  Free l - Free r = Free $ (-) <$> l <*> r
-  negate (Free f) = Free $ negate <$> f
-  abs (Free f)    = Free $ abs <$> f
-  signum (Free f) = Free $ signum <$> f
-  fromInteger i   = Free $ pure (fromInteger i)
+deriveInstance [t| () => Num (Free Num a) |]
+
 
 x, y :: Free Num String
 x = return "x"
diff --git a/examples/NonEmptyList.hs b/examples/NonEmptyList.hs
--- a/examples/NonEmptyList.hs
+++ b/examples/NonEmptyList.hs
@@ -1,26 +1,28 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 module NonEmptyList where
 
 import Data.Functor.Free
-
-import Data.Semigroup
+import Data.Algebra
 
 import Control.Applicative
 import Control.Comonad
 import Data.Functor.Identity
 import Data.Functor.Compose
 
+class Semigroup s where
+  (<>) :: s -> s -> s
 
+instance Semigroup [a] where
+  (<>) = (++)
+  
 -- This declaration creates a Functor that is also Applicative.
 type NonEmptyList = Free Semigroup
 
 -- This instance makes NonEmptyList a Monad.
-instance Semigroup (NonEmptyList a) where
-  Free fa <> Free fb = Free $ liftA2 (<>) fa fb
+deriveInstance [t| () => Semigroup (NonEmptyList a) |]
 
 -- This instance makes NonEmptyList Foldable and Traversable.
-instance Applicative f => Semigroup (LiftAFree Semigroup f a) where
-  LiftAFree fa <> LiftAFree fb = LiftAFree $ liftA2 (<>) fa fb
+deriveInstance [t| Applicative f => Semigroup (LiftAFree Semigroup f a) |]
 
 -- The next two instances make NonEmptyList a Comonad.
 instance Semigroup (Identity a) where
diff --git a/free-functors.cabal b/free-functors.cabal
--- a/free-functors.cabal
+++ b/free-functors.cabal
@@ -1,5 +1,5 @@
 name:                free-functors
-version:             0.2
+version:             0.3
 synopsis:            Provides free functors that are adjoint to functors that forget class constraints. 
 description:         A free functor is a left adjoint to a forgetful functor. It used to be the case
                      that the only category that was easy to work with in Haskell was Hask itself, so
@@ -44,7 +44,8 @@
     constraints >= 0.3.2 && < 0.4,
     transformers >= 0.2.0.0 && < 0.4,
     comonad >= 3.0 && < 3.1,
-    void >= 0.4 && < 0.7
+    void >= 0.4 && < 0.7,
+    algebraic-classes == 0.1.*
 
 source-repository head
   type:     git
diff --git a/src/Data/Functor/Free.hs b/src/Data/Functor/Free.hs
--- a/src/Data/Functor/Free.hs
+++ b/src/Data/Functor/Free.hs
@@ -1,11 +1,15 @@
 {-# LANGUAGE
     ConstraintKinds
+  , GADTs
   , RankNTypes
   , TypeOperators  
   , FlexibleInstances
   , MultiParamTypeClasses
   , UndecidableInstances
   , ScopedTypeVariables
+  , DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
   #-}
 -----------------------------------------------------------------------------
 -- |
@@ -24,7 +28,7 @@
 import Control.Applicative
 import Control.Comonad
 
-import Data.Constraint
+import Data.Constraint hiding (Class)
 import Data.Constraint.Forall
 
 import Data.Functor.Identity
@@ -33,6 +37,7 @@
 import Data.Traversable
 import Data.Void
 
+import Data.Algebra
 
 -- | The free functor for constraint @c@.
 newtype Free c a = Free { runFree :: forall b. c b => (a -> b) -> b }
@@ -85,8 +90,14 @@
   extract = runIdentity . rightAdjunctF Identity
   extend g = fmap g . getCompose . rightAdjunctF (Compose . return . return)
 
+instance c ~ Class f => Algebra f (Free c a) where
+  algebra fa = Free $ \k -> evaluate (fmap (rightAdjunct k) fa)
+
 newtype LiftAFree c f a = LiftAFree { getLiftAFree :: f (Free c a) }
 
+instance (Applicative f, c ~ Class s) => Algebra s (LiftAFree c f a) where
+  algebra = LiftAFree . fmap algebra . traverse getLiftAFree
+
 instance ForallT c (LiftAFree c) => Foldable (Free c) where
   foldMap = foldMapDefault
 
@@ -98,3 +109,28 @@
 
 convertClosed :: c r => Free c Void -> r
 convertClosed = rightAdjunct absurd
+
+type InitialObject c = Free c Void
+
+initial :: c r => InitialObject c -> r
+initial = rightAdjunct absurd
+
+type Coproduct c m n = Free c (Either m n)
+
+coproduct :: c r => (m -> r) -> (n -> r) -> Coproduct c m n -> r
+coproduct m n = rightAdjunct (either m n)
+
+inL :: c m => m -> Coproduct c m n
+inL = unit . Left
+
+inR :: c n => n -> Coproduct c m n
+inR = unit . Right
+
+product :: (r -> m) -> (r -> n) -> r -> Free c (m, n)
+product m n r = unit (m r, n r)
+
+fstP :: c m => Free c (m, n) -> m
+fstP = rightAdjunct fst
+
+sndP :: c n => Free c (m, n) -> n
+sndP = rightAdjunct snd