diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,63 @@
+0.10.4.3
+--------
+
+_Andreas Abel, 2025-08-27_
+
+- Remove old code for GHC 7
+- Tested with GHC 8.0 - 9.14 alpha1
+
+0.10.4
+======
+
+Add a Typeable a superclass to SafeCopy.  The previous version in effect
+had the Typeable constraint anyway, this means less need to specify it.
+The SafeCopy' type alias is now identical to SafeCopy.  This should not
+break any code except perhaps some GADT types that use "deriving Typeable".
+These may need a standalone deriving instance.
+
+0.10.0
+======
+
+This version replaces the default implementation of getCopy and putCopy
+with a full implementation using GHC.Generics.  Before these functions
+simply serialized and deserialized their argument.  Now they function
+identically to the instances generated by deriveSafeCopy.  This means
+that embedded values with SafeCopy instances will be migrated properly,
+and that you can replace template haskell with standalone deriving
+instances such as "deriving instance SafeCopy Foo where kind = extension;
+version = 3".
+
+The one caveat is that the new default implementation of getCopy and
+putCopy adds the constraint "Typeable a", so that it can build a set of
+the subtypes that appear in a.  This will only affect code that already
+used the default instance, not code that used deriveSafeCopy or custom
+SafeCopy instances.  If you do run into this you can add a custom SafeCopy
+instance with the old implementations mentioned above.
+
+0.9.4
+=====
+  - Support ghc-8.4.1
+  - Travis config for ghc-8.2.1
+  - SafeCopy instance for Data.List.NonEmpty.NonEmpty
+
+0.9.1
+=====
+
+ - fixed tests to work with QuickCheck-2.8.2
+ - add SafeCopy instance for Word
+ - updates for template-haskell 2.11
+ - export some internal TH derivation helpers
+
+0.9.0
+=====
+
+This version changes the way `Float` and `Double` are serialized to a
+more compact format. Old data should be migrated automatically. As a
+result, however, the `Float` and `Double` data serialized by this version can not be read
+by older versions of `safecopy`.
+
+This change originated as a modification to the way `cereal` 0.5 serializes `Float` and `Double`.
+
+[https://github.com/GaloisInc/cereal/commit/47d839609413e3e9d1147b99c34ae421ae36bced](https://github.com/GaloisInc/cereal/commit/47d839609413e3e9d1147b99c34ae421ae36bced)
+
+[https://github.com/GaloisInc/cereal/issues/35](https://github.com/GaloisInc/cereal/issues/35)
diff --git a/safecopy.cabal b/safecopy.cabal
--- a/safecopy.cabal
+++ b/safecopy.cabal
@@ -1,70 +1,96 @@
--- safecopy.cabal auto-generated by cabal init. For additional
--- options, see
--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
--- The name of the package.
+Cabal-version:       1.18
 Name:                safecopy
-
--- The package version. See the Haskell package versioning policy
--- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
--- standards guiding when and how versions should be incremented.
-Version:             0.6.3
-
--- A short (one-line) description of the package.
+Version:             0.10.4.3
 Synopsis:            Binary serialization with version control.
-
--- A longer description of the package.
 Description:         An extension to Data.Serialize with built-in version control.
-
--- URL for the project homepage or repository.
-Homepage:            http://acid-state.seize.it/safecopy
-
--- The license under which the package is released.
+Homepage:            https://github.com/acid-state/safecopy
 License:             PublicDomain
-
--- The package author(s).
 Author:              David Himmelstrup, Felipe Lessa
-
--- An email address to which users can send suggestions, bug reports,
--- and patches.
-Maintainer:          Lemmih <lemmih@gmail.com>
-
--- A copyright notice.
+Maintainer:          Lemmih <lemmih@gmail.com>, David Fox <dsf@seereason.com>
 -- Copyright:
-
 Category:            Data, Parsing
-
 Build-type:          Simple
 
--- Extra files to be distributed with the package, such as examples or
--- a README.
--- Extra-source-files:
+Extra-doc-files:  CHANGELOG.md
 
--- Constraint on the version of Cabal needed to build this package.
-Cabal-version:       >=1.6
+tested-with:
+  GHC == 9.14.1
+  GHC == 9.12.2
+  GHC == 9.10.2
+  GHC == 9.8.4
+  GHC == 9.6.7
+  GHC == 9.4.8
+  GHC == 9.2.8
+  GHC == 9.0.2
+  GHC == 8.10.7
+  GHC == 8.8.4
+  GHC == 8.6.5
+  GHC == 8.4.4
+  GHC == 8.2.2
+  GHC == 8.0.2
 
 Source-repository head
-  type:          darcs
-  location:      http://hub.darcs.net/Lemmih/safecopy
+  type:          git
+  location:      https://github.com/acid-state/safecopy.git
 
 
 Library
-  -- Modules exported by the library.
+  Default-language:    Haskell2010
   Exposed-modules:     Data.SafeCopy
+                       Data.SafeCopy.Internal
 
   Hs-Source-Dirs:      src/
 
-  -- Packages needed in order to build this package.
-  Build-depends:       base >=4 && <5, array, cereal >= 0.3.1.0, bytestring, containers >= 0.3,
-                       old-time, template-haskell, text, time
+  -- Lower bounds are chosen to match LTS 7.24 (GHC 8.0)
+  Build-depends:       base             >= 4.9       && < 5
+                     , array            >= 0.5.1.1   && < 0.6
+                     , cereal           >= 0.5.4.0   && < 0.6
+                     , bytestring       >= 0.10.8.1  && < 0.13
+                     , generic-data     >= 0.3.0.0   && < 2
+                     , containers       >= 0.5.7.1   && < 1
+                     , old-time         >= 1.1.0.3   && < 1.2
+                     , template-haskell >= 2.11.0.0  && < 2.25
+                     , text             >= 1.2.2.2   && < 1.3 || >= 2.0 && < 2.2
+                     , time             >= 1.6.0.1   && < 2
+                     , transformers     >= 0.5.2.0   && < 0.7
+                     , vector           >= 0.11.0.0  && < 0.14
 
-  -- Modules not exported by this package.
-  Other-modules:       Data.SafeCopy.Instances, Data.SafeCopy.SafeCopy,
+  Other-modules:       Data.SafeCopy.Instances
+                       Data.SafeCopy.SafeCopy
                        Data.SafeCopy.Derive
 
-  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
-  -- Build-tools:
-
   GHC-Options:         -Wall
 
-  if(impl(ghc >= 7.2.1))
-    cpp-options: -DDEFAULT_SIGNATURES
+  cpp-options: -DDEFAULT_SIGNATURES -DSAFE_HASKELL
+
+Test-suite instances
+  Default-language:    Haskell2010
+  Type:                exitcode-stdio-1.0
+  Main-is:             instances.hs
+  Hs-Source-Dirs:      test/
+  GHC-Options:         -Wall -threaded -rtsopts -with-rtsopts=-N
+  Build-depends:       base
+                     , array
+                     , cereal
+                     , containers
+                     , safecopy
+                     , template-haskell
+                     , time
+                     , vector
+                     -- new dependencies:
+                     , lens >= 4.7 && < 6
+                     , lens-action
+                     , tasty
+                     , tasty-quickcheck
+
+Test-suite generic
+  Default-language:    Haskell2010
+  Type:                exitcode-stdio-1.0
+  Main-is:             generic.hs
+  Hs-Source-Dirs:      test/
+  GHC-Options:         -Wall -threaded -rtsopts -with-rtsopts=-N
+  Build-depends:       base
+                     , bytestring
+                     , cereal
+                     , safecopy
+                     , HUnit
diff --git a/src/Data/SafeCopy.hs b/src/Data/SafeCopy.hs
--- a/src/Data/SafeCopy.hs
+++ b/src/Data/SafeCopy.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE CPP #-}
+#ifdef SAFE_HASKELL
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.SafeCopy
@@ -11,6 +16,8 @@
 -- can change the definition and binary format of a type nested deep within
 -- other types without problems.
 --
+-- = Migration
+--
 -- Consider this scenario. You want to store your contact list on disk
 -- and so write the following code:
 --
@@ -44,8 +51,8 @@
 --     getCopy = contain $ Contacts_v0 \<$\> safeGet
 --
 --data Contact = Contact { name    :: Name
---                        , address :: Address
---                        , phone   :: Phone }
+--                       , address :: Address
+--                       , phone   :: Phone }
 --instance SafeCopy Contact where
 --    putCopy Contact{..} = contain $ do safePut name; safePut address; safePut phone
 --    getCopy = contain $ Contact \<$\> safeGet \<*\> safeGet \<*\> safeGet
@@ -69,29 +76,62 @@
 -- With this, you reflect on your code and you are happy. You feel confident in the safety of
 -- your data and you know you can remove @Contacts_v0@ once you no longer wish to support
 -- that legacy format.
+--
+-- = Retiring Migrations
+--
+-- There may come a time when you have to remove @Contacts_v0@.
+-- Perhaps it uses types you want to remove from your build to
+-- decrease its size.  Perhaps it has constraints such as @Enum@ which
+-- are imposed on your new @Contacts@ type via the @SafeCopy@
+-- instance.
+--
+-- In any case, if you are using @safecopy@ incombination with
+-- @acid-state@, some care must be taken when removing @Contacts_v0@.
+-- The following steps must be taken to add a new type and remove the old:
+--
+--   1. Add the migration as described above.
+--   2. Run the server with the new migration on /all important data/.  This
+--      will cause the type to be modified in the running program.
+--   3. /Restart/ the server with the new migration on /all important data/.  This
+--      causes checkpoints to be written that only contain the new type.
+--   4. Remove the old type from your source code, changing the @kind@ of
+--      the new type from @extension@ to @base@. Build and deploy.
+--
+-- If you omit any of these steps it is a certainty that you will
+-- proceed happily with your development thinking all is grand, and
+-- then when you go to deploy your live system the migration will fail.
+
 module Data.SafeCopy
     (
       safeGet
     , safePut
-    , SafeCopy(version, kind, getCopy, putCopy, errorTypeName)
+    , SafeCopy(version, kind, getCopy, putCopy, objectProfile, errorTypeName)
+    , SafeCopy'
+    , Profile(..)
     , Prim(..)
     , Migrate(..)
+    , Reverse(..)
     , Kind
     , extension
+    , extended_extension
+    , extended_base
+    , base
     , Contained
     , contain
     , Version
 
       -- * Template haskell functions
     , deriveSafeCopy
+    , deriveSafeCopyIndexedType
     , deriveSafeCopySimple
+    , deriveSafeCopySimpleIndexedType
     , deriveSafeCopyHappstackData
+    , deriveSafeCopyHappstackDataIndexedType
 
       -- * Rarely used functions
     , getSafeGet
     , getSafePut
     , primitive
-    , base
     ) where
 
 import Data.SafeCopy.Instances ()
diff --git a/src/Data/SafeCopy/Derive.hs b/src/Data/SafeCopy/Derive.hs
--- a/src/Data/SafeCopy/Derive.hs
+++ b/src/Data/SafeCopy/Derive.hs
@@ -1,20 +1,16 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Data.SafeCopy.Derive
-    (
-      deriveSafeCopy
-    , deriveSafeCopySimple
-    , deriveSafeCopyHappstackData
-    ) where
+{-# LANGUAGE TemplateHaskell, CPP #-}
 
-import Data.Serialize (getWord8, putWord8)
+module Data.SafeCopy.Derive where
+
+import Data.Serialize (getWord8, putWord8, label)
 import Data.SafeCopy.SafeCopy
 
-import Language.Haskell.TH hiding (Kind(..))
-import Control.Applicative
+import Language.Haskell.TH hiding (Kind)
 import Control.Monad
 import Data.Maybe (fromMaybe)
-import Data.Typeable (Typeable, typeOf)
+#ifdef __HADDOCK__
 import Data.Word (Word8) -- Haddock
+#endif
 
 -- | Derive an instance of 'SafeCopy'.
 --
@@ -104,6 +100,9 @@
 deriveSafeCopy :: Version a -> Name -> Name -> Q [Dec]
 deriveSafeCopy = internalDeriveSafeCopy Normal
 
+deriveSafeCopyIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
+deriveSafeCopyIndexedType = internalDeriveSafeCopyIndexedType Normal
+
 -- | Derive an instance of 'SafeCopy'.  The instance derived by
 --   this function is simpler than the one derived by
 --   'deriveSafeCopy' in that we always use 'safePut' and
@@ -156,6 +155,9 @@
 deriveSafeCopySimple :: Version a -> Name -> Name -> Q [Dec]
 deriveSafeCopySimple = internalDeriveSafeCopy Simple
 
+deriveSafeCopySimpleIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
+deriveSafeCopySimpleIndexedType = internalDeriveSafeCopyIndexedType Simple
+
 -- | Derive an instance of 'SafeCopy'.  The instance derived by
 --   this function should be compatible with the instance derived
 --   by the module @Happstack.Data.SerializeTH@ of the
@@ -203,40 +205,132 @@
 deriveSafeCopyHappstackData :: Version a -> Name -> Name -> Q [Dec]
 deriveSafeCopyHappstackData = internalDeriveSafeCopy HappstackData
 
+deriveSafeCopyHappstackDataIndexedType :: Version a -> Name -> Name -> [Name] -> Q [Dec]
+deriveSafeCopyHappstackDataIndexedType = internalDeriveSafeCopyIndexedType HappstackData
+
 data DeriveType = Normal | Simple | HappstackData
 
 forceTag :: DeriveType -> Bool
 forceTag HappstackData = True
 forceTag _             = False
 
+#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
+
 internalDeriveSafeCopy :: DeriveType -> Version a -> Name -> Name -> Q [Dec]
-internalDeriveSafeCopy deriveType versionId kindName tyName
-    = do info <- reify tyName
-         case info of
-           TyConI (DataD context _name tyvars 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)
-           TyConI (NewtypeD context _name tyvars con _derivs)
-             -> worker context tyvars [(0, con)]
-           _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, info)
-    where worker context tyvars cons
-              = let ty = foldl appT (conT tyName) [ varT var | PlainTV var <- tyvars ]
-                in (:[]) <$> instanceD (cxt $ [classP ''SafeCopy [varT var] | PlainTV var <- tyvars] ++ map return context)
+internalDeriveSafeCopy deriveType versionId kindName tyName = do
+  info <- reify tyName
+  internalDeriveSafeCopy' deriveType versionId kindName tyName info
+
+internalDeriveSafeCopy' :: DeriveType -> Version a -> Name -> Name -> Info -> Q [Dec]
+internalDeriveSafeCopy' deriveType versionId kindName tyName info = do
+  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)
+
+    TyConI (NewtypeD context _name tyvars _kind con _derivs) ->
+      worker context tyvars [(0, 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)
+
+          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)
+
+          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 tyName 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
+#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)
+#else
+          DataInstD context _name ty _kind cons _derivs
+            | ty == tyIndex ->
+              worker' (foldl appT (conT tyName) (map return ty)) context [] (zip [0..] cons)
+#endif
+            | otherwise ->
+              return []
+
+#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)]
+#else
+          NewtypeInstD context _name ty _kind con _derivs
+            | ty == tyIndex ->
+              worker' (foldl appT (conT tyName) (map return ty)) context [] [(0, con)]
+#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) []]
+                                       ]
+
 mkPutCopy :: DeriveType -> [(Integer, Con)] -> DecQ
 mkPutCopy deriveType cons = funD 'putCopy $ map mkPutClause cons
     where
       manyConstructors = length cons > 1 || forceTag deriveType
       mkPutClause (conNumber, con)
