diff --git a/.ghci b/.ghci
index 7540d9a..f46a545 100644
--- a/.ghci
+++ b/.ghci
@@ -2,5 +2,7 @@
 :set -itest
 :set -DDEFAULT_SIGNATURES
 :set -XOverloadedStrings
+:set -XTemplateHaskell
+:set -XRankNTypes
 :set -Wall -Wredundant-constraints
 :set prompt "λ> "
diff --git a/safecopy.cabal b/safecopy.cabal
index 7c0e38d..0a4b1b8 100644
--- a/safecopy.cabal
+++ b/safecopy.cabal
@@ -1,6 +1,5 @@
 Name:                safecopy
-Version:             0.10.4.2
-x-revision:          10
+Version:             0.10.5
 Synopsis:            Binary serialization with version control.
 Description:         An extension to Data.Serialize with built-in version control.
 Homepage:            https://github.com/acid-state/safecopy
@@ -46,9 +45,14 @@ Library
                        cereal >= 0.5.3 && < 0.6,
                          -- cereal 0.5.3 introduced instance Monoid Put
                        bytestring < 0.13,
-                       generic-data >= 0.3.0.0,
                        containers >= 0.3 && < 0.8,
+                       -- Used to implement the default getCopy/putCopy implementations
+                       generic-data >= 0.3.0.0,
+                       -- generic-lens,
+                       lens,
                        old-time < 1.2,
+                       pretty,
+                       syb,
                        template-haskell >= 2.11.0.0 && < 2.23,
                        text < 1.3 || >= 2.0 && < 2.2,
                        time >= 1.6.0.1 && < 1.15,
@@ -69,13 +73,17 @@ Test-suite instances
   Main-is:             instances.hs
   Hs-Source-Dirs:      test/
   GHC-Options:         -Wall -threaded -rtsopts -with-rtsopts=-N
-  Build-depends:       base, cereal, template-haskell, safecopy,
+  Build-depends:       base, bytestring, cereal, template-haskell, safecopy,
                        containers, time, array, vector, lens >= 4.7 && < 6,
                        lens-action
+                     , syb
                      , tasty
+                     , tasty-hunit
                      , tasty-quickcheck
                      , quickcheck-instances
                      , QuickCheck >= 2.8.2 && < 3
+                     , th-orphans
+  Other-Modules:       Types
 
 Test-suite generic
   Default-language:    Haskell2010
diff --git a/src/Data/SafeCopy.hs b/src/Data/SafeCopy.hs
index 3ccd84a..228633e 100644
--- a/src/Data/SafeCopy.hs
+++ b/src/Data/SafeCopy.hs
@@ -122,11 +122,17 @@ module Data.SafeCopy
 
       -- * Template haskell functions
     , deriveSafeCopy
+    , deriveSafeCopy'
     , deriveSafeCopyIndexedType
+    , deriveSafeCopyIndexedType'
     , deriveSafeCopySimple
+    , deriveSafeCopySimple'
     , deriveSafeCopySimpleIndexedType
+    , deriveSafeCopySimpleIndexedType'
     , deriveSafeCopyHappstackData
+    , deriveSafeCopyHappstackData'
     , deriveSafeCopyHappstackDataIndexedType
+    , deriveSafeCopyHappstackDataIndexedType'
 
       -- * Rarely used functions
     , getSafeGet
