diff --git a/examples/Sem.hs b/examples/Sem.hs
deleted file mode 100644
--- a/examples/Sem.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveTraversable, FlexibleInstances, FlexibleContexts, UndecidableInstances, DataKinds #-}
-module Sem where
-  
-import Data.Functor.Free
-
-class BaseSem a where
-  val :: Int -> a
-  add :: a -> a -> a
-
-instance BaseSem Int where
-  val = id
-  add = (+)
-
-class BaseSem a => AdvSem a where
-  mul :: a -> a -> a
-
-instance AdvSem Int where
-  mul = (*)
-
-deriveInstances ''BaseSem
-deriveInstances ''AdvSem
-
-
-test :: Free AdvSem String
-test = mul (add (pure "a") (val 3)) (val 5)
-
-evaluate :: Free AdvSem String -> Int
-evaluate = rightAdjunct lookupVar
-  where
-    lookupVar :: String -> Int
-    lookupVar "a" = 2
-    lookupVar v = error $ "Unknown variable: " ++ v
-
-main :: IO ()
-main = putStrLn $ show test ++ " = " ++ show (evaluate test)
diff --git a/examples/SemSum.hs b/examples/SemSum.hs
new file mode 100644
--- /dev/null
+++ b/examples/SemSum.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE 
+  TemplateHaskell, TypeFamilies, DeriveTraversable, FlexibleInstances, UndecidableInstances,
+  TypeOperators, MultiParamTypeClasses, ConstraintKinds, UndecidableSuperClasses, QuantifiedConstraints 
+  #-}
+  
+module Sem where
+  
+import GHC.Generics
+import Data.Algebra
+import Data.Functor.Free
+
+class BaseSem a where
+  val :: Int -> a
+  add :: a -> a -> a
+
+instance BaseSem Int where
+  val = id
+  add = (+)
+
+class SubSem a where
+  sub :: a -> a -> a
+
+instance SubSem Int where
+  sub = (-)
+
+class MulSem a where
+  mul :: a -> a -> a
+
+instance MulSem Int where
+  mul = (*)
+
+
+class (a x, b x) => (a + b) x
+instance (a x, b x) => (a + b) x
+
+type instance Signature (a + b) = Signature a :+: Signature b
+
+instance (AlgebraSignature f, AlgebraSignature g) => AlgebraSignature (f :+: g) where
+  type Class (f :+: g) = Class f + Class g
+  evaluate (L1 f) = evaluate f
+  evaluate (R1 f) = evaluate f
+  
+
+deriveInstances ''BaseSem
+deriveInstances ''SubSem
+deriveInstances ''MulSem
+
+
+test :: Free (BaseSem + SubSem + MulSem) String
+test = mul (add (pure "a") (val 3)) (sub (val 5) (pure "b"))
+
+eval :: Free (BaseSem + SubSem + MulSem) String -> Int
+eval = rightAdjunct lookupVar
+  where
+    lookupVar :: String -> Int
+    lookupVar "a" = 2
+    lookupVar "b" = 1
+    lookupVar v = error $ "Unknown variable: " ++ v
+
+main :: IO ()
+main = putStrLn $ show test ++ " = " ++ show (eval test)
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:             1.0
+version:             1.0.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
diff --git a/src/Data/Functor/Free/Internal.hs b/src/Data/Functor/Free/Internal.hs
--- a/src/Data/Functor/Free/Internal.hs
+++ b/src/Data/Functor/Free/Internal.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
-    RankNTypes
+    GADTs
+  , RankNTypes
   , TypeOperators
   , DeriveFunctor
   , DeriveFoldable
@@ -88,17 +89,19 @@
   traverse f = getLiftAFree . rightAdjunct (LiftAFree . fmap unit . f)
 
 
-data ShowHelper f a = ShowUnit a | ShowRec (f (ShowHelper f a))
+data ShowHelper a where 
+  ShowUnit :: a -> ShowHelper a
+  ShowRec :: Show (f (ShowHelper a)) => f (ShowHelper a) -> ShowHelper a
 
-instance Algebra f (ShowHelper f a) where
+instance Show (f (ShowHelper a)) => Algebra f (ShowHelper a) where
   algebra = ShowRec
 
-instance (Show a, Show (f (ShowHelper f a))) => Show (ShowHelper f a) where
+instance Show a => Show (ShowHelper a) where
   showsPrec p (ShowUnit a) = showParen (p > 10) $ showString "unit " . showsPrec 11 a
   showsPrec p (ShowRec f) = showsPrec p f
 
-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)
+instance (Show a, Show (Signature c (ShowHelper a)), c (ShowHelper a)) => Show (Free c a) where
+  showsPrec p = showsPrec p . rightAdjunct ShowUnit
 
 
 class (a => b) => a :=> b
@@ -110,18 +113,15 @@
 --
 -- @deriveInstances ''Num@
 deriveInstances :: Name -> Q [Dec]
-deriveInstances 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
-    ]
-    where
-      freeHeader = [t|forall a c. (forall x. c x :=> $clss x) => $clss (Free c a)|]
-      liftAFreeHeader = [t|forall f a c. (Applicative f, forall x. c x :=> $clss x) => $clss (LiftAFree c f a)|]
-      showHelperHeader = [t|forall a. $clss (ShowHelper $sig a)|]
-      clss = pure $ ConT nm
-      sig = pure . ConT $ signatureName sigInfo
+deriveInstances nm = 
+  concat <$> sequenceA
+  [ deriveSignature nm
+  , deriveInstanceWith_skipSignature freeHeader $ return []
+  , deriveInstanceWith_skipSignature liftAFreeHeader $ return []
+  , deriveInstanceWith_skipSignature showHelperHeader $ return []
+  ]
+  where
+    freeHeader = [t|forall a c. (forall x. c x :=> $clss x) => $clss (Free c a)|]
+    liftAFreeHeader = [t|forall f a c. (Applicative f, forall x. c x :=> $clss x) => $clss (LiftAFree c f a)|]
+    showHelperHeader = [t|forall a. Show a => $clss (ShowHelper a)|]
+    clss = pure $ ConT nm