-          = do putVars <- replicateM (conSize con) (newName "arg")
+          = do putVars <- mapM (\n -> newName ("a" ++ show n)) [1..conSize con]
                (putFunsDecs, putFuns) <- case deriveType of
                                            Normal -> mkSafeFunctions "safePut_" 'getSafePut con
                                            _      -> return ([], const 'safePut)
@@ -248,9 +342,11 @@
                                    [ noBindS $ varE 'return `appE` tupE [] ])
                clause [putClause] (normalB putCopyBody) []
 
-mkGetCopy :: DeriveType -> Name -> [(Integer, Con)] -> DecQ
-mkGetCopy deriveType tyName cons = valD (varP 'getCopy) (normalB $ varE 'contain `appE` getCopyBody) []
+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 ++ ":"
       getCopyBody
           = case cons of
               [(_, con)] | not (forceTag deriveType) -> mkGetBody con
@@ -289,10 +385,13 @@
                                return ( bindS (varP funVar) (varE baseFun) : ds
                                       , (t, funVar) : fs )
               where found = any ((== t) . fst) fs
+          finish
+            :: [(Type, Type)]            -- "dictionary" from synonyms(or not) to real types
+            -> ([StmtQ], [(Type, Name)]) -- statements
+            -> ([StmtQ], Type -> Name)   -- function body and name-generator
           finish typeList (ds, fs) = (reverse ds, getName)
               where getName typ = fromMaybe err $ lookup typ typeList >>= flip lookup fs
                     err = error "mkSafeFunctions: never here"
-    -- We can't use a Data.Map because Type isn't a member of Ord =/...
 
 -- | Follow type synonyms.  This allows us to see, for example,
 -- that @[Char]@ and @String@ are the same type and we just need
@@ -313,7 +412,9 @@
 conSize (NormalC _name args) = length args
 conSize (RecC _name recs)    = length recs
 conSize InfixC{}             = 2
-conSize ForallC{}            = error "Found complex constructor. Cannot derive SafeCopy for it."
+conSize ForallC{}            = error "Found constructor with existentially quantified binder. Cannot derive SafeCopy for it."
+conSize GadtC{}              = error "Found GADT constructor. Cannot derive SafeCopy for it."
+conSize RecGadtC{}           = error "Found GADT constructor. Cannot derive SafeCopy for it."
 
 conName :: Con -> Name
 conName (NormalC name _args) = name
@@ -330,7 +431,7 @@
 typeName :: Type -> String
 typeName (VarT name) = nameBase name
 typeName (ConT name) = nameBase name
-typeName (TupleT n)  = '(' : replicate (n-1) ',' ++ ")"
+typeName (TupleT n)  = "Tuple" ++ show n
 typeName ArrowT      = "Arrow"
 typeName ListT       = "List"
 typeName (AppT t u)  = typeName t ++ typeName u
diff --git a/src/Data/SafeCopy/Instances.hs b/src/Data/SafeCopy/Instances.hs
--- a/src/Data/SafeCopy/Instances.hs
+++ b/src/Data/SafeCopy/Instances.hs
@@ -1,10 +1,13 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Data.SafeCopy.Instances where
 
 import Data.SafeCopy.SafeCopy
 
-import           Control.Applicative
 import           Control.Monad
 import qualified Data.Array as Array
 import qualified Data.Array.Unboxed as UArray
@@ -17,6 +20,7 @@
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import           Data.Ix
+import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
 import           Data.Ratio (Ratio, (%), numerator, denominator)
 import qualified Data.Sequence as Sequence
@@ -31,10 +35,16 @@
 import           Data.Time.Clock.TAI (AbsoluteTime, taiEpoch, addAbsoluteTime, diffAbsoluteTime)
 import           Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), TimeZone(..), ZonedTime(..))
 import qualified Data.Tree as Tree
