diff --git a/CHANGELOG b/CHANGELOG
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,5 +1,9 @@
 CHANGELOG
 
+0.8 -> 0.8.1
+  - Added HHCofree
+  - Changes towards support for `SuperClass1` in TH code for `Free`
+  
 0.7.2 -> 0.8
   - Updated for GHC 8.2
     - Updated to base-4.10
diff --git a/examples/FreeNum.hs b/examples/FreeNum.hs
--- a/examples/FreeNum.hs
+++ b/examples/FreeNum.hs
@@ -3,7 +3,8 @@
 
 import Data.Functor.Free
 
-deriveInstances ''Num
+-- This is what you would normally do with your own class, for Num this is already done for you.
+-- deriveInstances ''Num
 
 
 x, y :: Free Num String
diff --git a/examples/NonEmptyList.hs b/examples/NonEmptyList.hs
--- a/examples/NonEmptyList.hs
+++ b/examples/NonEmptyList.hs
@@ -12,7 +12,8 @@
 type NonEmptyList = Free Semigroup
 
 -- These instances make NonEmptyList a Semigroup and Show-able, Foldable and Traversable.
-deriveInstances ''Semigroup
+-- This is what you would normally do with your own class, for Semigroup this is already done for you.
+-- deriveInstances ''Semigroup
 
 -- The next two instances make NonEmptyList a Comonad.
 instance Semigroup (Extract 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.8
+version:             0.8.1
 synopsis:            Free functors, 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
@@ -35,8 +35,10 @@
     Data.Constraint.Class1,
     Data.Functor.Cofree,
     Data.Functor.Free,
+    Data.Functor.Free.TH,
     Data.Functor.HCofree,
     Data.Functor.HFree,
+    Data.Functor.HHCofree,
     Data.Functor.HHFree
 
   default-language:
diff --git a/src/Data/Constraint/Class1.hs b/src/Data/Constraint/Class1.hs
--- a/src/Data/Constraint/Class1.hs
+++ b/src/Data/Constraint/Class1.hs
@@ -35,6 +35,7 @@
 import Data.Functor.Contravariant
 import Data.Functor.Contravariant.Divisible
 import Data.Profunctor
+import Data.Semigroup
 
 -- | Proof that @b@ is a superclass of @h@, i.e. @h x@ entails @b x@.
 scls1 :: forall b h x. SuperClass1 b h => h x :- b x
@@ -51,6 +52,44 @@
   containsSelf :: FoldConstraints (SuperClasses c) x :- c x
   default containsSelf :: (SuperClasses c ~ '[c]) => FoldConstraints (SuperClasses c) x :- c x
   containsSelf = Sub Dict
+
+
+instance HasSuperClasses Num
+instance HasSuperClasses Eq
+instance HasSuperClasses Enum
+instance HasSuperClasses Bounded
+instance HasSuperClasses Show
+instance HasSuperClasses Read
+instance HasSuperClasses Ord where
+  type SuperClasses Ord = Ord ': SuperClasses Eq
+  superClasses = Sub Dict
+  containsSelf = Sub Dict
+instance HasSuperClasses Real where
+  type SuperClasses Real = Real ': SuperClasses Num ++ SuperClasses Ord
+  superClasses = Sub Dict
+  containsSelf = Sub Dict
+instance HasSuperClasses Fractional where
+  type SuperClasses Fractional = Fractional ': SuperClasses Num
+  superClasses = Sub Dict
+  containsSelf = Sub Dict
+instance HasSuperClasses Integral where
+  type SuperClasses Integral = Integral ': SuperClasses Real ++ SuperClasses Enum 
+  superClasses = Sub Dict
+  containsSelf = Sub Dict
+instance HasSuperClasses RealFrac where
+  type SuperClasses RealFrac = RealFrac ': SuperClasses Real ++ SuperClasses Fractional 
+  superClasses = Sub Dict
+  containsSelf = Sub Dict
+instance HasSuperClasses Floating where
+  type SuperClasses Floating = Floating ': SuperClasses Fractional 
+  superClasses = Sub Dict
+  containsSelf = Sub Dict
+instance HasSuperClasses RealFloat where
+  type SuperClasses RealFloat = RealFloat ': SuperClasses RealFrac ++ SuperClasses Floating 
+  superClasses = Sub Dict
+  containsSelf = Sub Dict
+instance HasSuperClasses Semigroup
+instance HasSuperClasses Monoid
 
 instance HasSuperClasses Functor
 instance HasSuperClasses Applicative where
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
@@ -12,6 +12,7 @@
   , DeriveTraversable
   , TemplateHaskell
   , PolyKinds
+  , TypeFamilies
   #-}
 -----------------------------------------------------------------------------
 -- |
@@ -53,18 +54,22 @@
 
 import Control.Comonad
 import Data.Function
+import Data.Semigroup
 
 import Data.Constraint hiding (Class)
 import Data.Constraint.Forall
+import Data.Constraint.Class1
 
 import Data.Foldable (Foldable(..))
 import Data.Traversable
 import Data.Void
 
 import Data.Algebra
-import Data.Algebra.TH
 import Language.Haskell.TH.Syntax
 
+import Data.Functor.Free.TH
+
+
 -- | The free functor for class @c@.
 --
 --   @Free c a@ is basically an expression tree with operations from class @c@
@@ -148,8 +153,12 @@
   extract = getExtract . rightAdjunctF Extract
   duplicate = getDuplicate . rightAdjunctF (Duplicate . unit . unit)
 
-instance c ~ Class f => Algebra f (Free c a) where
-  algebra fa = Free $ \k -> evaluate (fmap (rightAdjunct k) fa)
+instance SuperClass1 (Class f) c => Algebra f (Free c a) where
+  algebra fa = Free $ \k -> h scls1 (fmap (rightAdjunct k) fa)
+    where
+      h :: c b => (c b :- Class f b) -> f b -> b
+      h (Sub Dict) = evaluate
+      
 
 
 
@@ -173,38 +182,10 @@
 initial = rightAdjunct absurd
 
 
--- | Derive the instances of @`Free` c a@ for the class @c@, `Show`, `Foldable` and `Traversable`.
---
--- For example:
---
--- @deriveInstances ''Num@
-deriveInstances :: Name -> Q [Dec]
-deriveInstances nm = concat <$> sequenceA
-  [ deriveSignature nm
-  , deriveInstanceWith_skipSignature freeHeader $ return []
-  , deriveInstanceWith_skipSignature liftAFreeHeader $ return []
-  , deriveInstanceWith_skipSignature showHelperHeader $ return []
-  , [d|instance ForallLifted $(return c) where dictLifted = Dict|]
-  ]
-  where
-    freeHeader = return $ ForallT [PlainTV a] []
-      (AppT c (AppT (AppT free c) (VarT a)))
-    liftAFreeHeader = return $ ForallT [PlainTV f,PlainTV a] [AppT (ConT ''Applicative) (VarT f)]
-      (AppT c (AppT (AppT (AppT liftAFree c) (VarT f)) (VarT a)))
-    showHelperHeader = return $ ForallT [PlainTV a] []
-      (AppT c (AppT (AppT showHelper sig) (VarT a)))
-    free = ConT ''Free
-    liftAFree = ConT ''LiftAFree
-    showHelper = ConT ''ShowHelper
-    c = ConT nm
-    sig = ConT $ mkName (nameBase nm ++ "Signature")
-    a = mkName "a"
-    f = mkName "f"
 
-
 newtype LiftAFree c f a = LiftAFree { getLiftAFree :: f (Free c a) }
 
-instance (Applicative f, c ~ Class s) => Algebra s (LiftAFree c f a) where
+instance (Applicative f, SuperClass1 (Class s) c) => Algebra s (LiftAFree c f a) where
   algebra = LiftAFree . fmap algebra . traverse getLiftAFree
 
 instance ForallLifted c => Foldable (Free c) where
@@ -225,3 +206,15 @@
 
 instance (Show a, Show (Signature c (ShowHelper (Signature c) a)), c (ShowHelper (Signature c) a)) => Show (Free c a) where
   showsPrec p = showsPrec p . rightAdjunct (ShowUnit :: a -> ShowHelper (Signature c) a)
+  
+-- | Derive the instances of @`Free` c a@ for the class @c@, `Show`, `Foldable` and `Traversable`.
+--
+-- For example:
+--
+-- @deriveInstances ''Num@
+deriveInstances :: Name -> Q [Dec]
+deriveInstances = deriveInstances' ''ForallLifted 'dictLifted ''Free ''LiftAFree ''ShowHelper
+
+deriveInstances' ''ForallLifted 'dictLifted ''Free ''LiftAFree ''ShowHelper ''Num
+deriveInstances' ''ForallLifted 'dictLifted ''Free ''LiftAFree ''ShowHelper ''Semigroup
+deriveInstances' ''ForallLifted 'dictLifted ''Free ''LiftAFree ''ShowHelper ''Monoid
diff --git a/src/Data/Functor/Free/TH.hs b/src/Data/Functor/Free/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Functor/Free/TH.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE
+    ConstraintKinds
+  , GADTs
+  , RankNTypes
+  , TypeOperators
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , UndecidableInstances
+  , ScopedTypeVariables
+  , DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
+  , TemplateHaskell
+  , PolyKinds
+  #-}
+module Data.Functor.Free.TH where
+
+import Data.Constraint hiding (Class)
+import Data.Constraint.Class1
+
+import Data.Algebra.TH
+import Language.Haskell.TH.Syntax
+
+deriveInstances' :: Name -> Name -> Name -> Name -> Name -> Name -> Q [Dec]
+deriveInstances' forallLiftedNm dictLiftedNm freeNm liftAFreeNm showHelperNm nm = concat <$> sequenceA
+  [ deriveSignature nm
+  , deriveInstanceWith_skipSignature freeHeader $ return []
+  , deriveInstanceWith_skipSignature liftAFreeHeader $ return []
+  , deriveInstanceWith_skipSignature showHelperHeader $ return []
+  , return $ [InstanceD Nothing [] (AppT (ConT forallLiftedNm) c) [ValD (VarP dictLiftedNm) (NormalB (ConE 'Dict)) []]]
+  ]
+  where
+    freeHeader = return $ ForallT [PlainTV a, PlainTV vc] [AppT (AppT superClass1 c) (VarT vc)]
+      (AppT c (AppT (AppT free (VarT vc)) (VarT a)))
+    liftAFreeHeader = return $ ForallT [PlainTV f, PlainTV a, PlainTV vc] [AppT (ConT ''Applicative) (VarT f), isSC]
+      (AppT c (AppT (AppT (AppT liftAFree (VarT vc)) (VarT f)) (VarT a)))
+    showHelperHeader = return $ ForallT [PlainTV a] []
+      (AppT c (AppT (AppT showHelper sig) (VarT a)))
+    isSC = AppT (AppT superClass1 c) (VarT vc)
+    free = ConT freeNm
+    liftAFree = ConT liftAFreeNm
+    showHelper = ConT showHelperNm
+    superClass1 = ConT ''SuperClass1
+    c = ConT nm
+    sig = ConT $ mkName (nameBase nm ++ "Signature")
+    a = mkName "a"
+    f = mkName "f"
+    vc = mkName "c"
+
diff --git a/src/Data/Functor/HHCofree.hs b/src/Data/Functor/HHCofree.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Functor/HHCofree.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE
+    GADTs
+  , RankNTypes
+  , TypeOperators
+  , ConstraintKinds
+  , FlexibleContexts
+  , FlexibleInstances
+  , ScopedTypeVariables
+  , UndecidableInstances
+  , MultiParamTypeClasses
+  #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.HHCofree
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  sjoerd@w3future.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- A cofree functor is right adjoint to a forgetful functor.
+-- In this package the forgetful functor forgets class constraints.
+--
+-- Compared to @Data.Functor.HCofree@ we have 2 two parameters.
+-----------------------------------------------------------------------------
+module Data.Functor.HHCofree where
+
+import Prelude hiding ((.), id)
+import Data.Constraint (Dict(..), (:-)(..))
+import Data.Constraint.Class1
+import Data.Functor.HHFree (HHFree(..))
+import qualified Data.Functor.HHFree as F
+
+import Control.Category
+import Data.Bifunctor (Bifunctor(bimap))
+import Data.Bifunctor.Functor
+import Data.Profunctor
+import Data.Profunctor.Monad
+
+
+-- | Natural transformations.
+type f :~~> g = forall c d. f c d -> g c d
+
+-- | The higher order cofree functor for constraint @c@.
+data HHCofree c g a b where
+  HHCofree :: c f => (f :~~> g) -> f a b -> HHCofree c g a b
+
+
+counit :: HHCofree c g :~~> g
+counit (HHCofree k fa) = k fa
+
+leftAdjunct :: c f => (f :~~> g) -> f :~~> HHCofree c g
+leftAdjunct k fa = HHCofree k fa
+
+-- | @unit = leftAdjunct id@
+unit :: c g => g :~~> HHCofree c g
+unit = leftAdjunct id
+
+-- | @rightAdjunct f = counit . f@
+rightAdjunct :: (f :~~> HHCofree c g) -> f :~~> g
+rightAdjunct f = counit . f
+
+transform :: (forall r. c r => (r :~~> f) -> r :~~> g) -> HHCofree c f :~~> HHCofree c g
+transform t (HHCofree k a) = HHCofree (t k) a
+
+hfmap :: (f :~~> g) -> HHCofree c f :~~> HHCofree c g
+hfmap f = transform (\k -> f . k)
+
+hextend :: (HHCofree c f :~~> g) -> HHCofree c f :~~> HHCofree c g
+hextend f = transform (\k -> f . leftAdjunct k)
+
+
+instance BifunctorFunctor (HHCofree c) where
+  bifmap = hfmap
+
+instance BifunctorComonad (HHCofree c) where
+  biextract = counit
+  biextend = hextend
+  
+instance ProfunctorFunctor (HHCofree c) where
+  promap = hfmap
+
+instance ProfunctorComonad (HHCofree c) where
+  proextract = counit
+  produplicate = hextend id
+
+
+instance SuperClass1 Bifunctor c => Bifunctor (HHCofree c g) where
+  bimap f g (HHCofree k a) = HHCofree k (h scls1 f g a)
+    where
+      h :: c f => (c f :- Bifunctor f) -> (a -> a') -> (b -> b') -> f a b -> f a' b'
+      h (Sub Dict) = bimap
+      
+instance SuperClass1 Profunctor c => Profunctor (HHCofree c g) where
+  dimap f g (HHCofree k a) = HHCofree k (h scls1 f g a)
+    where
+      h :: c f => (c f :- Profunctor f) -> (a' -> a) -> (b -> b') -> f a b -> f a' b'
+      h (Sub Dict) = dimap
+      
+instance SuperClass1 Strong c => Strong (HHCofree c f) where
+  first' (HHCofree k a) = HHCofree k (h scls1 a)
+    where
+      h :: c g => (c g :- Strong g) -> g a b -> g (a, d) (b, d)
+      h (Sub Dict) = first'
+      
+instance SuperClass1 Choice c => Choice (HHCofree c f) where
+  left' (HHCofree k a) = HHCofree k (h scls1 a)
+    where
+      h :: c g => (c g :- Choice g) -> g a b -> g (Either a d) (Either b d)
+      h (Sub Dict) = left'
+      
+instance SuperClass1 Closed c => Closed (HHCofree c f) where
+  closed (HHCofree k a) = HHCofree k (h scls1 a)
+    where
+      h :: c g => (c g :- Closed g) -> g a b -> g (d -> a) (d -> b)
+      h (Sub Dict) = closed