diff --git a/CHANGELOG b/CHANGELOG
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,8 +1,12 @@
 CHANGELOG
 
+0.8.2 -> 0.8.3
+  - Added Data.Functor.Free.TH to other-modules
+  
 0.8.1 -> 0.8.2
   - Support for `deriveInstances` for classes which have one or more superclasses
   - `deriveInstances` now also derives the `HasSuperClasses` instance
+  - Expose internal `ShowHelper` datatype
   
 0.8 -> 0.8.1
   - Added HHCofree
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.2
+version:             0.8.3
 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
@@ -39,6 +39,9 @@
     Data.Functor.HFree,
     Data.Functor.HHCofree,
     Data.Functor.HHFree
+    
+  other-modules:
+    Data.Functor.Free.TH
 
   default-language:
     Haskell2010
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
@@ -51,6 +51,7 @@
   , InitialObject
   , initial
   
+  -- * Internal
   , ShowHelper(..)
 
   ) where
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,59 @@
+{-# LANGUAGE
+    ConstraintKinds
+  , GADTs
+  , RankNTypes
+  , TypeOperators
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , UndecidableInstances
+  , ScopedTypeVariables
+  , DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
+  , TemplateHaskell
+  , PolyKinds
+  , DataKinds
+  #-}
+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' :: Bool -> Name -> Name -> Name -> Name -> Name -> Name -> Q [Dec]
+deriveInstances' withHSC forallLiftedNm dictLiftedNm freeNm liftAFreeNm showHelperNm nm = getSignatureInfo nm >>= h where
+  h sigInfo =
+    concat <$> sequenceA
+    [ deriveSignature nm
+    , deriveInstanceWith_skipSignature freeHeader $ return []
+    , deriveInstanceWith_skipSignature liftAFreeHeader $ return []
+    , deriveInstanceWith_skipSignature showHelperHeader $ return []
+    , deriveSuperclassInstances showHelperHeader
+    , hasSuperClassesInstance
+    , 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)))
+      hasSuperClassesInstance = if withHSC then [d|instance HasSuperClasses $(pure c) where {
+        type SuperClasses $(pure c) = $(pure c) ': $(scs);
+        superClasses = Sub Dict;
+        containsSelf = Sub Dict
+      }|] else return []
+      scs = foldr (\(SuperclassTH scnm _ _) q -> [t|SuperClasses $(pure (ConT scnm)) ++ $(q)|]) [t|'[]|] $ superclasses sigInfo
+      isSC = AppT (AppT superClass1 c) (VarT vc)
+      free = ConT freeNm
+      liftAFree = ConT liftAFreeNm
+      showHelper = ConT showHelperNm
+      superClass1 = ConT ''SuperClass1
+      c = ConT nm
+      sig = ConT $ signatureName sigInfo
+      a = mkName "a"
+      f = mkName "f"
+      vc = mkName "c"