-import           Data.Typeable
+import           Data.Typeable hiding (Proxy)
 import           Data.Word
+import           Numeric.Natural (Natural)
 import           System.Time (ClockTime(..), TimeDiff(..), CalendarTime(..), Month(..))
 import qualified System.Time as OT
+import qualified Data.Vector as V
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Primitive as VP
+import qualified Data.Vector.Storable as VS
+import qualified Data.Vector.Unboxed as VU
 
 instance SafeCopy a => SafeCopy (Prim a) where
   kind = primitive
@@ -45,14 +55,22 @@
     = contain $ unsafeUnPack (putCopy e)
 
 instance SafeCopy a => SafeCopy [a] where
-    getCopy = contain $
-              do n <- get
-                 getSafeGet >>= replicateM n
-    putCopy lst
-        = contain $
-          do put (length lst)
-             getSafePut >>= forM_ lst
+  getCopy = contain $ do
+    n <- get
+    g <- getSafeGet
+    go g [] n
+      where
+        go :: Get a -> [a] -> Int -> Get [a]
+        go _ as 0 = return (reverse as)
+        go g as i = do x <- g
+                       x `seq` go g (x:as) (i - 1)
+  putCopy lst = contain $ do put (length lst)
+                             getSafePut >>= forM_ lst
+  errorTypeName = typeName1
 
+instance SafeCopy a => SafeCopy (NonEmpty.NonEmpty a) where
+    getCopy = contain $ fmap NonEmpty.fromList safeGet
+    putCopy = contain . safePut . NonEmpty.toList
     errorTypeName = typeName1
 
 instance SafeCopy a => SafeCopy (Maybe a) where
@@ -148,16 +166,60 @@
     getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
 instance SafeCopy Integer where
     getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
-instance SafeCopy Float where
+instance SafeCopy Natural where
     getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
+
+-- | cereal changed the formats for Float/Double in 0.5.*
+--
+-- https://github.com/GaloisInc/cereal/commit/47d839609413e3e9d1147b99c34ae421ae36bced
+-- https://github.com/GaloisInc/cereal/issues/35
+newtype CerealFloat040 = CerealFloat040 { unCerealFloat040 :: Float} deriving (Show)
+instance SafeCopy CerealFloat040 where
+    getCopy = contain (CerealFloat040 <$> liftM2 encodeFloat get get)
+    putCopy (CerealFloat040 float) = contain (put (decodeFloat float))
+    errorTypeName = typeName
+
+instance Migrate Float where
+  type MigrateFrom Float = CerealFloat040
+  migrate (CerealFloat040 d) = d
+
+instance SafeCopy Float where
+  version = Version 1
+  kind = extension
+  getCopy = contain get
+  putCopy = contain . put
+  errorTypeName = typeName
+
+-- | cereal changed the formats for Float/Double in 0.5.*
+--
+-- https://github.com/GaloisInc/cereal/commit/47d839609413e3e9d1147b99c34ae421ae36bced
+-- https://github.com/GaloisInc/cereal/issues/35
+newtype CerealDouble040 = CerealDouble040 { unCerealDouble040 :: Double} deriving (Show)
+instance SafeCopy CerealDouble040 where
+    getCopy = contain (CerealDouble040 <$> liftM2 encodeFloat get get)
+    putCopy (CerealDouble040 double) = contain (put (decodeFloat double))
+    errorTypeName = typeName
+
+instance Migrate Double where
+  type MigrateFrom Double = CerealDouble040
+  migrate (CerealDouble040 d) = d
+
 instance SafeCopy Double where
-    getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
+  version = Version 1
+  kind = extension
+  getCopy = contain get
+  putCopy = contain . put
+  errorTypeName = typeName
+
+
 instance SafeCopy L.ByteString where
     getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
 instance SafeCopy B.ByteString where
     getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
 instance SafeCopy Char where
     getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
+instance SafeCopy Word where
+    getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
 instance SafeCopy Word8 where
     getCopy = contain get; putCopy = contain . put; errorTypeName = typeName
 instance SafeCopy Word16 where
@@ -183,7 +245,7 @@
     putCopy r = contain $ do safePut (numerator   r)
                              safePut (denominator r)
     errorTypeName = typeName1
-instance (HasResolution a, Fractional (Fixed a)) => SafeCopy (Fixed a) where
+instance (HasResolution a, Fractional (Fixed a), Typeable a) => SafeCopy (Fixed a) where
     getCopy   = contain $ fromRational <$> safeGet
     putCopy   = contain . safePut . toRational
     errorTypeName = typeName1
@@ -348,8 +410,8 @@
                              pico   <- get
                              wday   <- safeGet
                              yday   <- get
-                             tzname <- get
-                             tz     <- safeGet
+                             tzname <- safeGet
+                             tz     <- get
                              dst    <- get
                              return (CalendarTime year month day hour mins sec pico wday yday tzname tz dst)
     putCopy t = contain $ do put     (ctYear t)
@@ -368,8 +430,37 @@
 typeName :: Typeable a => Proxy a -> String
 typeName proxy = show (typeOf (undefined `asProxyType` proxy))
 
+#if MIN_VERSION_base(4,10,0)
+typeName1 :: (Typeable c) => Proxy (c a) -> String
+typeName2 :: (Typeable c) => Proxy (c a b) -> String
+#else
 typeName1 :: (Typeable1 c) => Proxy (c a) -> String
-typeName1 proxy = show (typeOf1 (undefined `asProxyType` proxy))
-
 typeName2 :: (Typeable2 c) => Proxy (c a b) -> String