diff --git a/src/Data/SafeCopy/Derive.hs b/src/Data/SafeCopy/Derive.hs
index e3f262c..fea7947 100644
--- a/src/Data/SafeCopy/Derive.hs
+++ b/src/Data/SafeCopy/Derive.hs
@@ -1,16 +1,74 @@
-{-# LANGUAGE TemplateHaskell, CPP #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
 
-module Data.SafeCopy.Derive where
+module Data.SafeCopy.Derive
+  ( deriveSafeCopy
+  , deriveSafeCopy'
+  , deriveSafeCopySimple
+  , deriveSafeCopySimple'
+  , deriveSafeCopyHappstackData
+  , deriveSafeCopyHappstackData'
+  , deriveSafeCopyIndexedType
+  , deriveSafeCopyIndexedType'
+  , deriveSafeCopySimpleIndexedType
+  , deriveSafeCopySimpleIndexedType'
+  , deriveSafeCopyHappstackDataIndexedType
+  , deriveSafeCopyHappstackDataIndexedType'
+  , renderTH
+  , renderDecs
+  ) where
 
+-- import Data.Generics.Labels ()
 import Data.Serialize (getWord8, putWord8, label)
-import Data.SafeCopy.SafeCopy
-
+import Data.SafeCopy.SafeCopy (Version(unVersion), SafeCopy(version, kind, errorTypeName, getCopy, putCopy), contain, getSafePut, getSafeGet, safeGet, safePut)
 import Language.Haskell.TH hiding (Kind)
+import Control.Lens ((%=), _1, _3, makeLenses, over, set, to, use, view)
 import Control.Monad
+import Control.Monad.Trans.Class as MTL (lift)
+import Control.Monad.Trans.RWS.Lazy as MTL (ask, execRWST, local, RWST, tell)
+-- import Data.Data (Data)
+import Data.Generics (Data, everywhere, mkT)
+import Data.List (intercalate, intersperse, isPrefixOf, nub)
 import Data.Maybe (fromMaybe)
+import Data.String (IsString(fromString))
 #ifdef __HADDOCK__
 import Data.Word (Word8) -- Haddock
 #endif
+import Debug.Trace
+import GHC.Generics (Generic)
+import GHC.Stack (callStack, getCallStack, HasCallStack, SrcLoc(..))
+import Language.Haskell.TH.PprLib (Doc, to_HPJ_Doc)
+import Language.Haskell.TH.Syntax
+-- import SeeReason.SrcLoc (compactStack)
+import qualified Text.PrettyPrint as HPJ
+
+data DeriveType = Normal | Simple | HappstackData
+
+data R a =
+  R { _deriveType :: DeriveType
+    , _versionId :: Version a
+    , _kindName :: Name
+    , _freeVars :: [Name]
+    , _params :: [Type]
+    -- , _bindings :: [(Name, Type)]
+    , _indent :: String }
+
+type W = [Dec]
+
+data S =
+  S { _extraContext :: Cxt
+    , _bindings :: [(Name, Type)]
+    }
+
+$(makeLenses ''R)
+$(makeLenses ''S)
 
 -- | Derive an instance of 'SafeCopy'.
 --
@@ -98,10 +156,14 @@ import Data.Word (Word8) -- Haddock
 --   version of your data type and 'deriveSafeCopy' in another
 --   version without any problems.
 deriveSafeCopy :: Version a -> Name -> Name -> Q [Dec]
-deriveSafeCopy = internalDeriveSafeCopy Normal
+deriveSafeCopy versionId kindName tyName = do
+  deriveSafeCopy' versionId kindName (conT tyName)
 
-deriveSafeCopyIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
-deriveSafeCopyIndexedType = internalDeriveSafeCopyIndexedType Normal
+-- | Generalized version of 'deriveSafeCopy', takes a 'Type' rather
+-- than a type 'Name'.
+deriveSafeCopy' :: Version a -> Name -> TypeQ -> Q [Dec]
+deriveSafeCopy' versionId kindName typ = do
+  internalDeriveSafeCopy Normal versionId kindName typ
 
 -- | Derive an instance of 'SafeCopy'.  The instance derived by
 --   this function is simpler than the one derived by
@@ -153,10 +215,12 @@ deriveSafeCopyIndexedType = internalDeriveSafeCopyIndexedType Normal
 --   your data type and 'deriveSafeCopySimple' in another version
 --   without any problems.
 deriveSafeCopySimple :: Version a -> Name -> Name -> Q [Dec]
-deriveSafeCopySimple = internalDeriveSafeCopy Simple
+deriveSafeCopySimple versionId kindName tyName =
+  deriveSafeCopySimple' versionId kindName (conT tyName)
 
-deriveSafeCopySimpleIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
-deriveSafeCopySimpleIndexedType = internalDeriveSafeCopyIndexedType Simple
+deriveSafeCopySimple' :: Version a -> Name -> TypeQ -> Q [Dec]
+deriveSafeCopySimple' versionId kindName typ = do
+  internalDeriveSafeCopy Simple versionId kindName typ
 
 -- | Derive an instance of 'SafeCopy'.  The instance derived by
 --   this function should be compatible with the instance derived
@@ -203,127 +267,200 @@ deriveSafeCopySimpleIndexedType = internalDeriveSafeCopyIndexedType Simple
 --   your data type and 'deriveSafeCopyHappstackData' in another version
 --   without any problems.
 deriveSafeCopyHappstackData :: Version a -> Name -> Name -> Q [Dec]
-deriveSafeCopyHappstackData = internalDeriveSafeCopy HappstackData
+deriveSafeCopyHappstackData versionId kindName tyName =
+  deriveSafeCopyHappstackData' versionId kindName (conT tyName)
 
-deriveSafeCopyHappstackDataIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
-deriveSafeCopyHappstackDataIndexedType = internalDeriveSafeCopyIndexedType HappstackData
+deriveSafeCopyHappstackData' :: Version a -> Name -> TypeQ -> Q [Dec]
+deriveSafeCopyHappstackData' versionId kindName typq = do
+  internalDeriveSafeCopy HappstackData versionId kindName typq
 
-data DeriveType = Normal | Simple | HappstackData
+-- * Type traversal.
 
-forceTag :: DeriveType -> Bool
-forceTag HappstackData = True
-forceTag _             = False
+-- | Traverse a types to collect information about what context the
+-- 'SafeCopy' instance will need, and then output a declaration of the
+-- 'SafeCopy' instance.
+internalDeriveSafeCopy :: HasCallStack => DeriveType -> Version a -> Name -> TypeQ -> Q [Dec]
+internalDeriveSafeCopy deriveType versionId kindName typq = do
+  (S _ bindings, decs) <-
+    execRWST (doType =<< MTL.lift typq)
+      (R deriveType versionId kindName [] [] "") (S mempty [])
+  let decs' = everywhere (mkT (expand bindings)) decs
+  pure ({-trace ("decs=" <> vis decs' <> "\nbindings=" <> show bindings)-} decs')
 
-#if MIN_VERSION_template_haskell(2,17,0)
-tyVarName :: TyVarBndr s -> Name
-tyVarName (PlainTV n _) = n
-tyVarName (KindedTV n _ _) = n
-#else
-tyVarName :: TyVarBndr -> Name
-tyVarName (PlainTV n) = n
-tyVarName (KindedTV n _) = n
-#endif
+doType :: HasCallStack => Type -> RWST (R a) W S Q ()
+doType typ = -- traceLocM ("doType " <> ren typ) $
+  case typ of
+    ConT tyName -> doTypeName tyName
+    ForallT tyvars cxt' typ' -> do
+      extraContext %= (<> cxt')
+      local (over freeVars (fmap unKind tyvars <>)) $ doType typ'
+    AppT t1 t2 -> local (over params (t2 :)) $ doType t1
+    TupleT n -> doTypeName (tupleTypeName n)
+    _ -> fail $ "Can't derive SafeCopy instance for: " ++ show typ -- ++ " (" <> compactStack getStack <> ")"
 
-internalDeriveSafeCopy :: DeriveType -> Version a -> Name -> Name -> Q [Dec]
-internalDeriveSafeCopy deriveType versionId kindName tyName = do
-  info <- reify tyName
-  internalDeriveSafeCopy' deriveType versionId kindName tyName info
+doTypeName :: Name -> RWST (R a) W S Q ()
+doTypeName tyName = -- traceLocM ("doTypeName " <> ren tyName) $
+  MTL.lift (reify tyName) >>= doInfo tyName
 
-internalDeriveSafeCopy' :: DeriveType -> Version a -> Name -> Name -> Info -> Q [Dec]
-internalDeriveSafeCopy' deriveType versionId kindName tyName info = do
+-- | Process the info obtained from a type name
+doInfo :: HasCallStack => Name -> Info -> RWST (R a) W S Q ()
+doInfo tyName info = -- traceLocM ("doInfo " <> ren tyName <> " (" <> ren info <> ")") $
   case info of
     TyConI (DataD context _name tyvars _kind cons _derivs)
       | length cons > 255 -> fail $ "Can't derive SafeCopy instance for: " ++ show tyName ++
                                     ". The datatype must have less than 256 constructors."
-      | otherwise         -> worker context tyvars (zip [0..] cons)
+      | otherwise -> do
+          extraContext %= (++ ({-traceLoc ("context=" <> ren context)-} context))
+          withBindings tyvars $ do
+            doCons tyName (ConT tyName) tyvars cons
 
-    TyConI (NewtypeD context _name tyvars _kind con _derivs) ->
-      worker context tyvars [(0, con)]
+    TyConI (NewtypeD context _name tyvars _kind con _derivs) -> do
+      extraContext %= (<> context)
+      withBindings tyvars $ do
+        doCons tyName (ConT tyName) tyvars [con]
 
     FamilyI _ insts -> do
-      decs <- forM insts $ \inst ->
-        case inst of
-#if MIN_VERSION_template_haskell(2,15,0)
-          DataInstD context _ nty _kind cons _derivs ->
-              worker' (return nty) context [] (zip [0..] cons)
+      mapM_ (doInst tyName info . instCompat) insts
+    _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, info) -- ++ " (" <> compactStack getStack <> ")"
 
-          NewtypeInstD context _ nty _kind con _derivs ->
-              worker' (return nty) context [] [(0, con)]
-#else
-          DataInstD context _name ty _kind cons _derivs ->
-              worker' (foldl appT (conT tyName) (map return ty)) context [] (zip [0..] cons)
+withBindings :: [TyVarBndr] -> RWST (R a) W S Q () -> RWST (R a) W S Q ()
+withBindings tyvars action = do
+  ps <- view params
+  case length ps <= length tyvars of
+    False -> fail $ "Arity error"
+    True -> do
+      let (tobind, remaining) = splitAt (length tyvars) ps
+      let newbindings :: [(Name, Type)]
+          newbindings = zip (fmap unKind tyvars) tobind
+      bindings %= (newbindings <>)
+      local (set params remaining) $ action
 
-          NewtypeInstD context _name ty _kind con _derivs ->
-              worker' (foldl appT (conT tyName) (map return ty)) context [] [(0, con)]
-#endif
-          _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, inst)
-      return $ concat decs
-    _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, info)
-  where
-    worker = worker' (conT tyName)
-    worker' tyBase context tyvars cons =
-      let ty = foldl appT tyBase [ varT $ tyVarName var | var <- tyvars ]
-          safeCopyClass args = foldl appT (conT ''SafeCopy) args
-      in (:[]) <$> instanceD (cxt $ [safeCopyClass [varT $ tyVarName var] | var <- tyvars] ++ map return context)
-                                       (conT ''SafeCopy `appT` ty)
-                                       [ mkPutCopy deriveType cons
-                                       , mkGetCopy deriveType (show tyName) cons
-                                       , valD (varP 'version) (normalB $ litE $ integerL $ fromIntegral $ unVersion versionId) []
-                                       , valD (varP 'kind) (normalB (varE kindName)) []
-                                       , funD 'errorTypeName [clause [wildP] (normalB $ litE $ StringL (show tyName)) []]
-                                       ]
-
-internalDeriveSafeCopyIndexedType :: DeriveType -> Version a -> Name -> Name -> [Name] -> Q [Dec]
-internalDeriveSafeCopyIndexedType deriveType versionId kindName tyName tyIndex' = do
-  info <- reify tyName
-  internalDeriveSafeCopyIndexedType' deriveType versionId kindName tyName tyIndex' info
-
-internalDeriveSafeCopyIndexedType' :: DeriveType -> Version a -> Name -> Name -> [Name] -> Info -> Q [Dec]
-internalDeriveSafeCopyIndexedType' deriveType versionId kindName tyName tyIndex' info = do
-  tyIndex <- mapM conT tyIndex'
-  case info of
-    FamilyI _ insts -> do
-      decs <- forM insts $ \inst ->
-        case inst of
+unKind :: TyVarBndr -> Name
+unKind (PlainTV name) = name
+unKind (KindedTV name _) = name
+
+doInst :: HasCallStack => Name -> Info -> Maybe (Cxt, Type, Maybe Kind, [Con], [DerivClause]) -> RWST (R a) W S Q ()
+doInst _ info Nothing = fail $ "Can't derive SafeCopy instance for: " ++ show info
+doInst tyName _ (Just (context, nty, _knd, cons, _derivs)) = do
+  extraContext %= (<> context)
+  doCons tyName nty [] cons
+
+doCons :: HasCallStack => Name -> Type -> [TyVarBndr] -> [Con] -> RWST (R a) W S Q ()
+doCons tyName tyBase tyvars cons = do
+  let ty = foldl AppT tyBase (fmap (\var -> VarT $ tyVarName var) tyvars)
+  mapM_ doCon cons
+  context <- use extraContext
+  r <- ask
+  dec <- MTL.lift $
+    instanceD
+      (cxt (fmap pure (nub context)))
+      (pure (ConT ''SafeCopy `AppT` ty))
+      [ mkPutCopy (_deriveType r) (zip [0..] cons)
+      , mkGetCopy (_deriveType r) (renderTH (ppr . everywhere (mkT cleanName)) (ConT tyName)) (zip [0..] cons)
+      , valD (varP 'version) (normalB $ litE $ integerL $ fromIntegral $ unVersion (_versionId r)) []
+      , valD (varP 'kind) (normalB (varE (_kindName r))) []
+      , funD 'errorTypeName [clause [wildP] (normalB $ litE $ StringL (renderTH (ppr . everywhere (mkT cleanName)) (ConT tyName))) []] ]
+  tell [dec]
+
+doCon :: HasCallStack => Con -> RWST (R a) W S Q ()
+doCon con = -- traceLocM ("doCon " <> ren con) $ do
+  withSubs con $ \case
+    NormalC _name types -> mapM_ doField (fmap snd types)
+    RecC _name types -> mapM_ doField (fmap (view _3) types)
+    InfixC type1 _name type2 -> doField (snd type1) >> doField (snd type2)
+    ForallC _tyvars context con' -> do
+      extraContext %= (<> ({-traceLoc ("context=" <> show context)-} context))
+      doCon con'
+    GadtC _names _types _typ -> pure ()
+    RecGadtC _name _types _typ -> pure ()
+
+withSubs :: Data t => t -> (t -> RWST (R a) W S Q ()) -> RWST (R a) W S Q ()
+withSubs a f = do
+  bnd <- use bindings
+  f (everywhere (mkT (expand bnd)) a)
+
+expand :: [(Name, Type)] -> Type -> Type
+expand bindings typ@(VarT name) =
+  case lookup name bindings of
+    Nothing -> typ
+    Just typ' -> {-trace ("sub: " <> show typ <> " -> " <> show typ')-} typ'
+expand _ typ = typ
+
+-- | Values which appear in the fields of the type, these need
+-- instances if they are polymorphic.
+doField :: HasCallStack => Type -> RWST (R a) W S Q ()
+doField typ = -- traceLocM ("doField " <> vis typ) $
+  case polymorphic typ of
+    False -> pure ()
+    True -> do
+      context <- MTL.lift [t|SafeCopy $(pure typ)|]
+      extraContext %= (<> [context])
+
+-- | If we don't encounter any type variables when traversing the type
+-- it is considered to be fixed, not polymorphic.  In that case we
+-- assume the required instance is already visible, so no context is
+-- needed.  If the instance is an orphan it might not be visible, so
+-- this would fail.
+polymorphic :: Type -> Bool
+polymorphic (ConT _tyName) = False
+polymorphic (VarT _tyName) = True
+polymorphic (ForallT _ _ typ) = polymorphic typ
+polymorphic (AppT typ param) = polymorphic param || polymorphic typ
+polymorphic ListT = False
+polymorphic (TupleT _) = False
+polymorphic typ = error ("polymorphic " <> (show typ))
+
+instCompat :: Dec -> Maybe (Cxt, Type, Maybe Kind, [Con], [DerivClause])
 #if MIN_VERSION_template_haskell(2,15,0)
-          DataInstD context _ nty _kind cons _derivs
-            | nty == foldl AppT (ConT tyName) tyIndex ->
-              worker' (return nty) context [] (zip [0..] cons)
+instCompat (DataInstD context name nty knd cons derivs) =
+  Just (context, nty, knd, cons, derivs)
+instCompat (NewtypeInstD context name nty knd con derivs) =
+  Just (context, nty, knd, [con], derivs)
 #else
-          DataInstD context _name ty _kind cons _derivs
-            | ty == tyIndex ->
-              worker' (foldl appT (conT tyName) (map return ty)) context [] (zip [0..] cons)
+instCompat (DataInstD context name ty knd cons derivs) =
+  Just (context, foldl AppT (ConT name) ty, knd, cons, derivs)
+instCompat (NewtypeInstD context name ty knd con derivs) =
+  Just (context, foldl AppT (ConT name) ty, knd, [con], derivs)
 #endif
-            | otherwise ->
-              return []
+instCompat _inst = Nothing
 
-#if MIN_VERSION_template_haskell(2,15,0)
-          NewtypeInstD context _ nty _kind con _derivs
-            | nty == foldl AppT (ConT tyName) tyIndex ->
-              worker' (return nty) context [] [(0, con)]
+-- | Apply the TH pretty printer to a value after stripping any added
+-- suffixes from its names.  This may make it uncompilable, but it
+-- eliminates a source of randomness in the expected and actual test
+-- case results.
+renderTH :: {-Data a =>-} (a -> Doc) -> a -> String
+renderTH pretty decs =
+  HPJ.renderStyle (HPJ.style {HPJ.lineLength = 1000000 {-HPJ.mode = HPJ.OneLineMode-}}) $
+  to_HPJ_Doc $
+  pretty $
+  decs
+
+renderDecs :: [Dec] -> String
+renderDecs = renderTH (ppr . everywhere (mkT briefName))
+
+-- | Names with the best chance of compiling when prettyprinted:
+--    * Remove all package and module names
+--    * Remove suffixes on all constructor names
+--    * Remove suffixes on the four ids we export
+--    * Leave suffixes on all variables and type variables
+cleanName :: Name -> Name
+cleanName (Name oc (NameG _ns _pn mn)) = Name oc (NameQ mn)
+cleanName (Name oc (NameQ mn)) = Name oc (NameQ mn)
+cleanName (Name oc@(OccName _) (NameU _)) = Name oc NameS
+cleanName name@(Name _ (NameL _)) = name -- Not seeing any of these
+cleanName name@(Name _ NameS) = name
+
+#if MIN_VERSION_template_haskell(2,17,0)
+tyVarName :: TyVarBndr s -> Name
+tyVarName (PlainTV n _) = n
+tyVarName (KindedTV n _ _) = n
 #else
-          NewtypeInstD context _name ty _kind con _derivs
-            | ty == tyIndex ->
-              worker' (foldl appT (conT tyName) (map return ty)) context [] [(0, con)]
+tyVarName :: TyVarBndr -> Name
+tyVarName (PlainTV n) = n
+tyVarName (KindedTV n _) = n
 #endif
-            | otherwise ->
-              return []
-          _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, inst)
-      return $ concat decs
-    _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, info)
-  where
-    typeNameStr = unwords $ map show (tyName:tyIndex')
-    worker' tyBase context tyvars cons =
-      let ty = foldl appT tyBase [ varT $ tyVarName var | var <- tyvars ]
-          safeCopyClass args = foldl appT (conT ''SafeCopy) args
-      in (:[]) <$> instanceD (cxt $ [safeCopyClass [varT $ tyVarName var] | var <- tyvars] ++ map return context)
-                                       (conT ''SafeCopy `appT` ty)
-                                       [ mkPutCopy deriveType cons
-                                       , mkGetCopy deriveType typeNameStr cons
-                                       , valD (varP 'version) (normalB $ litE $ integerL $ fromIntegral $ unVersion versionId) []
-                                       , valD (varP 'kind) (normalB (varE kindName)) []
-                                       , funD 'errorTypeName [clause [wildP] (normalB $ litE $ StringL typeNameStr) []]
-                                       ]
+
+-- * Build the methods of the SafeCopy instance.
 
 mkPutCopy :: DeriveType -> [(Integer, Con)] -> DecQ
 mkPutCopy deriveType cons = funD 'putCopy $ map mkPutClause cons
@@ -345,8 +482,7 @@ mkPutCopy deriveType cons = funD 'putCopy $ map mkPutClause cons
 mkGetCopy :: DeriveType -> String -> [(Integer, Con)] -> DecQ
 mkGetCopy deriveType tyName cons = valD (varP 'getCopy) (normalB $ varE 'contain `appE` mkLabel) []
     where
-      mkLabel = varE 'label `appE` litE (stringL labelString) `appE` getCopyBody
-      labelString = tyName ++ ":"
+      mkLabel = varE 'label `appE` litE (stringL (tyName ++ ":")) `appE` getCopyBody
       getCopyBody
           = case cons of
               [(_, con)] | not (forceTag deriveType) -> mkGetBody con
@@ -393,6 +529,10 @@ mkSafeFunctions name baseFun con = do let origTypes = conTypes con
               where getName typ = fromMaybe err $ lookup typ typeList >>= flip lookup fs
                     err = error "mkSafeFunctions: never here"
 
+forceTag :: DeriveType -> Bool
+forceTag HappstackData = True
+forceTag _             = False
+
 -- | Follow type synonyms.  This allows us to see, for example,
 -- that @[Char]@ and @String@ are the same type and we just need
 -- to call 'getSafePut' or 'getSafeGet' once for both.
@@ -437,3 +577,160 @@ typeName ListT       = "List"
 typeName (AppT t u)  = typeName t ++ typeName u
 typeName (SigT t _k) = typeName t
 typeName _           = "_"
+
+-- * Debugging
+
+traceLoc :: HasCallStack => String -> a -> a
+traceLoc s a =
+  trace (s <> " (" <> compactStack getStack <> ")") a
+
+traceLocM :: HasCallStack => String -> RWST (R a) W S Q t -> RWST (R a) W S Q t
+traceLocM s t = do
+  ind <- view indent
+  ps <- view params
+  bindings <- use bindings
+  local (over indent ("  " <>)) $
+    trace (ind <> s <> "\n" <>
+           ind <> "  --> params: [" <> intercalate ", " (fmap vis ps) <> "]\n" <>
+           ind <> "  --> bindings: [" <> intercalate ", " (fmap (\(tv, ty) -> "(tv=" <> vis tv <> ", ty=" <> vis ty <> ")") bindings) <> "]\n" <>
+           ind <> "  --> stack: " <> compactStack ({-drop 1-} getStack)) t
+
+ren :: (Data a, Ppr a) => a -> String
+ren = renderTH (ppr . everywhere (mkT briefName))
+
+vis :: (Data a, Ppr a) => a -> String
+vis = renderTH (ppr . everywhere (mkT briefName'))
+
+-- This will probably make the expression invalid, but it
+-- removes random elements that will make tests fail.
+briefName :: Name -> Name
+briefName (Name oc (NameG _ns _pn _mn)) = Name oc NameS
+briefName (Name oc (NameQ _mn)) = Name oc NameS
+briefName (Name oc@(OccName _) (NameU _)) = Name oc NameS
+briefName name@(Name _ (NameL _)) = name -- Not seeing any of these
+briefName name@(Name _ NameS) = name
+
+briefName' :: Name -> Name
+briefName' name@(Name oc _nf) | oc == OccName "db" = visName name
+briefName' name = briefName name
+
+visName :: Name -> Name
+visName (Name oc nf) =
+  Name (OccName ("(Name (" <> show oc <> ") (" <> show nf <> "))")) NameS
+
+-- | Stack with main last.  Bottom frame includes the function name.
+-- Top frame includes the column number.
+compactStack :: forall s. (IsString s, Monoid s, HasCallStack) => [(String, SrcLoc)] -> s
+compactStack = mconcat . intersperse (" < " :: s) . compactLocs
+
+compactLocs :: forall s. (IsString s, Monoid s, HasCallStack) => [(String, SrcLoc)] -> [s]
+compactLocs [] = ["(no CallStack)"]
+compactLocs [(callee, loc)] = [fromString callee, srcloccol loc]
+compactLocs [(_, loc), (caller, _)] = [srcloccol loc <> "." <> fromString caller]
+compactLocs ((_, loc) : more@((caller, _) : _)) =
+  srcfunloc loc (fromString caller) : stacktail (fmap snd more)
+  where
+    stacktail :: [SrcLoc] -> [s]
+    stacktail [] = []
+    -- Include the column number of the last item, it may help to
+    -- figure out which caller is missing the HasCallStack constraint.
+    stacktail [loc'] = [srcloccol loc']
+    stacktail (loc' : more') = srcloc loc' : stacktail more'
+
+-- | With start column
+srcloccol :: (HasCallStack, IsString s, Semigroup s) => SrcLoc -> s
+srcloccol loc = srcloc loc <> ":" <> fromString (show (srcLocStartCol loc))
+
+-- | Compactly format a source location
+srcloc :: (IsString s, Semigroup s) => SrcLoc -> s
+srcloc loc = fromString (srcLocModule loc) <> ":" <> fromString (show (srcLocStartLine loc))
+
+-- | Compactly format a source location with a function name
+srcfunloc :: (IsString s, Semigroup s) => SrcLoc -> s -> s
+srcfunloc loc f = fromString (srcLocModule loc) <> "." <> f <> ":" <> fromString (show (srcLocStartLine loc))
+
+-- | Get the portion of the stack before we entered any SeeReason.Log module.
+getStack :: HasCallStack => [(String, SrcLoc)]
+getStack = dropBoringFrames $ getCallStack callStack
+  where
+    dropBoringFrames :: [(String, SrcLoc)] -> [(String, SrcLoc)]
+    dropBoringFrames = dropWhile (view (_1 . to (`elem` ["getStack", "traceLocM"])))
+
+isThisPackage :: String -> Bool
+isThisPackage s = trace ("isThisPackage " <> show s) False
+
+-- * Old versions of the derive function.
+
+-- Versions of the derive functions that take an additional list of
+-- type names, not 100% clear what this is for.  I'm hoping the
+-- changes to the regular version will supercede these.
+
+deriveSafeCopyIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
+deriveSafeCopyIndexedType versionId kindName tyName =
+  internalDeriveSafeCopyIndexedType Normal versionId kindName (conT tyName)
+
+deriveSafeCopyIndexedType' :: Version a -> Name -> TypeQ -> [Name] -> Q [Dec]
+deriveSafeCopyIndexedType' versionId kindName typ =
+  internalDeriveSafeCopyIndexedType Normal versionId kindName typ
+
+deriveSafeCopySimpleIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
+deriveSafeCopySimpleIndexedType versionId kindName tyName =
+  deriveSafeCopySimpleIndexedType' versionId kindName (conT tyName)
+
+deriveSafeCopySimpleIndexedType' :: Version a -> Name -> TypeQ -> [Name] -> Q [Dec]
+deriveSafeCopySimpleIndexedType' versionId kindName typ =
+  internalDeriveSafeCopyIndexedType Simple versionId kindName typ
+
+deriveSafeCopyHappstackDataIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
+deriveSafeCopyHappstackDataIndexedType versionId kindName tyName =
+  deriveSafeCopyHappstackDataIndexedType' versionId kindName (conT tyName)
+
+deriveSafeCopyHappstackDataIndexedType' :: Version a -> Name -> TypeQ -> [Name] -> Q [Dec]
+deriveSafeCopyHappstackDataIndexedType' versionId kindName typ =
+  internalDeriveSafeCopyIndexedType HappstackData versionId kindName typ
+
+internalDeriveSafeCopyIndexedType :: DeriveType -> Version a -> Name -> TypeQ -> [Name] -> Q [Dec]
+internalDeriveSafeCopyIndexedType deriveType versionId kindName typq tyIndex' = do
+  tyIndex <- mapM conT tyIndex'
+  typq >>= \case
+    typ@(ConT tyName) -> do
+      let itype = foldl AppT (ConT tyName) tyIndex
+      reify tyName >>= \case
+        FamilyI _ insts -> do
+          concat <$> (forM insts $ withInst2 typ (worker2 deriveType versionId kindName tyIndex' itype))
+        info -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, info) ++ " (5)"
+    typ -> fail $ "Can't derive SafeCopy instance for: " ++ show typ ++ " (6)"
+
+withInst2 ::
+  Monad m
+  => Type
+  -> (Type -> Cxt -> [TyVarBndr] -> [(Integer, Con)] -> m r)
+  -> Dec
+  -> m r
+#if MIN_VERSION_template_haskell(2,15,0)
+withInst2 typ worker (DataInstD context _ nty _ cons _) =
+  worker nty context [] (zip [0..] cons)
+withInst2 typ worker (NewtypeInstD context _ nty _ con _) =
+  worker nty context [] (zip [0..] [con])
+#else
+withInst2 typ worker (DataInstD context _ ty _ cons _) =
+  worker (foldl AppT typ ty) context [] (zip [0..] cons)
+withInst2 typ worker (NewtypeInstD context _ ty _ con _) =
+  worker (foldl AppT typ ty) context [] (zip [0..] [con])
+#endif
+withInst2 typ _ _ =
+  fail $ "Can't derive SafeCopy instance for: " ++ show typ
+
+worker2 :: DeriveType -> Version a -> Name -> [Name] -> Type -> Type -> Cxt -> [TyVarBndr] -> [(Integer, Con)] -> Q [Dec]
+worker2 _ _ _ _ itype tyBase _ _ _ | itype /= tyBase =
+  fail $ "Expected " <> show itype <> ", but found " <> show tyBase ++ " (7)"
+worker2 deriveType versionId kindName tyIndex' _ tyBase context tyvars cons = do
+  let ty = foldl AppT tyBase (fmap (\var -> VarT $ tyVarName var) tyvars)
+      typeNameStr = unwords (renderTH (ppr . everywhere (mkT cleanName)) ty  : map show tyIndex')
+  (:[]) <$> instanceD (cxt (fmap pure (nub context)))
+                      (pure (ConT ''SafeCopy `AppT` ty))
+                      [ mkPutCopy deriveType cons
+                      , mkGetCopy deriveType typeNameStr cons
+                      , valD (varP 'version) (normalB $ litE $ integerL $ fromIntegral $ unVersion versionId) []
+                      , valD (varP 'kind) (normalB (varE kindName)) []
+                      , funD 'errorTypeName [clause [wildP] (normalB $ litE $ StringL typeNameStr) []] ]
diff --git a/src/Data/SafeCopy/SafeCopy.hs b/src/Data/SafeCopy/SafeCopy.hs
index 2d07fdc..35d29f8 100644
--- a/src/Data/SafeCopy/SafeCopy.hs
+++ b/src/Data/SafeCopy/SafeCopy.hs
@@ -34,6 +34,8 @@ import qualified Control.Monad.Trans.State as State (get)
 import Control.Monad.Trans.RWS as RWS (evalRWST, modify, RWST, tell)
 import qualified Control.Monad.Trans.RWS as RWS (get)
 import Data.Bits (shiftR)
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Char8 as B
 import Data.Int (Int32)
 import Data.List
 import Data.Map as Map (Map, lookup, insert)
@@ -42,6 +44,7 @@ import Data.Set as Set (insert, member, Set)
 import Data.Typeable (Typeable, TypeRep, typeOf, typeRep)
 import Data.Word (Word8)
 import GHC.Generics
+import GHC.Stack (HasCallStack)
 import Generic.Data as G (Constructors, gconIndex, gconNum)
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -251,7 +254,7 @@ instance GGetFields f p => GGetCopy (M1 C c f) p where
 
 -- append constructor fields
 class GGetFields f p where
-    ggetFields :: p -> StateT (Map TypeRep Int32) Get (Get (f a))
+    ggetFields :: HasCallStack => p -> StateT (Map TypeRep Int32) Get (Get (f a))
 
 instance (GGetFields f p, GGetFields g p) => GGetFields (f :*: g) p where
     ggetFields p = do
@@ -290,7 +293,7 @@ data DatatypeInfo =
 -- read a version or not.  It constructs a Map TypeRep Int32 and reads
 -- when the new TypeRep is not in the map.
 getSafeGetGeneric ::
-  forall a. SafeCopy a
+  forall a. (SafeCopy a, HasCallStack)
   => StateT (Map TypeRep Int32) Get (Get a)
 getSafeGetGeneric
     = checkConsistency proxy $
@@ -341,7 +344,7 @@ putCopyDefault :: forall a. GSafeCopy a => a -> Contained Put
 putCopyDefault a = (contain . gputCopy (ConstructorInfo (fromIntegral (gconNum @a)) (fromIntegral (gconIndex a))) . from) a
 
 -- constructGetterFromVersion :: SafeCopy a => Version a -> Kind (MigrateFrom (Reverse a)) -> Get (Get a)
-constructGetterFromVersion :: SafeCopy a => Version a -> Kind a -> Either String (Get a)
+constructGetterFromVersion :: (SafeCopy a, HasCallStack) => Version a -> Kind a -> Either String (Get a)
 constructGetterFromVersion diskVersion orig_kind =
   worker False diskVersion orig_kind
   where
@@ -382,14 +385,14 @@ constructGetterFromVersion diskVersion orig_kind =
 
 -- | Parse a version tagged data type and then migrate it to the desired type.
 --   Any serialized value has been extended by the return type can be parsed.
-safeGet :: SafeCopy a => Get a
+safeGet :: (SafeCopy a, HasCallStack) => Get a
 safeGet
     = join getSafeGet
 
 -- | Parse a version tag and return the corresponding migrated parser. This is
 --   useful when you can prove that multiple values have the same version.
 --   See 'getSafePut'.
-getSafeGet :: forall a. SafeCopy a => Get (Get a)
+getSafeGet :: forall a. (SafeCopy a, HasCallStack) => Get (Get a)
 getSafeGet
     = checkConsistency proxy $
       case kindFromProxy proxy of
@@ -403,14 +406,14 @@ getSafeGet
 -- | Serialize a data type by first writing out its version tag. This is much
 --   simpler than the corresponding 'safeGet' since previous versions don't
 --   come into play.
-safePut :: SafeCopy a => a -> Put
+safePut :: (SafeCopy a, HasCallStack) => a -> Put
 safePut a
     = do putter <- getSafePut
          putter a
 
 -- | Serialize the version tag and return the associated putter. This is useful
 --   when serializing multiple values with the same version. See 'getSafeGet'.
-getSafePut :: forall a. SafeCopy a => PutM (a -> Put)
+getSafePut :: forall a. (SafeCopy a, HasCallStack) => PutM (a -> Put)
 getSafePut
     = unpureCheckConsistency proxy $
       case kindFromProxy proxy of
@@ -575,6 +578,27 @@ isObviouslyConsistent Primitive = True
 isObviouslyConsistent Base      = True
 isObviouslyConsistent _         = False
 
+-------------------------------------------------
+-- Some SafeCopy versions of Serialize functions.
+
+-- | Encode a value using binary serialization to a strict ByteString.
+safeEncode :: (SafeCopy a, HasCallStack) => a -> B.ByteString
+safeEncode = runPut . safePut
+
+-- | Encode a value using binary serialization to a lazy ByteString.
+safeEncodeLazy :: (SafeCopy a, HasCallStack) => a -> L.ByteString
+safeEncodeLazy  = runPutLazy . safePut
+
+-- | Decode a value from a strict ByteString, reconstructing the original
+-- structure.
+safeDecode :: (SafeCopy a, HasCallStack) => B.ByteString -> Either String a
+safeDecode = runGet safeGet
+
+-- | Decode a value from a lazy ByteString, reconstructing the original
+-- structure.
+safeDecodeLazy :: (SafeCopy a, HasCallStack) => L.ByteString -> Either String a
+safeDecodeLazy  = runGetLazy safeGet
+
 -------------------------------------------------
 -- Small utility functions that mean we don't
 -- have to depend on ScopedTypeVariables.
diff --git a/test/Types.hs b/test/Types.hs
new file mode 100644
index 0000000..64d639b
--- /dev/null
+++ b/test/Types.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE DataKinds, DeriveDataTypeable, FlexibleInstances, KindSignatures #-}
+
+module Types where
+
+import Control.Monad (MonadPlus, msum)
+import Data.ByteString (ByteString)
+import Data.Data (Data)
+import Data.Generics (listify)
+import Data.Set (Set)
+import Data.Typeable (Typeable)
+import Language.Haskell.TH.Instances ()
+import Language.Haskell.TH.Syntax
+
+newtype ClientView db = ClientView {unClientView :: ViewModifiers db (PKey Client)} deriving (Eq, Ord, Show)
+data Client
+  = Client
+    { _clientName :: PersonName
+    , _clientTitle :: RenderedUnicode
+    , _clientCompany :: RenderedUnicode
+    , _clientAddress :: RenderedUnicode
+    , _clientAddress2 :: RenderedUnicode
+    , _clientCity :: RenderedUnicode
+    , _clientState :: RenderedUnicode
+    , _clientPostal :: RenderedUnicode
+    , _clientGreeting :: RenderedUnicode
+    , _clientPhone :: RenderedUnicode
+    , _clientEmail :: RenderedUnicode
+    , _clientPreferredContactMethods :: Set ContactMethod
+    , _clientNotes :: RenderedHtml
+    , _clientUserId :: Maybe UserId
+      -- ^ Does this client have have an AppraisalScribe account?  I hope so!
+    } deriving (Show, Eq, Ord, Typeable, Data)
+type PersonName = String
+type RenderedUnicode = String
+type RenderedHtml = String
+type ContactMethod = Char
+newtype UserId = UserId Integer deriving (Eq, Ord, Show, Data)
+data ViewModifiers db col = ViewModifiers {_mods :: Set (ViewModifier db)} deriving (Show, Eq, Ord)
+data ViewModifier db =
+    Effective UserId -- ^ Use this user's data
+  | Matching SearchTerm -- ^ Filter out object that do not match this search term
+  | PagerView PagerStyle
+  | MemberAny [PKey db]
+  | ViewNotes [String]
+  | InvertMod (ViewModifier db) -- invert the sense of a test
+  | TestKeys [ByteString] -- ^ Test whether the key argument matches any encoded key
+  deriving (Eq, Ord, Show)
+data SearchTerm =
+    SearchTerm {_searchWords :: [CI Text]}
+  | NoTerm
+  deriving (Read, Show, Eq, Ord, Data, Typeable)
+type Text = String
+type PagerStyle = String
+type CI a = a
+data OpticTag = F | G | I | L | P | S | T | U deriving (Eq, Show, Typeable)
+newtype Path (o :: OpticTag) s = Path UPath deriving (Typeable, Eq, Ord, Data, Show)
+type UPath = [UHop Int]
+data UHop pos
+  = IxPathU ByteString -- ^ 'Control.Lens.ix' path
+  | AtPathU ByteString -- ^ 'Control.Lens.at' path
+  | NonPathU ByteString -- ^ 'Control.Lens.non' path
+  | FieldU pos pos -- ^ Path from a record to one of its fields
+  | CtorU pos -- ^ Path from a record to a tuple containing the fields of one of its constructors
+  | NewtypePathU -- ^ A path that unwraps a newtype
+  | OrderedPathU -- ^ A path to a 'Order'.
+  | ViewPathU -- ^ A path corresponding to the 'Control.Lens.Path._View' iso
+  | FoldPathU -- ^ A path to an instance of FoldableWithIndex
+  | SingularPathU [UHop pos] -- ^ 'Control.Lens.singular' path
+  | UnsafeSingularPathU [UHop pos] -- ^ 'Control.Lens.unsafeSingular' path
+  deriving (Eq, Ord, Data, Typeable, Show)
+newtype PKey s = PKey {unPKey :: Path 'U s} deriving (Typeable, Eq, Ord, Data, Show)
+
+
+data N a = N a
+instance Show (N Name) where
+  show (N (Name o f)) = "(Name (" <> show o <> ") (" <> show f <> "))"
+
+gFind :: (MonadPlus m, Data a, Typeable b) => a -> m b
+gFind = msum . map return . listify (const True)
diff --git a/test/instances.hs b/test/instances.hs
index b1af845..de1e2d7 100644
--- a/test/instances.hs
+++ b/test/instances.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -11,17 +12,25 @@ import Control.Lens.Traversal (Traversal')
 import Control.Lens.Action    ((^!!), act)
 import Data.Array (Array)
 import Data.Array.Unboxed (UArray)
+import Data.ByteString (ByteString)
+import Data.Data (Data)
 import Data.Data.Lens         (template)
 import Data.Fixed (Fixed, E1)
 import Data.List
 import Data.SafeCopy
-import Data.Serialize (runPut, runGet)
+import Data.SafeCopy.Internal (renderTH, renderDecs)
+import Data.Serialize (runPut, runGet, Serialize)
+import Data.Set (Set)
 import Data.Time (UniversalTime(..), ZonedTime(..))
 import Data.Tree (Tree)
+import Data.Typeable (Typeable)
 import Language.Haskell.TH
+import Language.Haskell.TH.Instances ()
 import Language.Haskell.TH.Syntax
 import Test.Tasty
+import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck hiding (Fixed, (===))
+import Types
 import qualified Data.Vector as V
 import qualified Data.Vector.Primitive as VP
 import qualified Data.Vector.Storable as VS
@@ -111,4 +120,59 @@ do let a = conT ''Int
 main :: IO ()
 main = defaultMain $ testGroup "SafeCopy instances"
     [ testGroup "decode is the inverse of encode" inversions
+    , deriveTests ]
+
+
+-- | A smattering of test cases.
+deriveTests =
+  testGroup "deriveSafeCopy"
+    [ testCase "deriveSafeCopy 0 'base ''(,,,,,,,)" $ do
+          let decs = $(do addDependentFile "src/Data/SafeCopy/Derive.hs"
+                          lift =<< deriveSafeCopy 0 'base ''(,,,,,,,))
+          renderDecs decs @?= intercalate "\n"
+            ["instance (SafeCopy a, SafeCopy b, SafeCopy c, SafeCopy d, SafeCopy e, SafeCopy f, SafeCopy g, SafeCopy h) => SafeCopy ((,,,,,,,) a b c d e f g h)",
+             "    where putCopy ((,,,,,,,) a1 a2 a3 a4 a5 a6 a7 a8) = contain (do {safePut_a <- getSafePut; safePut_b <- getSafePut; safePut_c <- getSafePut; safePut_d <- getSafePut; safePut_e <- getSafePut; safePut_f <- getSafePut; safePut_g <- getSafePut; safePut_h <- getSafePut; safePut_a a1; safePut_b a2; safePut_c a3; safePut_d a4; safePut_e a5; safePut_f a6; safePut_g a7; safePut_h a8; return ()})",
+             "          getCopy = contain (label \"GHC.Tuple.(,,,,,,,):\" (do {safeGet_a <- getSafeGet; safeGet_b <- getSafeGet; safeGet_c <- getSafeGet; safeGet_d <- getSafeGet; safeGet_e <- getSafeGet; safeGet_f <- getSafeGet; safeGet_g <- getSafeGet; safeGet_h <- getSafeGet; (((((((return (,,,,,,,) <*> safeGet_a) <*> safeGet_b) <*> safeGet_c) <*> safeGet_d) <*> safeGet_e) <*> safeGet_f) <*> safeGet_g) <*> safeGet_h}))",
+             "          version = 0",
+             "          kind = base",
+             "          errorTypeName _ = \"GHC.Tuple.(,,,,,,,)\""]
+      -- Test passing a type to deriveSafeCopy' instead of a Name.
+      , testCase "deriveSafeCopy' 0 'base [t(,,,,,,,)|]" $ do
+          let decs = $(do addDependentFile "src/Data/SafeCopy/Derive.hs"
+                          lift =<< deriveSafeCopy' 0 'base [t|forall a b c d e f g h. (Show a, Typeable a) => (a,b,c,d,e,f,g,h)|])
+          renderDecs decs @?= intercalate "\n"
+            ["instance (Show a, Typeable a, SafeCopy a, SafeCopy b, SafeCopy c, SafeCopy d, SafeCopy e, SafeCopy f, SafeCopy g, SafeCopy h) => SafeCopy ((,,,,,,,) a b c d e f g h)",
+             "    where putCopy ((,,,,,,,) a1 a2 a3 a4 a5 a6 a7 a8) = contain (do {safePut_a <- getSafePut; safePut_b <- getSafePut; safePut_c <- getSafePut; safePut_d <- getSafePut; safePut_e <- getSafePut; safePut_f <- getSafePut; safePut_g <- getSafePut; safePut_h <- getSafePut; safePut_a a1; safePut_b a2; safePut_c a3; safePut_d a4; safePut_e a5; safePut_f a6; safePut_g a7; safePut_h a8; return ()})",
+             "          getCopy = contain (label \"GHC.Tuple.(,,,,,,,):\" (do {safeGet_a <- getSafeGet; safeGet_b <- getSafeGet; safeGet_c <- getSafeGet; safeGet_d <- getSafeGet; safeGet_e <- getSafeGet; safeGet_f <- getSafeGet; safeGet_g <- getSafeGet; safeGet_h <- getSafeGet; (((((((return (,,,,,,,) <*> safeGet_a) <*> safeGet_b) <*> safeGet_c) <*> safeGet_d) <*> safeGet_e) <*> safeGet_f) <*> safeGet_g) <*> safeGet_h}))",
+             "          version = 0",
+             "          kind = base",
+             "          errorTypeName _ = \"GHC.Tuple.(,,,,,,,)\""]
+      -- A type with a type parameter results in some context.
+      , testCase "deriveSafeCopy' 0 'base (ClientView db)" $ do
+          let decs = $(do addDependentFile "src/Data/SafeCopy/Derive.hs"
+                          lift =<< deriveSafeCopy' 0 'base [t|forall db. ClientView db|])
+          renderDecs decs @?= intercalate "\n"
+            ["instance SafeCopy (ViewModifiers db (PKey Client)) => SafeCopy (ClientView db)",
+             "    where putCopy (ClientView a1) = contain (do {safePut_ViewModifiersdbPKeyClient <- getSafePut; safePut_ViewModifiersdbPKeyClient a1; return ()})",
+             "          getCopy = contain (label \"Types.ClientView:\" (do {safeGet_ViewModifiersdbPKeyClient <- getSafeGet; return ClientView <*> safeGet_ViewModifiersdbPKeyClient}))",
+             "          version = 0",
+             "          kind = base",
+             "          errorTypeName _ = \"Types.ClientView\""]
+      -- There is a hidden forall type parameter inside SearchTerm, so
+      -- context is generated here.
+      , testCase "deriveSafeCopy' 0 'base SearchTerm" $ do
+          let decs = $(do addDependentFile "src/Data/SafeCopy/Derive.hs"
+                          lift =<< deriveSafeCopy' 0 'base [t|SearchTerm|])
+          renderDecs decs @?= intercalate "\n"
+            ["instance SafeCopy SearchTerm",
+             "    where putCopy (SearchTerm a1) = contain (do {putWord8 0; safePut_ListaListChar <- getSafePut; safePut_ListaListChar a1; return ()})",
+             "          putCopy (NoTerm) = contain (do {putWord8 1; return ()})",
+             "          getCopy = contain (label \"Types.SearchTerm:\" (do {tag <- getWord8;",
+             "                                                            case tag of",
+             "                                                                0 -> do {safeGet_ListaListChar <- getSafeGet; return SearchTerm <*> safeGet_ListaListChar}",
+             "                                                                1 -> do return NoTerm",
+             "                                                                _ -> fail (\"Could not identify tag \\\"\" ++ (show tag ++ \"\\\" for type \\\"Types.SearchTerm\\\" that has only 2 constructors.  Maybe your data is corrupted?\"))}))",
+             "          version = 0",
+             "          kind = base",
+             "          errorTypeName _ = \"Types.SearchTerm\""]
     ]