+#endif
+
+typeName1 proxy = show (typeOf1 (undefined `asProxyType` proxy))
 typeName2 proxy = show (typeOf2 (undefined `asProxyType` proxy))
+
+getGenericVector :: (SafeCopy a, VG.Vector v a) => Contained (Get (v a))
+getGenericVector = contain $ do n <- get
+                                getSafeGet >>= VG.replicateM n
+
+putGenericVector :: (SafeCopy a, VG.Vector v a) => v a -> Contained Put
+putGenericVector v = contain $ do put (VG.length v)
+                                  getSafePut >>= VG.forM_ v
+
+instance SafeCopy a => SafeCopy (V.Vector a) where
+    getCopy = getGenericVector
+    putCopy = putGenericVector
+
+instance (SafeCopy a, VP.Prim a) => SafeCopy (VP.Vector a) where
+    getCopy = getGenericVector
+    putCopy = putGenericVector
+
+instance (SafeCopy a, VS.Storable a) => SafeCopy (VS.Vector a) where
+    getCopy = getGenericVector
+    putCopy = putGenericVector
+
+instance (SafeCopy a, VU.Unbox a) => SafeCopy (VU.Vector a) where
+    getCopy = getGenericVector
+    putCopy = putGenericVector
diff --git a/src/Data/SafeCopy/Internal.hs b/src/Data/SafeCopy/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/SafeCopy/Internal.hs
@@ -0,0 +1,7 @@
+module Data.SafeCopy.Internal (
+    module Data.SafeCopy.SafeCopy
+  , module Data.SafeCopy.Derive
+  ) where
+
+import Data.SafeCopy.SafeCopy
+import Data.SafeCopy.Derive
diff --git a/src/Data/SafeCopy/SafeCopy.hs b/src/Data/SafeCopy/SafeCopy.hs
--- a/src/Data/SafeCopy/SafeCopy.hs
+++ b/src/Data/SafeCopy/SafeCopy.hs
@@ -1,10 +1,15 @@
-{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-{-# LANGUAGE CPP #-}
-#ifdef DEFAULT_SIGNATURES
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
-#endif
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -21,11 +26,24 @@
 --
 module Data.SafeCopy.SafeCopy where
 
-import Data.Serialize
-
 import Control.Monad
+import Control.Monad.Trans.Class (lift)
+import qualified Control.Monad.Fail as Fail
+import Control.Monad.Trans.State as State (evalStateT, modify, StateT)
+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 Data.Int (Int32)
 import Data.List
+import Data.Map as Map (Map, lookup, insert)
+import Data.Serialize
+import Data.Set as Set (insert, member, Set)
+import Data.Typeable (Typeable, TypeRep, typeOf, typeRep)
+import Data.Word (Word8)
+import GHC.Generics
+import Generic.Data as G (Constructors, gconIndex, gconNum)
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | The central mechanism for dealing with version control.
 --
@@ -41,22 +59,30 @@
     --   all taken care of internally in the library.
     migrate :: MigrateFrom a -> a
 
+-- | This is a wrapper type used migrating backwards in the chain of compatible types.
+newtype Reverse a = Reverse { unReverse :: a }
+
 -- | The kind of a data type determines how it is tagged (if at all).
 --
 --   Primitives kinds (see 'primitive') are not tagged with a version
 --   id and hence cannot be extended later.
 --
---   Extensions (see 'extension') tells the system that there exists
+--   Extensions (see 'extension') tell the system that there exists
 --   a previous version of the data type which should be migrated if
 --   needed.
 --
---   There is also a default kind which is neither primitive nor is
+--   There is also a default kind which is neither primitive nor
 --   an extension of a previous type.
 data Kind a where
     Primitive :: Kind a
     Base      :: Kind a
     Extends   :: (Migrate a) => Proxy (MigrateFrom a) -> Kind a
+    Extended  :: (Migrate (Reverse a)) => Kind a -> Kind a
 
+isPrimitive :: Kind a -> Bool
+isPrimitive Primitive = True
+isPrimitive _ = False
+
 -- | Wrapper for data that was saved without a version tag.
 newtype Prim a = Prim { getPrimitive :: a }
 
@@ -67,7 +93,7 @@
 --   even though 'getCopy' and 'putCopy' can't be used directly.
 --   To serialize/parse a data type using 'SafeCopy', see 'safeGet'
 --   and 'safePut'.
-class SafeCopy a where
+class Typeable a => SafeCopy a where
     -- | The version of the type.
     --
     --   Only used as a key so it must be unique (this is checked at run-time)
@@ -91,7 +117,7 @@
 
     -- | This method defines how a value should be parsed without worrying about
     --   previous versions or migrations. This function cannot be used directly.
-    --   One should use 'safeGet', instead.
+    --   One should use 'safePut, instead.
     putCopy  :: a -> Contained Put
 
     -- | Internal function that should not be overrided.
@@ -104,43 +130,247 @@
     --   lifetime, instead of everytime 'safeGet' or 'safePut' is
     --   used.
     internalConsistency :: Consistency a
-    internalConsistency =
-        let ret = computeConsistency proxy
-            proxy = proxyFromConsistency ret
-        in ret
+    internalConsistency = computeConsistency Proxy
 
-    -- | The name of the type. This is only used in error
-    -- message strings.
-    -- Feel free to leave undefined in your instances.
+    -- | Version profile.
+    objectProfile :: Profile a
+    objectProfile = mkProfile Proxy
+
+    -- | The name of the type. This is only used in error message
+    -- strings.
     errorTypeName :: Proxy a -> String
-    errorTypeName _ = "<unkown type>"
 
-#ifdef DEFAULT_SIGNATURES
-    default getCopy :: Serialize a => Contained (Get a)
-    getCopy = contain get
+    default errorTypeName :: Typeable a => Proxy a -> String
+    errorTypeName _ = show (typeRep (Proxy @a))
 
-    default putCopy :: Serialize a => a -> Contained Put
-    putCopy = contain . put
-#endif
+    default putCopy :: (GPutCopy (Rep a) DatatypeInfo, Constructors a) => a -> Contained Put
+    putCopy a = (contain . gputCopy (ConstructorInfo (fromIntegral (gconNum @a)) (fromIntegral (gconIndex a))) . from) a
 
+    default getCopy :: (GGetCopy (Rep a) DatatypeInfo, Constructors a) => Contained (Get a)
+    getCopy = contain (to <$> ggetCopy (ConstructorCount (fromIntegral (gconNum @a))))
 
-constructGetterFromVersion :: SafeCopy a => Version a -> Proxy a -> Get a
-constructGetterFromVersion diskVersion a_proxy
-    | version == diskVersion = unsafeUnPack getCopy
-    | otherwise              = case kindFromProxy a_proxy of
-                                 Primitive -> fail $ errorMsg "Cannot migrate from primitive types."
-                                 Base      ->
-                                     fail $
-                                     errorMsg $
-                                     "Cannot find getter associated with this version number: " ++ show diskVersion
-                                 Extends b_proxy
-                                   -> fmap migrate (constructGetterFromVersion (castVersion diskVersion) b_proxy)
+class GPutCopy f p where
+    gputCopy :: p -> f p -> Put
 
+instance GPutCopy a p => GPutCopy (M1 D c a) p where
+    gputCopy p (M1 a) = gputCopy p a
+    {-# INLINE gputCopy #-}
+
+instance (GPutCopy f p, GPutCopy g p) => GPutCopy (f :+: g) p where
+    gputCopy p (L1 x) = gputCopy @f p x
+    gputCopy p (R1 x) = gputCopy @g p x
+    {-# INLINE gputCopy #-}
+
+-- | A constraint that combines 'SafeCopy' and 'Typeable'.
+type SafeCopy' a = SafeCopy a
+{-# DEPRECATED SafeCopy' "SafeCopy' is now equivalent to SafeCopy " #-}
+
+-- To get the current safecopy behavior we need to emulate the
+-- template haskell code here - collect the (a -> Put) values for all
+-- the fields and then run them in order.o
+instance (GPutFields a p, p ~ DatatypeInfo) => GPutCopy (M1 C c a) p where
+    gputCopy p (M1 x) =
+      (when (_size p >= 2) (putWord8 (fromIntegral (_code p)))) *>
+        -- This is how I tried it first, and it works well but the
+        -- result is not the same as deriveSafeCopy.
+        -- mconcat (fmap join (gputFields p x))
+        -- join (mconcat <$> sequence (fmap snd (gputFields p x)))
+      (do putter <- (mconcat . snd) <$> (evalRWST (gputFields p x) () mempty)
+          putter)
+    {-# INLINE gputCopy #-}
+
+-- | gputFields traverses the fields of a constructor and returns a put
+-- for the safecopy versions and a put for the field values.
+class GPutFields f p where
+    gputFields :: p -> f p -> RWST () [Put] (Set TypeRep) PutM ()
+
+instance (GPutFields f p, GPutFields g p) => GPutFields (f :*: g) p where
+    gputFields p (a :*: b) = gputFields p a >> gputFields p b
+    {-# INLINE gputFields #-}
+
+instance GPutFields f p => GPutFields (M1 S c f) p where
+    gputFields p (M1 a) = gputFields p a
+    {-# INLINE gputFields #-}
+
+instance SafeCopy a => GPutFields (K1 R a) p where
+    gputFields _ (K1 a) = do
+      getSafePutGeneric putCopy a
+    {-# INLINE gputFields #-}
+
+-- This corresponds to ggetFields, but does it match deriveSafeCopy?
+instance GPutFields U1 p where
+    gputFields _ _ =
+      return ()
+{-
+-- This outputs the version tag for (), which is 1.
+instance (GPutFields (K1 R ()) p) => GPutFields U1 p where
+    gputFields p _ =
+      gputFields p (K1 () :: K1 R () p)
+-}
+    {-# INLINE gputFields #-}
+
+instance GPutFields V1 p where
+    gputFields _ _ = undefined
+    {-# INLINE gputFields #-}
+
+------------------------------------------------------------------------
+
+class GGetCopy f p where
+    ggetCopy :: p -> Get (f a)
+
+-- | The M1 type has a fourth type parameter p:
+--
+--     newtype M1 i (c :: Meta) (f :: k -> *) (p :: k) = M1 {unM1 :: f p}
+--
+-- Note that the type of the M1 field is @f p@, so in order to express this
+-- type we add a parameter of type p that we can apply to values of type f.
+instance (GGetCopy f p, p ~ DatatypeInfo) => GGetCopy (M1 D d f) p where
+    ggetCopy p
+      | _size p >= 2 = do
+          !code <- getWord8
+          M1 <$> ggetCopy (ConstructorInfo (_size p) code)
+      | otherwise = M1 <$> ggetCopy (ConstructorInfo (_size p) 0)
+    {-# INLINE ggetCopy #-}
+
+instance (GGetCopy f p, GGetCopy g p, p ~ DatatypeInfo) => GGetCopy (f :+: g) p where
+    ggetCopy p = do
+      -- choose the left or right branch of the constructor types
+      -- based on whether the code is in the left or right half of the
+      -- remaining constructor count.
+      let sizeL = _size p `shiftR` 1
+          sizeR = _size p - sizeL
+      case _code p < sizeL of
+        True -> L1 <$> ggetCopy @f (ConstructorInfo sizeL (_code p))
+        False -> R1 <$> ggetCopy @g (ConstructorInfo sizeR (_code p - sizeL))
+    {-# INLINE ggetCopy #-}
+
+instance GGetFields f p => GGetCopy (M1 C c f) p where
+    ggetCopy p = do
+      M1 <$> join (evalStateT (ggetFields p) mempty)
+    {-# INLINE ggetCopy #-}
+
+-- append constructor fields
+class GGetFields f p where
+    ggetFields :: p -> StateT (Map TypeRep Int32) Get (Get (f a))
+
+instance (GGetFields f p, GGetFields g p) => GGetFields (f :*: g) p where
+    ggetFields p = do
+      fgetter <- ggetFields @f p
+      ggetter <- ggetFields @g p
+      return ((:*:) <$> fgetter <*> ggetter)
+    {-# INLINE ggetFields #-}
+
+instance GGetFields f p => GGetFields (M1 S c f) p where
+    ggetFields p = do
+      getter <- ggetFields p
+      return (M1 <$> getter)
+    {-# INLINE ggetFields #-}
+
+instance SafeCopy a => GGetFields (K1 R a) p where
+    ggetFields _ = do
+      getter <- getSafeGetGeneric
+      return (K1 <$> getter)
+    {-# INLINE ggetFields #-}
+
+instance GGetFields U1 p where
+    ggetFields _p = pure (pure U1)
+    {-# INLINE ggetFields #-}
+
+instance GGetFields V1 p where
+    ggetFields _p = undefined
+    {-# INLINE ggetFields #-}
+
+data DatatypeInfo =
+    ConstructorCount {_size :: Word8}
+  | ConstructorInfo {_size :: Word8, _code :: Word8}
+  deriving Show
+
+-- | Whereas the other 'getSafeGet' is only run when we know we need a
+-- version, this one is run for every field and must decide whether to
+-- 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
+  => StateT (Map TypeRep Int32) Get (Get a)
+getSafeGetGeneric
+    = checkConsistency proxy $
+      case kindFromProxy proxy of
+        Primitive -> return $ unsafeUnPack getCopy
+        a_kind    -> do let rep = typeRep (Proxy :: Proxy a)
+                        reps <- State.get
+                        v <- maybe (lift get) pure (Map.lookup rep reps)
+                        case constructGetterFromVersion (unsafeCoerce v) a_kind of
+                          Right getter -> State.modify (Map.insert rep v) >> return getter
+                          Left msg     -> fail msg
+    where proxy = Proxy :: Proxy a
+
+-- | This version returns (Put, Put), the collected version tags and
+-- the collected serialized fields.  The original 'getSafePut' result
+-- type prevents doing this because each fields may have a different
+-- type.  Maybe you can show me a better way
+getSafePutGeneric ::
+  forall a. SafeCopy a
+  => (a -> Contained Put)
+  -> a
+  -> RWST () [Put] (Set TypeRep) PutM ()
+getSafePutGeneric cput a
+    = unpureCheckConsistency proxy $
+      case kindFromProxy proxy of
+        Primitive -> tell [unsafeUnPack (cput $ asProxyType a proxy)]
+        _         -> do reps <- RWS.get
+                        let typ = typeOf a
+                        when (not (member typ reps)) $ do
+                          lift (put (versionFromProxy proxy))
+                          RWS.modify (Set.insert typ)
+                        tell [unsafeUnPack (cput $ asProxyType a proxy)]
+    where proxy = Proxy :: Proxy a
+
+type GSafeCopy a = (SafeCopy a, Generic a, GPutCopy (Rep a) DatatypeInfo, Constructors a)
+
+-- | Generic only version of safePut. Instead of calling 'putCopy' it
+-- calls 'putCopyDefault', a copy of the implementation of the
+-- 'SafeCopy' default method for 'putCopy'.
+safePutGeneric :: forall a. GSafeCopy a => a -> Put
+safePutGeneric a = do
+  putter <- (mconcat . snd) <$> evalRWST (getSafePutGeneric putCopyDefault a) () mempty
+  putter
+
+-- | See 'safePutGeneric'.  A copy of the code in the default
+-- implementation of the putCopy method.
+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 diskVersion orig_kind =
+  worker False diskVersion orig_kind
   where
-    errorMsg msg =
+    worker :: forall a. SafeCopy a => Bool -> Version a -> Kind a -> Either String (Get a)
+    worker fwd thisVersion thisKind
+      | version == thisVersion = return $ unsafeUnPack getCopy
+      | otherwise =
+        case thisKind of
+          Primitive -> Left $ errorMsg thisKind "Cannot migrate from primitive types."
+          Base      -> Left $ errorMsg thisKind versionNotFound
+          Extends b_proxy -> do
+            previousGetter <- worker fwd (castVersion diskVersion) (kindFromProxy b_proxy)
+            return $ fmap migrate previousGetter
+          Extended{} | fwd -> Left $ errorMsg thisKind versionNotFound
+          Extended a_kind -> do
+            let rev_proxy :: Proxy (MigrateFrom (Reverse a))
+                rev_proxy = Proxy
+                forwardGetter :: Either String (Get a)
+                forwardGetter  = fmap (fmap (unReverse . migrate)) $ worker True (castVersion thisVersion) (kindFromProxy rev_proxy)
+                previousGetter :: Either String (Get a)
+                previousGetter = worker fwd (castVersion thisVersion) a_kind
+            case forwardGetter of
+              Left{}    -> previousGetter
+              Right val -> Right val
+    versionNotFound   = "Cannot find getter associated with this version number: " ++ show diskVersion
+    errorMsg fail_kind msg =
         concat
          [ "safecopy: "
-         , errorTypeName a_proxy
+         , errorTypeName (proxyFromKind fail_kind)
          , ": "
          , msg
          ]
@@ -164,8 +394,10 @@
     = checkConsistency proxy $
       case kindFromProxy proxy of
         Primitive -> return $ unsafeUnPack getCopy
-        _         -> do v <- get
-                        return $ constructGetterFromVersion v proxy
+        a_kind    -> do v <- get
+                        case constructGetterFromVersion v a_kind of
+                          Right getter -> return getter
+                          Left msg     -> fail msg
     where proxy = Proxy :: Proxy a
 
 -- | Serialize a data type by first writing out its version tag. This is much
@@ -180,19 +412,29 @@
 --   when serializing multiple values with the same version. See 'getSafeGet'.
 getSafePut :: forall a. SafeCopy a => PutM (a -> Put)
 getSafePut
-    = checkConsistency proxy $
+    = unpureCheckConsistency proxy $
       case kindFromProxy proxy of
         Primitive -> return $ \a -> unsafeUnPack (putCopy $ asProxyType a proxy)
         _         -> do put (versionFromProxy proxy)
                         return $ \a -> unsafeUnPack (putCopy $ asProxyType a proxy)
     where proxy = Proxy :: Proxy a
 
+-- | The extended_extension kind lets the system know that there is
+--   at least one previous and one future version of this type.
+extended_extension :: (Migrate a, Migrate (Reverse a)) => Kind a
+extended_extension = Extended extension
+
+-- | The extended_base kind lets the system know that there is
+--   at least one future version of this type.
+extended_base :: (Migrate (Reverse a)) => Kind a
+extended_base = Extended base
+
 -- | The extension kind lets the system know that there is
 --   at least one previous version of this type. A given data type
 --   can only extend a single other data type. However, it is
 --   perfectly fine to build chains of extensions. The migrations
 --   between each step is handled automatically.
-extension :: (SafeCopy a, Migrate a) => Kind a
+extension :: Migrate a => Kind a
 extension = Extends Proxy
 
 -- | The default kind. Does not extend any type.
@@ -233,7 +475,7 @@
 -- parsers/putters.
 
 -- | To ensure that no-one reads or writes values without handling versions
---   correct, it is necessary to restrict access to 'getCopy' and 'putCopy'.
+--   correctly, it is necessary to restrict access to 'getCopy' and 'putCopy'.
 --   This is where 'Contained' enters the picture. It allows you to put
 --   values in to a container but not to take them out again.
 newtype Contained a = Contained {unsafeUnPack :: a}
@@ -245,45 +487,83 @@
 -------------------------------------------------
 -- Consistency checking
 
+data Profile a =
+  PrimitiveProfile |
+  InvalidProfile String |
+  Profile
+  { profileCurrentVersion :: Int32
+  , profileSupportedVersions :: [Int32]
+  } deriving (Show)
+
+mkProfile :: SafeCopy a => Proxy a -> Profile a
+mkProfile a_proxy =
+  case computeConsistency a_proxy of
+    NotConsistent msg -> InvalidProfile msg
+    Consistent | isPrimitive (kindFromProxy a_proxy) -> PrimitiveProfile
+    Consistent ->
+      Profile{ profileCurrentVersion    = unVersion (versionFromProxy a_proxy)
+             , profileSupportedVersions = availableVersions a_proxy
+             }
+
 data Consistency a = Consistent | NotConsistent String
 
 availableVersions :: SafeCopy a => Proxy a -> [Int32]
-availableVersions a_proxy
-    = case kindFromProxy a_proxy of
-        Primitive -> []
-        Base      -> [unVersion (versionFromProxy a_proxy)]
-        Extends b_proxy ->unVersion (versionFromProxy a_proxy) : availableVersions b_proxy
+availableVersions a_proxy =
+  worker True (kindFromProxy a_proxy)
+  where
+    worker :: SafeCopy b => Bool -> Kind b -> [Int32]
+    worker fwd b_kind =
+      case b_kind of
+        Primitive         -> []
+        Base              -> [unVersion (versionFromKind b_kind)]
+        Extends b_proxy   -> unVersion (versionFromKind b_kind) : worker False (kindFromProxy b_proxy)
+        Extended sub_kind | fwd  -> worker False (getForwardKind sub_kind)
+        Extended sub_kind -> worker False sub_kind
 
+getForwardKind :: (Migrate (Reverse a)) => Kind a -> Kind (MigrateFrom (Reverse a))
+getForwardKind _ = kind
+
 -- Extend chains must end in a Base kind. Ending in a Primitive is an error.
 validChain :: SafeCopy a => Proxy a -> Bool
-validChain a_proxy
-    = case kindFromProxy a_proxy of
-        Primitive       -> True
-        Base            -> True
-        Extends b_proxy -> check b_proxy
-    where check :: SafeCopy b => Proxy b -> Bool
-          check b_proxy
-              = case kindFromProxy b_proxy of
+validChain a_proxy =
+  worker (kindFromProxy a_proxy)
+  where
+    worker Primitive         = True
+    worker Base              = True
+    worker (Extends b_proxy) = check (kindFromProxy b_proxy)
+    worker (Extended a_kind)   = worker a_kind
+    check :: SafeCopy b => Kind b -> Bool
+    check b_kind
+              = case b_kind of
                   Primitive       -> False
                   Base            -> True
-                  Extends c_proxy -> check c_proxy
+                  Extends c_proxy -> check (kindFromProxy c_proxy)
+                  Extended sub_kind   -> check sub_kind
 
 -- Verify that the SafeCopy instance is consistent.
-checkConsistency :: (SafeCopy a, Monad m) => Proxy a -> m b -> m b
+checkConsistency :: (SafeCopy a, Fail.MonadFail m) => Proxy a -> m b -> m b
 checkConsistency proxy ks
     = case consistentFromProxy proxy of
-        NotConsistent msg -> fail msg
+        NotConsistent msg -> Fail.fail msg
         Consistent        -> ks
 
+-- | PutM doesn't have reasonable 'fail' implementation.
+-- It just throws an unpure exception anyway.
+unpureCheckConsistency :: SafeCopy a => Proxy a -> b -> b
+unpureCheckConsistency proxy ks
+    = case consistentFromProxy proxy of
+        NotConsistent msg -> error $ "unpureCheckConsistency: " ++ msg
+        Consistent        -> ks
+
 {-# INLINE computeConsistency #-}
-computeConsistency :: SafeCopy a => Proxy a -> Consistency a
+computeConsistency :: forall a. SafeCopy a => Proxy a -> Consistency a
 computeConsistency proxy
     -- Match a few common cases before falling through to the general case.
     -- This allows use to generate nearly all consistencies at compile-time.
     | isObviouslyConsistent (kindFromProxy proxy)
     = Consistent
     | versions /= nub versions
-    = NotConsistent $ "Duplicate version tags: " ++ show versions
+    = NotConsistent $ "Duplicate version tags for " ++ show (typeRep (Proxy @a)) ++ ": " ++ show versions
     | not (validChain proxy)
     = NotConsistent "Primitive types cannot be extended as they have no version tag."
     | otherwise
@@ -302,11 +582,20 @@
 proxyFromConsistency :: Consistency a -> Proxy a
 proxyFromConsistency _ = Proxy
 
+proxyFromKind :: Kind a -> Proxy a
+proxyFromKind _ = Proxy
+
 consistentFromProxy :: SafeCopy a => Proxy a -> Consistency a
 consistentFromProxy _ = internalConsistency
 
 versionFromProxy :: SafeCopy a => Proxy a -> Version a
 versionFromProxy _ = version
+
+versionFromKind :: (SafeCopy a) => Kind a -> Version a
+versionFromKind _ = version
+
+versionFromReverseKind :: (SafeCopy (MigrateFrom (Reverse a))) => Kind a -> Version (MigrateFrom (Reverse a))
+versionFromReverseKind _ = version
 
 kindFromProxy :: SafeCopy a => Proxy a -> Kind a
 kindFromProxy _ = kind
diff --git a/test/generic.hs b/test/generic.hs
new file mode 100644
--- /dev/null
+++ b/test/generic.hs
@@ -0,0 +1,281 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS -Wno-missing-signatures #-}
+
+import GHC.Generics
+#if !MIN_VERSION_base(4,11,0)
+import Data.Monoid ((<>))
+#endif
+import Data.SafeCopy
+import Data.SafeCopy.Internal
+import Data.Serialize (runGet, runPut, Serialize)
+import Text.Printf
+import Test.HUnit (Test(..), assertEqual, runTestTT)
+--import Generic.Data as G hiding (unpack)
+
+-- Debugging
+import Data.Typeable hiding (Proxy)
+--import Debug.Trace
+import Data.ByteString (ByteString, unpack)
+import Data.Char (chr)
+import Data.Word (Word8, Word32)
+
+-- Test types
+data Foo = Foo Int Char deriving (Generic, Show, Eq)
+data Bar = Bar Float Foo deriving (Generic, Show, Eq)
+data Baz = Baz1 Int | Baz2 Bool deriving (Generic, Show, Eq)
+
+#if 0
+safePutTest :: forall a. (SafeCopy' a, Generic a, GPutCopy (Rep a) DatatypeInfo, GConstructors (Rep a)) => a -> Put
+safePutTest a =
+  case runPut p1 == runPut p2 of
+    True -> p1
+    False -> trace ("safePutTest failed for " ++ show (typeRep (Proxy :: Proxy a)) ++ "\n custom: " ++ showBytes (runPut p1) ++ "\n generic: " ++ showBytes (runPut p2)) p1
+  where
+    p1 = safePut a
+    p2 = safePutGeneric a
+#endif
+
+----------------------------------------------
+
+-- Compare a value to the result of encoding and then decoding it.
+roundTrip :: forall a. (SafeCopy a, Typeable a, Eq a, Show a) => a -> Test
+roundTrip x = do
+  -- putStrLn ("\n========== " ++ show x ++ " :: " ++ show (typeRep (Proxy :: Proxy a)) ++ " ==========")
+  let d = runPut (safePut x) -- Use custom putCopy/getCopy implementation if present
+      a :: Either String a
+      a = runGet safeGet d
+  TestCase (assertEqual ("roundTrip " ++ show x ++ " :: " ++ show (typeRep (Proxy :: Proxy a))) (Right x) a)
+
+-- Test whether two values of different types have the same encoded
+-- representation.  This is used here on types of similar shape to
+-- test whether the generic SafeCopy instance matches the template
+-- haskell instance.
+compareBytes ::
+  forall expected actual. (SafeCopy expected, Typeable expected,
+                           SafeCopy actual, Typeable actual)
+  => expected -> actual -> Test
+compareBytes e a =
+  TestCase (assertEqual ("compareBytes " ++ show (typeRep (Proxy :: Proxy expected)) ++ " " ++
+                                            show (typeRep (Proxy :: Proxy actual)))
+              (showBytes (runPut $ safePut e))
+              (showBytes (runPut $ safePut a)))
+
+showBytes :: ByteString -> String
+showBytes b = mconcat (fmap f (unpack b))
+   where f :: Word8 -> String
+         f 192 = "[G|"
+         f 193 = "[C|"
+         f 194 = "[T|"
+         f 195 = "]_ "
+         f 196 = " _<"
+         f 197 = ">_ "
+         f c | c >= 32 && c < 127 = [' ', chr (fromIntegral c), ' ']
+         f c | c == 0 = " __"
+         f c = printf " %02x" c
+
+-----------------------------
+-- Test Types and Values
+-----------------------------
+
+foo = Foo maxBound 'x'
+bar = Bar 1.5 foo
+baz1 = Baz1 3
+baz2 = Baz2 True
+
+-- These instances will use the generic putCopy and getCopy
+instance SafeCopy Foo where version = 3; kind = base
+instance SafeCopy Bar where version = 4; kind = base
+instance SafeCopy Baz where version = 5; kind = base
+
+-- Copies of the types above with generated SafeCopy instances
+data FooTH = FooTH Int Char deriving (Generic, Serialize, Show, Eq)
+data BarTH = BarTH Float FooTH deriving (Generic, Serialize, Show, Eq)
+data BazTH = Baz1TH Int | Baz2TH Bool deriving (Generic, Serialize, Show, Eq)
+
+fooTH = FooTH maxBound 'x'
+barTH = BarTH 1.5 fooTH
+baz1TH = Baz1TH 3
+baz2TH = Baz2TH True
+
+-- For comparison, these instances have the generated implementations
+-- of putCopy and getCopy
+#if 1
+$(deriveSafeCopy 3 'base ''FooTH)
+$(deriveSafeCopy 4 'base ''BarTH)
+$(deriveSafeCopy 5 'base ''BazTH)
+#else
+instance SafeCopy FooTH where
+      putCopy (FooTH a1_aeVVN a2_aeVVO)
+        = contain
+            (do safePut_Int_aeVVP <- getSafePut
+                safePut_Char_aeVVQ <- getSafePut
+                safePut_Int_aeVVP a1_aeVVN
+                safePut_Char_aeVVQ a2_aeVVO
+                return ())
+      getCopy
+        = contain
+            ((Data.Serialize.Get.label "Main.FooTH:")
+               (do safeGet_Int_aeVVR <- getSafeGet
+                   safeGet_Char_aeVVS <- getSafeGet
+                   ((return FooTH <*> safeGet_Int_aeVVR) <*> safeGet_Char_aeVVS)))
+      version = 3
+      kind = base
+      errorTypeName _ = "Main.FooTH"
+
+instance SafeCopy BarTH where
+      putCopy (BarTH a1_aeVXE a2_aeVXF)
+        = contain
+            (do safePut_Float_aeVXG <- getSafePut
+                safePut_FooTH_aeVXH <- getSafePut
+                safePut_Float_aeVXG a1_aeVXE
+                safePut_FooTH_aeVXH a2_aeVXF
+                return ())
+      getCopy
+        = contain
+            ((Data.Serialize.Get.label "Main.BarTH:")
+               (do safeGet_Float_aeVXI <- getSafeGet
+                   safeGet_FooTH_aeVXJ <- getSafeGet
+                   ((return BarTH <*> safeGet_Float_aeVXI) <*> safeGet_FooTH_aeVXJ)))
+      version = 4
+      kind = base
+      errorTypeName _ = "Main.BarTH"
+
+instance SafeCopy BazTH where
+      putCopy (Baz1TH a1_aeVZv)
+        = contain
+            (do Data.Serialize.Put.putWord8 0
+                safePut_Int_aeVZw <- getSafePut
+                safePut_Int_aeVZw a1_aeVZv
+                return ())
+      putCopy (Baz2TH a1_aeVZx)
+        = contain
+            (do Data.Serialize.Put.putWord8 1
+                safePut_Bool_aeVZy <- getSafePut
+                safePut_Bool_aeVZy a1_aeVZx
+                return ())
+      getCopy
+        = contain
+            ((Data.Serialize.Get.label "Main.BazTH:")
+               (do tag_aeVZz <- Data.Serialize.Get.getWord8
+                   case tag_aeVZz of
+                     0 -> do safeGet_Int_aeVZA <- getSafeGet
+                             (return Baz1TH <*> safeGet_Int_aeVZA)
+                     1 -> do safeGet_Bool_aeVZB <- getSafeGet
+                             (return Baz2TH <*> safeGet_Bool_aeVZB)
+                     _ -> fail
+                            ("Could not identify tag \""
+                               ++
+                                 (show tag_aeVZz
+                                    ++
+                                      "\" for type \"Main.BazTH\" that has only 2 constructors.  Maybe your data is corrupted?"))))
+      version = 5
+      kind = base
+      errorTypeName _ = "Main.BazTH"
+#endif
+
+data File
+    = File { _fileChksum :: Checksum             -- ^ The checksum of the file's contents
+           , _fileMessages :: [String]           -- ^ Messages received while manipulating the file
+           , _fileExt :: String                  -- ^ Name is formed by appending this to checksum
+           } deriving (Generic, Eq, Ord, Show)
+
+data FileSource
+    = TheURI String
+    | ThePath FilePath
+    deriving (Generic, Eq, Ord, Show)
+
+type Checksum = String
+
+$(deriveSafeCopy 10 'base ''File)
+$(deriveSafeCopy 11 'base ''FileSource)
+
+file1 = File ("checksum") [] ".jpg"
+file2 = File ("checksum") [] ".jpg"
+file3 = File ("checksum") [] ".jpg"
+
+----------------------------------------------
+-- Demonstration of the ordering issue
+----------------------------------------------
+
+data T1 = T1 Char T2 T3 deriving (Generic, Show)
+data T2 = T2 Char deriving (Generic, Show)
+data T3 = T3 Char deriving (Generic, Show)
+data T4 = T4 Word32 Word32 Word32 deriving (Generic, Show)
+
+t1 = T1 'a' (T2 'b') (T3 'c')
+t2 = (T2 'b')
+t3 = (T3 'c')
+t4 = T4 100 200 300
+
+$(deriveSafeCopy 4 'base ''T2)
+$(deriveSafeCopy 5 'base ''T3)
+$(deriveSafeCopy 3 'base ''T1)
+$(deriveSafeCopy 6 'base ''T4)
+
+data T1G = T1G Char T2G T3G deriving (Generic, Show)
+data T2G = T2G Char deriving (Generic, Show)
+data T3G = T3G Char deriving (Generic, Show)
+data T4G = T4G Word32 Word32 Word32 deriving (Generic, Show)
+
+t1g = T1G 'a' (T2G 'b') (T3G 'c')
+t2g = (T2G 'b')
+t3g = (T3G 'c')
+t4g = T4G 100 200 300
+
+instance SafeCopy T1G where version = 3; kind = base
+instance SafeCopy T2G where version = 4; kind = base
+instance SafeCopy T3G where version = 5; kind = base
+instance SafeCopy T4G where version = 6; kind = base
+
+orderTests :: Test
+orderTests =
+  let -- When I thought to myself "what should the output be type Baz"
+      -- without reference to reality, this is what I came up with.
+      _expected :: ByteString
+      _expected = ("\NUL\NUL\NUL\ETX" <> "\NUL\NUL\NUL\NUL" <> "a" <> "\NUL\NUL\NUL\EOT" <> "\NUL\NUL\NUL\NUL" <> "b" <> "\NUL\NUL\NUL\ENQ" <> "\NUL\NUL\NUL\NUL" <> "c")
+      --                  T1                   Char            'a'            T2                    Char          'b'            T3                   Char           'c'
+      -- But this is reality - the type, followed by its three field
+      -- types, followed by its three field values.
+      actual :: ByteString
+      actual = ("\NUL\NUL\NUL\ETX" <> "\NUL\NUL\NUL\NUL" <> "\NUL\NUL\NUL\EOT" <> "\NUL\NUL\NUL\ENQ" <> "a" <> "\NUL\NUL\NUL\NUL" <> "b" <> "\NUL\NUL\NUL\NUL" <> "c") in
+      --               T1                   Char                    T2                    T3            'a'           Char           'b'            Char          'c'
+  TestList
+     [ TestCase (assertEqual "actual template haskell safeput output" (showBytes actual) (showBytes (runPut (safePut t1))))
+     , TestCase (assertEqual "what the new implementation does"       (showBytes actual) (showBytes (runPut (safePut t1g))))
+     ]
+
+main = do
+  runTestTT
+    (TestList
+      [ orderTests
+      , roundTrip ()
+      , roundTrip ("hello" :: String)
+      , roundTrip foo
+      , roundTrip fooTH
+      , roundTrip bar
+      , roundTrip barTH
+      , roundTrip baz1
+      , roundTrip baz1TH
+      , roundTrip baz2
+      , roundTrip baz2TH
+      , roundTrip (Just 'x')
+      , roundTrip (Nothing :: Maybe Char)
+      , roundTrip ('a', (123 :: Int), ("hello" :: String))
+      , roundTrip file1
+      , roundTrip file2
+      , roundTrip file3
+      , compareBytes fooTH foo
+      , compareBytes barTH bar
+      , compareBytes baz1TH baz1
+      , compareBytes baz2TH baz2
+      ])
diff --git a/test/instances.hs b/test/instances.hs
new file mode 100644
--- /dev/null
+++ b/test/instances.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+import Control.Applicative
+import Control.Lens           (transformOn, transformOnOf)
+import Control.Lens.Traversal (Traversal')
+import Control.Lens.Action    ((^!!), act)
+import Data.Array (Array)
+import Data.Array.Unboxed (UArray)
+import Data.Data.Lens         (template)
+import Data.Fixed (Fixed, E1)
+import Data.List
+import Data.SafeCopy
+import Data.Serialize (runPut, runGet)
+import Data.Time (UniversalTime(..), ZonedTime(..))
+import Data.Tree (Tree)
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import Test.Tasty
+import Test.Tasty.QuickCheck hiding (Fixed, (===))
+import qualified Data.Vector as V
+import qualified Data.Vector.Primitive as VP
+import qualified Data.Vector.Storable as VS
+import qualified Data.Vector.Unboxed as VU
+
+deriving instance (Arbitrary a) => Arbitrary (Prim a)
+deriving instance (Eq a) => Eq (Prim a)
+deriving instance (Show a) => Show (Prim a)
+
+deriving instance Eq ZonedTime
+
+-- | Equality on the 'Right' value, showing the unequal value on failure;
+-- or explicit failure using the 'Left' message without equality testing.
+(===) :: (Eq a, Show a) => Either String a -> a -> Property
+Left  e === _ = printTestCase e False
+Right a === b = printTestCase (show a) $ a == b
+
+-- | An instance for 'SafeCopy' makes a type isomorphic to a bytestring
+-- serialization, which is to say that @decode . encode = id@, i.e.
+-- @decode@ is the inverse of @encode@ if we ignore bottom.
+prop_inverse :: (SafeCopy a, Arbitrary a, Eq a, Show a) => a -> Property
+prop_inverse a = (decode . encode) a === a where
+    encode = runPut . safePut
+    decode = runGet safeGet
+
+-- | Test the 'prop_inverse' property against all 'SafeCopy' instances
+-- (that also satisfy the rest of the constraints) defaulting any type
+-- variables to 'Int'.
+do let a = conT ''Int
+
+   -- types we skip because the Int defaulting doesn't type check
+   excluded <- sequence
+      [ [t| Fixed $a |]
+      ]
+
+   -- instead we include these hand-defaulted types
+   included <- sequence
+      [ [t| Fixed E1 |]
+      ]
+
+   -- types whose samples grow exponentially and need a lower maxSize
+   downsized <- sequence
+      [ [t| Array $a $a |]
+      , [t| UArray $a $a |]
+      , [t| Tree $a |]
+      ]
+
+   safecopy <- reify ''SafeCopy
+   preds <- 'prop_inverse ^!! act reify . (template :: Traversal' Info Pred)
+   classes <-
+         case preds of
+           [ForallT _ cxt' _] ->
+              mapM reify [ name | AppT (ConT name) _ <- cxt' ]
+           _ -> error "FIXME: fix this code to handle this case."
+   def <- a
+
+   let instances (ClassI _ decs) = [ typ | InstanceD _ _ (AppT _ typ) _ <- decs ]
+       instances _ = []
+       types = map instances classes
+
+       defaulting (VarT _) = def
+       defaulting t = t
+       defaulted = transformOn (traverse.traverse) defaulting types
+       wanted = transformOn traverse defaulting $ instances safecopy
+
+       common = foldl1 intersect defaulted
+       untested = wanted \\ common
+       exclusive = filter (`notElem` excluded) common
+
+       downsize typ | typ `elem` downsized = [| mapSize (`div` 5) |]
+                    | otherwise            = [| id |]
+
+       unqualifying (Name occ _) = Name occ NameS
+       name = pprint . transformOnOf template template unqualifying
+
+       prop typ =
+           [| testProperty $(litE . stringL $ name typ)
+               ($(downsize typ) (prop_inverse :: $(return typ) -> Property)) |]
+
+       props = listE . map prop
+
+   mapM_ (\typ -> reportWarning $ "not tested: " ++ name typ) untested
+
+   [d| inversions :: [TestTree]
+       inversions = $(props included) ++ $(props exclusive) |]
+
+main :: IO ()
+main = defaultMain $ testGroup "SafeCopy instances"
+    [ testGroup "decode is the inverse of encode" inversions
+    ]