diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,10 @@
+# 1.12.2 [2018.06.28]
+* Backport the `Generic(1)` instances for `Data.Ord.Down`, introduced in
+  `base-4.12`. Add `GEq`, `GShow`, `GSemigroup`, `GMonoid`, `GFunctor`,
+  `GFoldable`, `GTraversable`, and `GCopoint` instances for `Down`.
+* Refactor internals using `th-abstraction`.
+* Adapt to `Maybe` moving to `GHC.Maybe` in GHC 8.6.
+
 # 1.12.1 [2018.01.11]
 * Remove a test that won't work on GHC 8.4.
 
diff --git a/generic-deriving.cabal b/generic-deriving.cabal
--- a/generic-deriving.cabal
+++ b/generic-deriving.cabal
@@ -1,5 +1,5 @@
 name:                   generic-deriving
-version:                1.12.1
+version:                1.12.2
 synopsis:               Generic programming library for generalised deriving.
 description:
 
@@ -33,7 +33,7 @@
                       , GHC == 7.10.3
                       , GHC == 8.0.2
                       , GHC == 8.2.2
-                      , GHC == 8.4.1
+                      , GHC == 8.4.3
 extra-source-files:     CHANGELOG.md
                       , README.md
 
@@ -75,9 +75,10 @@
     build-depends:      base >= 4.3 && < 4.9
     other-modules:      Generics.Deriving.TH.Pre4_9
 
-  build-depends:        containers       >= 0.1 && < 0.6
-                      , ghc-prim                   < 1
-                      , template-haskell >= 2.4 && < 2.13
+  build-depends:        containers       >= 0.1   && < 0.6
+                      , ghc-prim                     < 1
+                      , template-haskell >= 2.4   && < 2.14
+                      , th-abstraction   >= 0.2.7 && < 0.3
 
   default-language:     Haskell2010
   ghc-options:          -Wall
@@ -91,7 +92,7 @@
   build-depends:        base             >= 4.3  && < 5
                       , generic-deriving
                       , hspec            >= 2    && < 3
-                      , template-haskell >= 2.4  && < 2.13
+                      , template-haskell >= 2.4  && < 2.14
   build-tool-depends:   hspec-discover:hspec-discover
   hs-source-dirs:       tests
   default-language:     Haskell2010
diff --git a/src/Generics/Deriving/Copoint.hs b/src/Generics/Deriving/Copoint.hs
--- a/src/Generics/Deriving/Copoint.hs
+++ b/src/Generics/Deriving/Copoint.hs
@@ -5,13 +5,18 @@
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE Safe #-}
 #endif
 
 #if __GLASGOW_HASKELL__ >= 705
 {-# LANGUAGE PolyKinds #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 module Generics.Deriving.Copoint (
   -- * GCopoint class
     GCopoint(..)
@@ -31,6 +36,12 @@
 
 import           Generics.Deriving.Base
 
+#if MIN_VERSION_base(4,6,0)
+import           Data.Ord (Down)
+#else
+import           GHC.Exts (Down)
+#endif
+
 #if MIN_VERSION_base(4,8,0)
 import           Data.Functor.Identity (Identity)
 import           Data.Monoid (Alt)
@@ -125,6 +136,9 @@
 instance GCopoint (Arg a) where
   gcopoint = gcopointdefault
 #endif
+
+instance GCopoint Down where
+  gcopoint = gcopointdefault
 
 instance GCopoint Dual where
   gcopoint = gcopointdefault
diff --git a/src/Generics/Deriving/Eq.hs b/src/Generics/Deriving/Eq.hs
--- a/src/Generics/Deriving/Eq.hs
+++ b/src/Generics/Deriving/Eq.hs
@@ -365,6 +365,9 @@
 instance GEq Double where
   geq = (==)
 
+instance GEq a => GEq (Down a) where
+  geq = geqdefault
+
 instance GEq a => GEq (Dual a) where
   geq = geqdefault
 
diff --git a/src/Generics/Deriving/Foldable.hs b/src/Generics/Deriving/Foldable.hs
--- a/src/Generics/Deriving/Foldable.hs
+++ b/src/Generics/Deriving/Foldable.hs
@@ -6,13 +6,18 @@
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE Safe #-}
 #endif
 
 #if __GLASGOW_HASKELL__ >= 705
 {-# LANGUAGE PolyKinds #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 module Generics.Deriving.Foldable (
   -- * Generic Foldable class
     GFoldable(..)
@@ -57,6 +62,12 @@
 import           Data.Complex (Complex)
 #endif
 
+#if MIN_VERSION_base(4,6,0)
+import           Data.Ord (Down)
+#else
+import           GHC.Exts (Down)
+#endif
+
 #if MIN_VERSION_base(4,7,0)
 import           Data.Proxy (Proxy)
 #endif
@@ -187,6 +198,9 @@
 #endif
 
 instance GFoldable (Const m) where
+  gfoldMap = gfoldMapdefault
+
+instance GFoldable Down where
   gfoldMap = gfoldMapdefault
 
 instance GFoldable Dual where
diff --git a/src/Generics/Deriving/Functor.hs b/src/Generics/Deriving/Functor.hs
--- a/src/Generics/Deriving/Functor.hs
+++ b/src/Generics/Deriving/Functor.hs
@@ -7,7 +7,6 @@
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE Safe #-}
 #endif
 
 #if __GLASGOW_HASKELL__ >= 705
@@ -18,6 +17,12 @@
 {-# LANGUAGE EmptyCase #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 module Generics.Deriving.Functor (
   -- * Generic Functor class
     GFunctor(..)
@@ -41,6 +46,12 @@
 import           Data.Complex (Complex)
 #endif
 
+#if MIN_VERSION_base(4,6,0)
+import           Data.Ord (Down)
+#else
+import           GHC.Exts (Down)
+#endif
+
 #if MIN_VERSION_base(4,7,0)
 import           Data.Proxy (Proxy)
 #endif
@@ -154,6 +165,9 @@
 #endif
 
 instance GFunctor (Const m) where
+  gmap = gmapdefault
+
+instance GFunctor Down where
   gmap = gmapdefault
 
 instance GFunctor Dual where
diff --git a/src/Generics/Deriving/Instances.hs b/src/Generics/Deriving/Instances.hs
--- a/src/Generics/Deriving/Instances.hs
+++ b/src/Generics/Deriving/Instances.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE TypeSynonymInstances #-}
@@ -13,6 +14,10 @@
 {-# LANGUAGE Trustworthy #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+#endif
+
 #if __GLASGOW_HASKELL__ >= 705
 {-# LANGUAGE PolyKinds #-}
 #endif
@@ -22,8 +27,12 @@
 module Generics.Deriving.Instances (
 -- Only instances from Generics.Deriving.Base
 -- and the Generic1 instances
+#if !(MIN_VERSION_base(4,12,0))
+    Rep0Down
+  , Rep1Down
+#endif
 #if !(MIN_VERSION_base(4,9,0))
-    Rep0ExitCode
+  , Rep0ExitCode
   , Rep0Version
   , Rep1ConSum
   , Rep1ConProduct
@@ -135,9 +144,51 @@
 
 #if !(MIN_VERSION_base(4,9,0))
 import Data.Version (Version(..))
-import Generics.Deriving.Base.Internal
 import System.Exit (ExitCode(..))
 #endif
+
+#if !(MIN_VERSION_base(4,12,0))
+# if MIN_VERSION_base(4,6,0)
+import Data.Ord (Down(..))
+# else
+import GHC.Exts (Down(..))
+# endif
+import Generics.Deriving.Base.Internal
+#endif
+
+#if !(MIN_VERSION_base(4,12,0))
+# if MIN_VERSION_base(4,6,0)
+type Rep0Down a = Rep (Down a)
+type Rep1Down   = Rep1 Down
+deriving instance Generic (Down a)
+deriving instance Generic1 Down
+# else
+type Rep0Down a = D1 D1Down (C1 C1_0Down (S1 NoSelector (Rec0 a)))
+type Rep1Down   = D1 D1Down (C1 C1_0Down (S1 NoSelector Par1))
+
+instance Generic (Down a) where
+    type Rep (Down a) = Rep0Down a
+    from (Down x) = M1 (M1 (M1 (K1 x)))
+    to (M1 (M1 (M1 (K1 x)))) = Down x
+
+instance Generic1 Down where
+    type Rep1 Down = Rep1Down
+    from1 (Down x) = M1 (M1 (M1 (Par1 x)))
+    to1 (M1 (M1 (M1 x))) = Down (unPar1 x)
+
+data D1Down
+data C1_0Down
+
+instance Datatype D1Down where
+    datatypeName _ = "Down"
+    moduleName   _ = "GHC.Exts"
+
+instance Constructor C1_0Down where
+    conName _ = "Down"
+# endif
+#endif
+
+-----
 
 #if !(MIN_VERSION_base(4,9,0))
 type Rep0ExitCode = D1 D1ExitCode (C1 C1_0ExitCode U1
diff --git a/src/Generics/Deriving/Monoid.hs b/src/Generics/Deriving/Monoid.hs
--- a/src/Generics/Deriving/Monoid.hs
+++ b/src/Generics/Deriving/Monoid.hs
@@ -5,13 +5,18 @@
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE Safe #-}
 #endif
 
 #if __GLASGOW_HASKELL__ >= 705
 {-# LANGUAGE PolyKinds #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 {- | This module provides two main features:
 
     1. 'GMonoid', a generic version of the 'Monoid' type class, including instances
@@ -71,6 +76,12 @@
 import Data.Monoid
 import Generics.Deriving.Base
 
+#if MIN_VERSION_base(4,6,0)
+import Data.Ord (Down)
+#else
+import GHC.Exts (Down)
+#endif
+
 #if MIN_VERSION_base(4,7,0)
 import Data.Proxy (Proxy)
 #endif
@@ -217,6 +228,9 @@
   gmempty _ = gmempty
   gmappend f g x = gmappend (f x) (g x)
 instance GMonoid a => GMonoid (Const a b) where
+  gmempty  = gmemptydefault
+  gmappend = gmappenddefault
+instance GMonoid a => GMonoid (Down a) where
   gmempty  = gmemptydefault
   gmappend = gmappenddefault
 
diff --git a/src/Generics/Deriving/Semigroup.hs b/src/Generics/Deriving/Semigroup.hs
--- a/src/Generics/Deriving/Semigroup.hs
+++ b/src/Generics/Deriving/Semigroup.hs
@@ -5,13 +5,18 @@
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE Safe #-}
 #endif
 
 #if __GLASGOW_HASKELL__ >= 705
 {-# LANGUAGE PolyKinds #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 module Generics.Deriving.Semigroup (
   -- * Generic semigroup class
     GSemigroup(..)
@@ -31,6 +36,12 @@
 #endif
 import Generics.Deriving.Base
 
+#if MIN_VERSION_base(4,6,0)
+import Data.Ord (Down)
+#else
+import GHC.Exts (Down)
+#endif
+
 #if MIN_VERSION_base(4,7,0)
 import Data.Proxy (Proxy)
 #endif
@@ -138,6 +149,8 @@
 instance GSemigroup b => GSemigroup (a -> b) where
   gsappend f g x = gsappend (f x) (g x)
 instance GSemigroup a => GSemigroup (Const a b) where
+  gsappend = gsappenddefault
+instance GSemigroup a => GSemigroup (Down a) where
   gsappend = gsappenddefault
 instance GSemigroup (Either a b) where
   gsappend Left{} b = b
diff --git a/src/Generics/Deriving/Show.hs b/src/Generics/Deriving/Show.hs
--- a/src/Generics/Deriving/Show.hs
+++ b/src/Generics/Deriving/Show.hs
@@ -428,6 +428,9 @@
 instance GShow Double where
   gshowsPrec = showsPrec
 
+instance GShow a => GShow (Down a) where
+  gshowsPrec = gshowsPrecdefault
+
 instance GShow a => GShow (Dual a) where
   gshowsPrec = gshowsPrecdefault
 
diff --git a/src/Generics/Deriving/TH.hs b/src/Generics/Deriving/TH.hs
--- a/src/Generics/Deriving/TH.hs
+++ b/src/Generics/Deriving/TH.hs
@@ -102,12 +102,7 @@
 
 import           Control.Monad ((>=>), unless, when)
 
-#if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))
-import           Data.Foldable (foldr')
-#endif
-import           Data.List (nub)
-import qualified Data.Map as Map (fromList)
-import           Data.Maybe (catMaybes)
+import qualified Data.Map as Map (empty, fromList)
 
 import           Generics.Deriving.TH.Internal
 #if MIN_VERSION_base(4,9,0)
@@ -116,6 +111,7 @@
 import           Generics.Deriving.TH.Pre4_9
 #endif
 
+import           Language.Haskell.TH.Datatype
 import           Language.Haskell.TH.Lib
 import           Language.Haskell.TH
 
@@ -311,18 +307,18 @@
 deriveRepCommon :: GenericClass -> KindSigOptions -> Name -> Q [Dec]
 deriveRepCommon gClass useKindSigs n = do
   i <- reifyDataInfo n
-  let (name, isNT, declTvbs, cons, dv) = either error id i
+  let (name, instTys, cons, dv) = either error id i
   -- See Note [Forcing buildTypeInstance]
-  !_ <- buildTypeInstance gClass useKindSigs name declTvbs dv
-  tySynVars <- grabTyVarsFromCons gClass cons
+  !_ <- buildTypeInstance gClass useKindSigs name instTys
 
   -- See Note [Kind signatures in derived instances]
-  let tySynVars' = if useKindSigs
+  let (tySynVars, gk) = genericKind gClass instTys
+      tySynVars' = if useKindSigs
                       then tySynVars
-                      else map unSigT tySynVars
+                      else map unKindedTV tySynVars
   fmap (:[]) $ tySynD (genRepName gClass dv name)
-                      (catMaybes $ map typeToTyVarBndr tySynVars')
-                      (repType gClass dv name isNT cons tySynVars)
+                      tySynVars'
+                      (repType gk dv name Map.empty cons)
 
 deriveInst :: GenericClass -> Options -> Name -> Q [Dec]
 deriveInst Generic  = deriveInstCommon genericTypeName  repTypeName  Generic  fromValName  toValName
@@ -338,13 +334,13 @@
                  -> Q [Dec]
 deriveInstCommon genericName repName gClass fromName toName opts n = do
   i <- reifyDataInfo n
-  let (name, isNT, allTvbs, cons, dv) = either error id i
+  let (name, instTys, cons, dv) = either error id i
       useKindSigs = kindSigOptions opts
   -- See Note [Forcing buildTypeInstance]
-  !(origTy, origKind) <- buildTypeInstance gClass useKindSigs name allTvbs dv
+  !(origTy, origKind) <- buildTypeInstance gClass useKindSigs name instTys
   tyInsRHS <- if repOptions opts == InlineRep
-                 then makeRepInline   gClass dv name isNT cons origTy
-                 else makeRepTySynApp gClass dv name      cons origTy
+                 then makeRepInline   gClass dv name instTys cons origTy
+                 else makeRepTySynApp gClass dv name              origTy
 
   let origSigTy = if useKindSigs
                      then SigT origTy origKind
@@ -356,7 +352,8 @@
                          [origSigTy] tyInsRHS
 #endif
       ecOptions = emptyCaseOptions opts
-      mkBody maker = [clause [] (normalB $ mkCaseExp gClass ecOptions name cons maker) []]
+      mkBody maker = [clause [] (normalB $
+        mkCaseExp gClass ecOptions name instTys cons maker) []]
       fcs = mkBody mkFrom
       tcs = mkBody mkTo
 
@@ -555,47 +552,43 @@
               -> Q Type
 makeRepCommon gClass repOpts n mbQTy = do
   i <- reifyDataInfo n
-  let (name, isNT, declTvbs, cons, dv) = either error id i
+  let (name, instTys, cons, dv) = either error id i
   -- See Note [Forcing buildTypeInstance]
-  !_ <- buildTypeInstance gClass False name declTvbs dv
+  !_ <- buildTypeInstance gClass False name instTys
 
   case (mbQTy, repOpts) of
-       (Just qTy, TypeSynonymRep) -> qTy >>= makeRepTySynApp gClass dv name cons
-       (Just qTy, InlineRep)      -> qTy >>= makeRepInline   gClass dv name isNT cons
+       (Just qTy, TypeSynonymRep) -> qTy >>= makeRepTySynApp gClass dv name
+       (Just qTy, InlineRep)      -> qTy >>= makeRepInline   gClass dv name instTys cons
        (Nothing,  TypeSynonymRep) -> conT $ genRepName gClass dv name
        (Nothing,  InlineRep)      -> fail "makeRepCommon"
 
 makeRepInline :: GenericClass
-              -> DataVariety
+              -> DatatypeVariant_
               -> Name
-              -> Bool
-              -> [Con]
+              -> [Type]
+              -> [ConstructorInfo]
               -> Type
               -> Q Type
-makeRepInline gClass dv name isNT cons ty = do
-  let instVars = map tyVarBndrToType $ requiredTyVarsOfType ty
-  repType gClass dv name isNT cons instVars
+makeRepInline gClass dv name instTys cons ty = do
+  let instVars = requiredTyVarsOfTypes [ty]
+      (tySynVars, gk)  = genericKind gClass instTys
 
-makeRepTySynApp :: GenericClass
-                -> DataVariety
-                -> Name
-                -> [Con]
-                -> Type
-                -> Q Type
-makeRepTySynApp gClass dv name cons ty = do
+      typeSubst :: TypeSubst
+      typeSubst = Map.fromList $
+        zip (map tvName tySynVars)
+            (map (VarT . tvName) instVars)
+
+  repType gk dv name typeSubst cons
+
+makeRepTySynApp :: GenericClass -> DatatypeVariant_ -> Name
+                -> Type -> Q Type
+makeRepTySynApp gClass dv name ty =
   -- Here, we figure out the distinct type variables (in order from left-to-right)
   -- of the LHS of the Rep(1) instance. We call unKindedTV because the kind
   -- inferencer can figure out the kinds perfectly well, so we don't need to
   -- give anything here explicit kind signatures.
-  let instTvbs = map unKindedTV $ requiredTyVarsOfType ty
-  -- We grab the type variables from the first constructor's type signature.
-  -- Or, if there are no constructors, we grab no type variables. The latter
-  -- is okay because we use zipWith to ensure that we never pass more type
-  -- variables than the generated type synonym can accept.
-  -- See Note [Arguments to generated type synonyms]
-  tySynVars <- grabTyVarsFromCons gClass cons
-  return . applyTyToTvbs (genRepName gClass dv name)
-         $ zipWith const instTvbs tySynVars
+  let instTvbs = map unKindedTV $ requiredTyVarsOfTypes [ty]
+  in return $ applyTyToTvbs (genRepName gClass dv name) instTvbs
 
 -- | A backwards-compatible synonym for 'makeFrom0'.
 makeFrom :: Name -> Q Exp
@@ -637,82 +630,88 @@
 makeTo1Options :: EmptyCaseOptions -> Name -> Q Exp
 makeTo1Options = makeFunCommon mkTo Generic1
 
-makeFunCommon :: (GenericClass -> EmptyCaseOptions ->  Int -> Int -> Name -> [Con] -> Q Match)
-              -> GenericClass -> EmptyCaseOptions -> Name -> Q Exp
+makeFunCommon
+  :: (GenericClass -> EmptyCaseOptions ->  Int -> Int -> Name -> [Type]
+                   -> [ConstructorInfo] -> Q Match)
+  -> GenericClass -> EmptyCaseOptions -> Name -> Q Exp
 makeFunCommon maker gClass ecOptions n = do
   i <- reifyDataInfo n
-  let (name, _, allTvbs, cons, dv) = either error id i
+  let (name, instTys, cons, _) = either error id i
   -- See Note [Forcing buildTypeInstance]
-  buildTypeInstance gClass False name allTvbs dv
-    `seq` mkCaseExp gClass ecOptions name cons maker
+  buildTypeInstance gClass False name instTys
+    `seq` mkCaseExp gClass ecOptions name instTys cons maker
 
-genRepName :: GenericClass -> DataVariety -> Name -> Name
-genRepName gClass dv n = mkName
-                      . showsDataVariety dv
-                      . (("Rep" ++ show (fromEnum gClass)) ++)
-                      . ((showNameQual n ++ "_") ++)
-                      . sanitizeName
-                      $ nameBase n
+genRepName :: GenericClass -> DatatypeVariant_
+           -> Name -> Name
+genRepName gClass dv n
+  = mkName
+  . showsDatatypeVariant dv
+  . (("Rep" ++ show (fromEnum gClass)) ++)
+  . ((showNameQual n ++ "_") ++)
+  . sanitizeName
+  $ nameBase n
 
-repType :: GenericClass
-        -> DataVariety
+repType :: GenericKind
+        -> DatatypeVariant_
         -> Name
-        -> Bool
-        -> [Con]
-        -> [Type]
+        -> TypeSubst
+        -> [ConstructorInfo]
         -> Q Type
-repType gClass dv dt isNT cs tySynVars =
-    conT d1TypeName `appT` mkMetaDataType dv dt isNT `appT`
+repType gk dv dt typeSubst cs =
+    conT d1TypeName `appT` mkMetaDataType dv dt `appT`
       foldr1' sum' (conT v1TypeName)
-        (map (repCon gClass dv dt tySynVars) cs)
+        (map (repCon gk dv dt typeSubst) cs)
   where
     sum' :: Q Type -> Q Type -> Q Type
     sum' a b = conT sumTypeName `appT` a `appT` b
 
-repCon :: GenericClass
-       -> DataVariety
+repCon :: GenericKind
+       -> DatatypeVariant_
        -> Name
-       -> [Type]
-       -> Con
+       -> TypeSubst
+       -> ConstructorInfo
        -> Q Type
-repCon gClass dv dt tySynVars (NormalC n bts) = do
-    let bangs = map fst bts
-    ssis <- reifySelStrictInfo n bangs
-    repConWith gClass dv dt n tySynVars Nothing ssis False False
-repCon gClass dv dt tySynVars (RecC n vbts) = do
-    let (selNames, bangs, _) = unzip3 vbts
-    ssis <- reifySelStrictInfo n bangs
-    repConWith gClass dv dt n tySynVars (Just selNames) ssis True False
-repCon gClass dv dt tySynVars (InfixC t1 n t2) = do
-    let bangs = map fst [t1, t2]
-    ssis <- reifySelStrictInfo n bangs
-    repConWith gClass dv dt n tySynVars Nothing ssis False True
-repCon _ _ _ _ con = gadtError con
+repCon gk dv dt typeSubst
+  (ConstructorInfo { constructorName       = n
+                   , constructorVars       = vars
+                   , constructorContext    = ctxt
+                   , constructorStrictness = bangs
+                   , constructorFields     = ts
+                   , constructorVariant    = cv
+                   }) = do
+  checkExistentialContext n vars ctxt
+  let mbSelNames = case cv of
+                     NormalConstructor          -> Nothing
+                     InfixConstructor           -> Nothing
+                     RecordConstructor selNames -> Just selNames
+      isRecord   = case cv of
+                     NormalConstructor   -> False
+                     InfixConstructor    -> False
+                     RecordConstructor _ -> True
+      isInfix    = case cv of
+                     NormalConstructor   -> False
+                     InfixConstructor    -> True
+                     RecordConstructor _ -> False
+  ssis <- reifySelStrictInfo n bangs
+  repConWith gk dv dt n typeSubst mbSelNames ssis ts isRecord isInfix
 
-repConWith :: GenericClass
-           -> DataVariety
+repConWith :: GenericKind
+           -> DatatypeVariant_
            -> Name
            -> Name
-           -> [Type]
+           -> TypeSubst
            -> Maybe [Name]
            -> [SelStrictInfo]
+           -> [Type]
            -> Bool
            -> Bool
            -> Q Type
-repConWith gClass dv dt n tySynVars mbSelNames ssis isRecord isInfix = do
-    (conVars, ts, gk) <- reifyConTys gClass n
-
+repConWith gk dv dt n typeSubst mbSelNames ssis ts isRecord isInfix = do
     let structureType :: Q Type
         structureType = case ssis of
                              [] -> conT u1TypeName
                              _  -> foldr1 prodT f
 
-        -- See Note [Substituting types in a constructor type signature]
-        typeSubst :: TypeSubst
-        typeSubst = Map.fromList $
-          zip (nub $ concatMap             tyVarNamesOfType  conVars)
-              (nub $ concatMap (map VarT . tyVarNamesOfType) tySynVars)
-
         f :: [Q Type]
         f = case mbSelNames of
                  Just selNames -> zipWith3 (repField gk dv dt n typeSubst . Just)
@@ -728,7 +727,7 @@
 prodT a b = conT productTypeName `appT` a `appT` b
 
 repField :: GenericKind
-         -> DataVariety
+         -> DatatypeVariant_
          -> Name
          -> Name
          -> TypeSubst
@@ -739,20 +738,19 @@
 repField gk dv dt ns typeSubst mbF ssi t =
            conT s1TypeName
     `appT` mkMetaSelType dv dt ns mbF ssi
-    `appT` (repFieldArg gk =<< expandSyn t'')
+    `appT` (repFieldArg gk =<< resolveTypeSynonyms t'')
   where
-    -- See Note [Substituting types in constructor type signatures]
+    -- See Note [Generic1 is polykinded in base-4.10]
     t', t'' :: Type
     t' = case gk of
               Gen1 _ (Just _kvName) ->
--- See Note [Generic1 is polykinded in base-4.10]
 #if MIN_VERSION_base(4,10,0)
                 t
 #else
                 substNameWithKind _kvName starK t
 #endif
               _ -> t
-    t'' = substType typeSubst t'
+    t'' = applySubstitution typeSubst t'
 
 repFieldArg :: GenericKind -> Type -> Q Type
 repFieldArg _ ForallT{} = rankNError
@@ -790,15 +788,18 @@
     Just (boxTyName, _, _) -> conT boxTyName
     Nothing                -> conT rec0TypeName `appT` return ty
 
-mkCaseExp :: GenericClass -> EmptyCaseOptions -> Name -> [Con]
-          -> (GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Con] -> Q Match)
-          -> Q Exp
-mkCaseExp gClass ecOptions dt cs matchmaker = do
+mkCaseExp
+  :: GenericClass -> EmptyCaseOptions -> Name -> [Type] -> [ConstructorInfo]
+  -> (GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Type]
+                   -> [ConstructorInfo] -> Q Match)
+  -> Q Exp
+mkCaseExp gClass ecOptions dt instTys cs matchmaker = do
   val <- newName "val"
-  lam1E (varP val) $ caseE (varE val) [matchmaker gClass ecOptions 1 0 dt cs]
+  lam1E (varP val) $ caseE (varE val) [matchmaker gClass ecOptions 1 0 dt instTys cs]
 
-mkFrom :: GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Con] -> Q Match
-mkFrom gClass ecOptions m i dt cs = do
+mkFrom :: GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Type]
+       -> [ConstructorInfo] -> Q Match
+mkFrom gClass ecOptions m i dt instTys cs = do
     y <- newName "y"
     match (varP y)
           (normalB $ conE m1DataName `appE` caseE (varE y) cases)
@@ -806,8 +807,9 @@
   where
     cases = case cs of
               [] -> errorFrom ecOptions dt
-              _  -> zipWith (fromCon gClass wrapE (length cs)) [0..] cs
+              _  -> zipWith (fromCon gk wrapE (length cs)) [0..] cs
     wrapE e = lrE m i e
+    (_, gk) = genericKind gClass instTys
 
 errorFrom :: EmptyCaseOptions -> Name -> [Q Match]
 errorFrom useEmptyCase dt
@@ -824,8 +826,9 @@
                           ++ nameBase dt))
           []]
 
-mkTo :: GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Con] -> Q Match
-mkTo gClass ecOptions m i dt cs = do
+mkTo :: GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Type]
+     -> [ConstructorInfo] -> Q Match
+mkTo gClass ecOptions m i dt instTys cs = do
     y <- newName "y"
     match (conP m1DataName [varP y])
           (normalB $ caseE (varE y) cases)
@@ -833,8 +836,9 @@
   where
     cases = case cs of
               [] -> errorTo ecOptions dt
-              _  -> zipWith (toCon gClass wrapP (length cs)) [0..] cs
+              _  -> zipWith (toCon gk wrapP (length cs)) [0..] cs
     wrapP p = lrP m i p
+    (_, gk) = genericKind gClass instTys
 
 errorTo :: EmptyCaseOptions -> Name -> [Q Match]
 errorTo useEmptyCase dt
@@ -857,38 +861,30 @@
 ghc7'8OrLater = False
 #endif
 
-fromCon :: GenericClass -> (Q Exp -> Q Exp) -> Int -> Int -> Con -> Q Match
-fromCon _ wrap m i (NormalC cn []) =
-  match
-    (conP cn [])
-    (normalB $ wrap $ lrE m i $ conE m1DataName `appE` (conE u1DataName)) []
-fromCon gClass wrap m i (NormalC cn _) = do
-  (ts, gk) <- fmap shrink $ reifyConTys gClass cn
-  fNames   <- newNameList "f" $ length ts
-  match
-    (conP cn (map varP fNames))
-    (normalB $ wrap $ lrE m i $ conE m1DataName `appE`
-      foldr1 prodE (zipWith (fromField gk) fNames ts)) []
-fromCon _ wrap m i (RecC cn []) =
-  match
-    (conP cn [])
-    (normalB $ wrap $ lrE m i $ conE m1DataName `appE` (conE u1DataName)) []
-fromCon gClass wrap m i (RecC cn _) = do
-  (ts, gk) <- fmap shrink $ reifyConTys gClass cn
-  fNames   <- newNameList "f" $ length ts
-  match
-    (conP cn (map varP fNames))
-    (normalB $ wrap $ lrE m i $ conE m1DataName `appE`
-      foldr1 prodE (zipWith (fromField gk) fNames ts)) []
-fromCon gClass wrap m i (InfixC t1 cn t2) =
-  fromCon gClass wrap m i (NormalC cn [t1,t2])
-fromCon _ _ _ _ con = gadtError con
+fromCon :: GenericKind -> (Q Exp -> Q Exp) -> Int -> Int
+        -> ConstructorInfo -> Q Match
+fromCon gk wrap m i
+  (ConstructorInfo { constructorName    = cn
+                   , constructorVars    = vars
+                   , constructorContext = ctxt
+                   , constructorFields  = ts
+                   }) = do
+  checkExistentialContext cn vars ctxt
+  case ts of
+    [] -> match (conP cn [])
+                (normalB $ wrap $ lrE m i $ conE m1DataName `appE` (conE u1DataName)) []
+    _ -> do
+      fNames <- newNameList "f" $ length ts
+      match
+        (conP cn (map varP fNames))
+        (normalB $ wrap $ lrE m i $ conE m1DataName `appE`
+          foldr1 prodE (zipWith (fromField gk) fNames ts)) []
 
 prodE :: Q Exp -> Q Exp -> Q Exp
 prodE x y = conE productDataName `appE` x `appE` y
 
 fromField :: GenericKind -> Name -> Type -> Q Exp
-fromField gk nr t = conE m1DataName `appE` (fromFieldWrap gk nr =<< expandSyn t)
+fromField gk nr t = conE m1DataName `appE` (fromFieldWrap gk nr =<< resolveTypeSynonyms t)
 
 fromFieldWrap :: GenericKind -> Name -> Type -> Q Exp
 fromFieldWrap _             _  ForallT{}  = rankNError
@@ -926,36 +922,27 @@
 boxRepName :: Type -> Name
 boxRepName = maybe k1DataName snd3 . unboxedRepNames
 
-toCon :: GenericClass -> (Q Pat -> Q Pat) -> Int -> Int -> Con -> Q Match
-toCon _ wrap m i (NormalC cn []) =
-    match
-      (wrap $ lrP m i $ conP m1DataName [conP u1DataName []])
-      (normalB $ conE cn) []
-toCon gClass wrap m i (NormalC cn _) = do
-    (ts, gk) <- fmap shrink $ reifyConTys gClass cn
-    fNames   <- newNameList "f" $ length ts
-    match
-      (wrap $ lrP m i $ conP m1DataName
-        [foldr1 prod (zipWith (toField gk) fNames ts)])
-      (normalB $ foldl appE (conE cn) (zipWith (\nr -> expandSyn >=> toConUnwC gk nr)
-                                      fNames ts)) []
-  where prod x y = conP productDataName [x,y]
-toCon _ wrap m i (RecC cn []) =
-    match
-      (wrap $ lrP m i $ conP m1DataName [conP u1DataName []])
-      (normalB $ conE cn) []
-toCon gClass wrap m i (RecC cn _) = do
-    (ts, gk) <- fmap shrink $ reifyConTys gClass cn
-    fNames   <- newNameList "f" $ length ts
-    match
-      (wrap $ lrP m i $ conP m1DataName
-        [foldr1 prod (zipWith (toField gk) fNames ts)])
-      (normalB $ foldl appE (conE cn) (zipWith (\nr -> expandSyn >=> toConUnwC gk nr)
-                                               fNames ts)) []
+toCon :: GenericKind -> (Q Pat -> Q Pat) -> Int -> Int
+      -> ConstructorInfo -> Q Match
+toCon gk wrap m i
+  (ConstructorInfo { constructorName    = cn
+                   , constructorVars    = vars
+                   , constructorContext = ctxt
+                   , constructorFields  = ts
+                   }) = do
+  checkExistentialContext cn vars ctxt
+  case ts of
+    [] -> match (wrap $ lrP m i $ conP m1DataName [conP u1DataName []])
+                (normalB $ conE cn) []
+    _ -> do
+      fNames <- newNameList "f" $ length ts
+      match
+        (wrap $ lrP m i $ conP m1DataName
+          [foldr1 prod (zipWith (toField gk) fNames ts)])
+        (normalB $ foldl appE (conE cn)
+                         (zipWith (\nr -> resolveTypeSynonyms >=> toConUnwC gk nr)
+                         fNames ts)) []
   where prod x y = conP productDataName [x,y]
-toCon gk wrap m i (InfixC t1 cn t2) =
-  toCon gk wrap m i (NormalC cn [t1,t2])
-toCon _ _ _ _ con = gadtError con
 
 toConUnwC :: GenericKind -> Name -> Type -> Q Exp
 toConUnwC Gen0          nr _ = varE nr
@@ -1019,109 +1006,26 @@
   | ty == ConT wordHashTypeName   = Just (uWordTypeName,   uWordDataName,   uWordHashValName)
   | otherwise                     = Nothing
 
--- | Deduces the instance type (and kind) to use for a Generic(1) instance.
+-- For the given Types, deduces the instance type (and kind) to use for a
+-- Generic(1) instance. Coming up with the instance type isn't as simple as
+-- dropping the last types, as you need to be wary of kinds being instantiated
+-- with *.
+-- See Note [Type inference in derived instances]
 buildTypeInstance :: GenericClass
                   -- ^ Generic or Generic1
                   -> KindSigOptions
                   -- ^ Whether or not to use explicit kind signatures in the instance type
                   -> Name
                   -- ^ The type constructor or data family name
-                  -> [TyVarBndr]
-                  -- ^ The type variables from the data type/data family declaration
-                  -> DataVariety
-                  -- ^ If using a data family instance, provides the types used
-                  -- to instantiate the instance
+                  -> [Type]
+                  -- ^ The types to instantiate the instance with
                   -> Q (Type, Kind)
--- Plain data type/newtype case
-buildTypeInstance gClass useKindSigs tyConName tvbs DataPlain =
-    let varTys :: [Type]
-        varTys = map tyVarBndrToType tvbs
-    in buildTypeInstanceFromTys gClass useKindSigs tyConName varTys
--- Data family instance case
---
--- The CPP is present to work around a couple of annoying old GHC bugs.
--- See Note [Polykinded data families in Template Haskell]
-buildTypeInstance gClass useKindSigs parentName tvbs (DataFamily _ instTysAndKinds) = do
-#if !(MIN_VERSION_template_haskell(2,8,0)) || MIN_VERSION_template_haskell(2,10,0)
-    let instTys :: [Type]
-        instTys = zipWith stealKindForType tvbs instTysAndKinds
-#else
-    let kindVarNames :: [Name]
-        kindVarNames = nub $ concatMap (tyVarNamesOfType . tyVarBndrKind) tvbs
-
-        numKindVars :: Int
-        numKindVars = length kindVarNames
-
-        givenKinds, givenKinds' :: [Kind]
-        givenTys                :: [Type]
-        (givenKinds, givenTys) = splitAt numKindVars instTysAndKinds
-        givenKinds' = map sanitizeStars givenKinds
-
-        -- A GHC 7.6-specific bug requires us to replace all occurrences of
-        -- (ConT GHC.Prim.*) with StarT, or else Template Haskell will reject it.
-        -- Luckily, (ConT GHC.Prim.*) only seems to occur in this one spot.
-        sanitizeStars :: Kind -> Kind
-        sanitizeStars = go
-          where
-            go :: Kind -> Kind
-            go (AppT t1 t2)                 = AppT (go t1) (go t2)
-            go (SigT t k)                   = SigT (go t) (go k)
-            go (ConT n) | n == starKindName = StarT
-            go t                            = t
-
-    -- If we run this code with GHC 7.8, we might have to generate extra type
-    -- variables to compensate for any type variables that Template Haskell
-    -- eta-reduced away.
-    -- See Note [Polykinded data families in Template Haskell]
-    xTypeNames <- newNameList "tExtra" (length tvbs - length givenTys)
-
-    let xTys   :: [Type]
-        -- Because these type variables were eta-reduced away, we can only
-        -- determine their kind by using stealKindForType. Therefore, we mark
-        -- them as VarT to ensure they will be given an explicit kind annotation
-        -- (and so the kind inference machinery has the right information).
-        xTys = map VarT xTypeNames
-
-        substNamesWithKinds :: [(Name, Kind)] -> Type -> Type
-        substNamesWithKinds nks t = foldr' (uncurry substNameWithKind) t nks
-
-        -- The types from the data family instance might not have explicit kind
-        -- annotations, which the kind machinery needs to work correctly. To
-        -- compensate, we use stealKindForType to explicitly annotate any
-        -- types without kind annotations.
-        instTys :: [Type]
-        instTys = map (substNamesWithKinds (zip kindVarNames givenKinds'))
-                  -- Note that due to a GHC 7.8-specific bug
-                  -- (see Note [Polykinded data families in Template Haskell]),
-                  -- there may be more kind variable names than there are kinds
-                  -- to substitute. But this is OK! If a kind is eta-reduced, it
-                  -- means that is was not instantiated to something more specific,
-                  -- so we need not substitute it. Using stealKindForType will
-                  -- grab the correct kind.
-                $ zipWith stealKindForType tvbs (givenTys ++ xTys)
-#endif
-    buildTypeInstanceFromTys gClass useKindSigs parentName instTys
-
--- For the given Types, deduces the instance type (and kind) to use for a
--- Generic(1) instance. Coming up with the instance type isn't as simple as
--- dropping the last types, as you need to be wary of kinds being instantiated
--- with *.
--- See Note [Type inference in derived instances]
-buildTypeInstanceFromTys :: GenericClass
-                         -- ^ Generic or Generic1
-                         -> KindSigOptions
-                         -- ^ Whether or not to use explicit kind signatures in the instance type
-                         -> Name
-                         -- ^ The type constructor or data family name
-                         -> [Type]
-                         -- ^ The types to instantiate the instance with
-                         -> Q (Type, Kind)
-buildTypeInstanceFromTys gClass useKindSigs tyConName varTysOrig = do
+buildTypeInstance gClass useKindSigs tyConName varTysOrig = do
     -- Make sure to expand through type/kind synonyms! Otherwise, the
     -- eta-reduction check might get tripped up over type variables in a
     -- synonym that are actually dropped.
     -- (See GHC Trac #11416 for a scenario where this actually happened.)
-    varTysExp <- mapM expandSyn varTysOrig
+    varTysExp <- mapM resolveTypeSynonyms varTysOrig
 
     let remainingLength :: Int
         remainingLength = length varTysOrig - fromEnum gClass
@@ -1213,12 +1117,6 @@
       etaReductionError instanceType
     return (instanceType, instanceKind)
 
--- See Note [Arguments to generated type synonyms]
-grabTyVarsFromCons :: GenericClass -> [Con] -> Q [Type]
-grabTyVarsFromCons _      []      = return []
-grabTyVarsFromCons gClass (con:_) =
-    fmap fst3 $ reifyConTys gClass (constructorName con)
-
 {-
 Note [Forcing buildTypeInstance]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1230,107 +1128,6 @@
 to be skipped entirely, which could result in some indecipherable type errors
 down the road.
 
-Note [Substituting types in constructor type signatures]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-While reifyConTys gives you the type variables of a constructor, they may not be
-the same of the data declaration's type variables. The classic example of this is
-GADTs:
-
-  data GADT a b where
-    GADTCon :: e -> f -> GADT e f
-
-The type variables of GADTCon are completely different from the declaration's, which
-can cause a problem when generating a Rep instance:
-
-  type Rep (GADT a b) = Rec0 e :*: Rec0 f
-
-Naïvely, we would generate something like this, since traversing the constructor
-would give us precisely those arguments. Not good. We need to perform a type
-substitution to ensure that e maps to a, and f maps to b.
-
-This turns out to be surprisingly simple. Whenever you have a constructor type
-signature like (e -> f -> GADT e f), take the result type, collect all of its
-distinct type variables in order from left-to-right, and then map them to their
-corresponding type variables from the data declaration.
-
-There is another obscure case where we need to do a type subtitution. With
--XTypeInType enabled on GHC 8.0, you might have something like this:
-
-  data Proxy (a :: k) (b :: k) = Proxy k deriving Generic1
-
-Then k gets specialized to *, which means that k should NOT show up in the RHS of
-a Rep1 type instance! To avoid this, make sure to substitute k with *.
-See also Note [Generic1 is polykinded in base-4.10].
-
-Note [Arguments to generated type synonyms]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-A surprisingly difficult component of generating the type synonyms for Rep/Rep1 is
-coming up with the type synonym variable arguments, since they have to be just the
-right name and kind to work. The type signature of a constructor does a remarkably
-good job of coming up with these type variables for us, so if at least one constructor
-exists, we simply steal the type variables from that constructor's type signature
-for use in the generated type synonym. We also count the number of type variables
-that the first constructor's type signature has in order to determine how many
-type variables we should give it as arguments in the generated
-(type Rep (Foo ...) = <makeRep> ...) code.
-
-This leads one to ask: what if there are no constructors? If that's the case, then
-we're OK, since that means no type variables can possibly appear on the RHS of the
-type synonym! In such a special case, we're perfectly justified in making the type
-synonym not have any type variable arguments, and similarly, we don't apply any
-arguments to it in the generated (type Rep Foo = <makeRep>) code.
-
-Note [Polykinded data families in Template Haskell]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-In order to come up with the correct instance context and head for an instance, e.g.,
-
-  instance C a => C (Data a) where ...
-
-We need to know the exact types and kinds used to instantiate the instance. For
-plain old datatypes, this is simple: every type must be a type variable, and
-Template Haskell reliably tells us the type variables and their kinds.
-
-Doing the same for data families proves to be much harder for three reasons:
-
-1. On any version of Template Haskell, it may not tell you what an instantiated
-   type's kind is. For instance, in the following data family instance:
-
-     data family Fam (f :: * -> *) (a :: *)
-     data instance Fam f a
-
-   Then if we use TH's reify function, it would tell us the TyVarBndrs of the
-   data family declaration are:
-
-     [KindedTV f (AppT (AppT ArrowT StarT) StarT),KindedTV a StarT]
-
-   and the instantiated types of the data family instance are:
-
-     [VarT f1,VarT a1]
-
-   We can't just pass [VarT f1,VarT a1] to buildTypeInstanceFromTys, since we
-   have no way of knowing their kinds. Luckily, the TyVarBndrs tell us what the
-   kind is in case an instantiated type isn't a SigT, so we use the stealKindForType
-   function to ensure all of the instantiated types are SigTs before passing them
-   to buildTypeInstanceFromTys.
-2. On GHC 7.6 and 7.8, a bug is present in which Template Haskell lists all of
-   the specified kinds of a data family instance efore any of the instantiated
-   types. Fortunately, this is easy to deal with: you simply count the number of
-   distinct kind variables in the data family declaration, take that many elements
-   from the front of the  Types list of the data family instance, substitute the
-   kind variables with their respective instantiated kinds (which you took earlier),
-   and proceed as normal.
-3. On GHC 7.8, an even uglier bug is present (GHC Trac #9692) in which Template
-   Haskell might not even list all of the Types of a data family instance, since
-   they are eta-reduced away! And yes, kinds can be eta-reduced too.
-
-   The simplest workaround is to count how many instantiated types are missing from
-   the list and generate extra type variables to use in their place. Luckily, we
-   needn't worry much if its kind was eta-reduced away, since using stealKindForType
-   will get it back.
-
 Note [Kind signatures in derived instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -1377,7 +1174,7 @@
 The Rep1 type instance in a Generic1 instance for Compose would involve the type
 (f :.: Rec1 g), which forces (f :: * -> *). But this library doesn't have very
 sophisticated kind inference machinery (other than what is mentioned in
-Note [Substituting types in constructor type signatures]), so at the moment we
+Note [Generic1 is polykinded in base-4.10]), so at the moment we
 have no way of actually unifying k1 with *. So the naïve generated Generic1
 instance would be:
 
diff --git a/src/Generics/Deriving/TH/Internal.hs b/src/Generics/Deriving/TH/Internal.hs
--- a/src/Generics/Deriving/TH/Internal.hs
+++ b/src/Generics/Deriving/TH/Internal.hs
@@ -14,6 +14,8 @@
 
 module Generics.Deriving.TH.Internal where
 
+import           Control.Monad (unless)
+
 import           Data.Char (isAlphaNum, ord)
 import           Data.Foldable (foldr')
 import           Data.List
@@ -23,10 +25,16 @@
 import qualified Data.Set as Set
 import           Data.Set (Set)
 
+import           Language.Haskell.TH.Datatype
 import           Language.Haskell.TH.Lib
 import           Language.Haskell.TH.Ppr (pprint)
 import           Language.Haskell.TH.Syntax
 
+#if !(MIN_VERSION_base(4,8,0))
+import           Data.Foldable (Foldable(foldMap))
+import           Data.Monoid (Monoid(..))
+#endif
+
 #ifndef CURRENT_PACKAGE_KEY
 import           Data.Version (showVersion)
 import           Paths_generic_deriving (version)
@@ -36,88 +44,21 @@
 -- Expanding type synonyms
 -------------------------------------------------------------------------------
 
--- | Expands all type synonyms in a type. Written by Dan Rosén in the
--- @genifunctors@ package (licensed under BSD3).
-expandSyn :: Type -> Q Type
-expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t
-expandSyn t@AppT{}            = expandSynApp t []
-expandSyn t@ConT{}            = expandSynApp t []
-expandSyn (SigT t k)          = do t' <- expandSyn t
-                                   k' <- expandSynKind k
-                                   return (SigT t' k')
-expandSyn t                   = return t
-
-expandSynKind :: Kind -> Q Kind
-#if MIN_VERSION_template_haskell(2,8,0)
-expandSynKind = expandSyn
-#else
-expandSynKind = return -- There are no kind synonyms to deal with
-#endif
-
-expandSynApp :: Type -> [Type] -> Q Type
-expandSynApp (AppT t1 t2) ts = do
-    t2' <- expandSyn t2
-    expandSynApp t1 (t2':ts)
-expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts
-expandSynApp t@(ConT n) ts = do
-    info <- reify n
-    case info of
-        TyConI (TySynD _ tvs rhs) ->
-            let (ts', ts'') = splitAt (length tvs) ts
-                subs = mkSubst tvs ts'
-                rhs' = substType subs rhs
-             in expandSynApp rhs' ts''
-        _ -> return $ foldl' AppT t ts
-expandSynApp t ts = do
-    t' <- expandSyn t
-    return $ foldl' AppT t' ts
-
 type TypeSubst = Map Name Type
-type KindSubst = Map Name Kind
 
-mkSubst :: [TyVarBndr] -> [Type] -> TypeSubst
-mkSubst vs ts =
-   let vs' = map tyVarBndrName vs
-   in Map.fromList $ zip vs' ts
-
-substType :: TypeSubst -> Type -> Type
-substType subs (ForallT v c t) = ForallT v c $ substType subs t
-substType subs t@(VarT n)      = Map.findWithDefault t n subs
-substType subs (AppT t1 t2)    = AppT (substType subs t1) (substType subs t2)
-substType subs (SigT t k)      = SigT (substType subs t)
-#if MIN_VERSION_template_haskell(2,8,0)
-                                      (substType subs k)
-#else
-                                      k
-#endif
-substType _ t                  = t
-
-substKind :: KindSubst -> Type -> Type
+applySubstitutionKind :: Map Name Kind -> Type -> Type
 #if MIN_VERSION_template_haskell(2,8,0)
-substKind = substType
+applySubstitutionKind = applySubstitution
 #else
-substKind _ = id -- There are no kind variables!
+applySubstitutionKind _ t = t
 #endif
 
 substNameWithKind :: Name -> Kind -> Type -> Type
-substNameWithKind n k = substKind (Map.singleton n k)
+substNameWithKind n k = applySubstitutionKind (Map.singleton n k)
 
 substNamesWithKindStar :: [Name] -> Type -> Type
 substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns
 
-substTyVarBndrType :: TypeSubst -> TyVarBndr -> Type
-substTyVarBndrType subs = substType subs . tyVarBndrToType
-
-substTyVarBndrKind :: KindSubst -> TyVarBndr -> Type
-#if MIN_VERSION_template_haskell(2,8,0)
-substTyVarBndrKind = substTyVarBndrType
-#else
-substTyVarBndrKind _ = tyVarBndrToType
-#endif
-
-substNameWithKindStarInTyVarBndr :: Name -> TyVarBndr -> Type
-substNameWithKindStarInTyVarBndr n = substTyVarBndrKind (Map.singleton n starK)
-
 -------------------------------------------------------------------------------
 -- StarKindStatus
 -------------------------------------------------------------------------------
@@ -163,31 +104,45 @@
 #endif
 hasKindStar _              = False
 
--- | Gets all of the type/kind variable names mentioned somewhere in a Type.
-tyVarNamesOfType :: Type -> [Name]
-tyVarNamesOfType = go
-  where
-    go :: Type -> [Name]
-    go (AppT t1 t2) = go t1 ++ go t2
-    go (SigT t _k)  = go t
+-- | Gets all of the required type/kind variable binders mentioned in a Type.
+-- This does not add separate items for kind variable binders (in contrast with
+-- the behavior of 'freeVariables').
+requiredTyVarsOfTypes :: [Type] -> [TyVarBndr]
+requiredTyVarsOfTypes tys =
+  let fvs :: [Name]
+      fvs = nub $ concatMap freeVariables tys
+
+      varKindSigs :: Map Name Kind
+      varKindSigs = foldMap go tys
+        where
+          go :: Type -> Map Name Kind
+          go (ForallT {}) = error "`forall` type used in type family pattern"
+          go (AppT t1 t2) = go t1 `mappend` go t2
+          go (SigT t k) =
+            let kSigs =
 #if MIN_VERSION_template_haskell(2,8,0)
-                           ++ go _k
+                  go k
+#else
+                  mempty
 #endif
-    go (VarT n)     = [n]
-    go _            = []
+            in case t of
+                 VarT n -> Map.insert n k kSigs
+                 _      -> go t `mappend` kSigs
+          go _ = mempty
 
--- | Gets all of the required type/kind variable binders mentioned in a Type.
--- This does not add separate items for kind variable binders (in contrast with
--- the behavior of 'tyVarNamesOfType').
-requiredTyVarsOfType :: Type -> [TyVarBndr]
-requiredTyVarsOfType = go
-  where
-    go :: Type -> [TyVarBndr]
-    go (AppT t1 t2)      = go t1 ++ go t2
-    go (SigT (VarT n) k) = [KindedTV n k]
-    go (VarT n)          = [PlainTV n]
-    go _                 = []
+      ascribeWithKind n
+        | Just k <- Map.lookup n varKindSigs
+        = KindedTV n k
+        | otherwise
+        = PlainTV n
 
+      isKindBinder = (`Set.member` kindVars)
+        where
+          kindVars = Set.fromList $ concatMap freeVariables $ Map.elems varKindSigs
+
+  in map ascribeWithKind $
+     filter (not . isKindBinder) fvs
+
 -- | Converts a VarT or a SigT into Just the corresponding TyVarBndr.
 -- Converts other Types to Nothing.
 typeToTyVarBndr :: Type -> Maybe TyVarBndr
@@ -322,19 +277,6 @@
 tyVarBndrToType (PlainTV n)    = VarT n
 tyVarBndrToType (KindedTV n k) = SigT (VarT n) k
 
-tyVarBndrName :: TyVarBndr -> Name
-tyVarBndrName (PlainTV  name)   = name
-tyVarBndrName (KindedTV name _) = name
-
-tyVarBndrKind :: TyVarBndr -> Kind
-tyVarBndrKind PlainTV{}      = starK
-tyVarBndrKind (KindedTV _ k) = k
-
--- | If a VarT is missing an explicit kind signature, steal it from a TyVarBndr.
-stealKindForType :: TyVarBndr -> Type -> Type
-stealKindForType tvb t@VarT{} = SigT t (tyVarBndrKind tvb)
-stealKindForType _   t        = t
-
 -- | Generate a list of fresh names with a common prefix, and numbered suffixes.
 newNameList :: String -> Int -> Q [Name]
 newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n]
@@ -443,16 +385,11 @@
 foldr1' _ _ [x] = x
 foldr1' f x (h:t) = f h (foldr1' f x t)
 
--- | Extracts the name of a constructor.
-constructorName :: Con -> Name
-constructorName (NormalC name      _  ) = name
-constructorName (RecC    name      _  ) = name
-constructorName (InfixC  _    name _  ) = name
-constructorName (ForallC _    _    con) = constructorName con
-#if MIN_VERSION_template_haskell(2,11,0)
-constructorName (GadtC    names _ _)    = head names
-constructorName (RecGadtC names _ _)    = head names
-#endif
+isNewtypeVariant :: DatatypeVariant_ -> Bool
+isNewtypeVariant Datatype_             = False
+isNewtypeVariant Newtype_              = True
+isNewtypeVariant (DataInstance_ {})    = False
+isNewtypeVariant (NewtypeInstance_ {}) = True
 
 #if MIN_VERSION_template_haskell(2,7,0)
 -- | Extracts the constructors of a data or newtype declaration.
@@ -482,84 +419,50 @@
                  | Gen1 Name (Maybe Name)
 
 -- Determines the universally quantified type variables (possibly after
--- substituting * in the case of Generic1), the types of a constructor's
--- arguments, and the last type parameter name (if there is one).
-reifyConTys :: GenericClass
-            -> Name
-            -> Q ([Type], [Type], GenericKind)
-reifyConTys gClass conName = do
-    info <- reify conName
-    let (tvbs, uncTy) = case info of
-          DataConI _ ty _
-#if !(MIN_VERSION_template_haskell(2,11,0))
-                   _
-#endif
-                   -> uncurryTy ty
-          _ -> error "Must be a data constructor"
-    let (argTys, [resTy]) = splitAt (length uncTy - 1) uncTy
-    -- Make sure to expand through synonyms on the last type, or else you might
-    -- have something like
-    --
-    --   type Constant a b = a
-    --   data Good a = Good (Constant a b)
-    --
-    -- which you'd only be able to tell was legal if you expand Constant a b to a!
-    resTyExp <- expandSyn resTy
-    let numResTyVars = length . nub $ requiredTyVarsOfType resTyExp
-        -- We need to grab a number of types from the constructor's
-        -- type signature to re-use for the Rep(1) type synonym's type variable
-        -- binders. As it turns out, that number is equal to the number of distinct
-        -- type variables which appear in the result type.
-        --
-        -- We assume that the required types all come last in the list
-        -- of forall'd type variables. I suppose nothing guarantees this, but
-        -- this seems to always be the case via experimentation. Fingers crossed.
-        requiredTvbs = drop (length tvbs - numResTyVars) tvbs
-    let (requiredTyVars', gk) = case gClass of
-           Generic  -> (map tyVarBndrToType requiredTvbs, Gen0)
-           Generic1 ->
-             -- If deriving Generic1 and the last type variable is polykinded,
-             -- make sure to substitute that kind with * in the other type
-             -- variable binders' kind signatures
-             let headRequiredTvbs :: [TyVarBndr]
-                 lastRequiredTvb :: TyVarBndr
-                 (headRequiredTvbs, [lastRequiredTvb]) =
-                   splitAt (length requiredTvbs - 1) requiredTvbs
+-- substituting * in the case of Generic1) and the last type parameter name
+-- (if there is one).
+genericKind :: GenericClass -> [Type] -> ([TyVarBndr], GenericKind)
+genericKind gClass tySynVars =
+  case gClass of
+    Generic  -> (requiredTyVarsOfTypes tySynVars, Gen0)
+    Generic1 -> (requiredTyVarsOfTypes initArgs, Gen1 (varTToName lastArg) mbLastArgKindName)
+  where
+    -- Everything below is only used for Generic1.
+    initArgs :: [Type]
+    initArgs = init tySynVars
 
-                 mbLastArgKindName :: Maybe Name
-                 mbLastArgKindName = starKindStatusToName
-                                   . canRealizeKindStar
-                                   $ tyVarBndrToType lastRequiredTvb
+    lastArg :: Type
+    lastArg = last tySynVars
 
-                 requiredTyVars :: [Type]
-                 requiredTyVars =
-                   case mbLastArgKindName of
-                        Nothing   -> map tyVarBndrToType headRequiredTvbs
-                        Just _lakn ->
--- See Note [Generic1 is polykinded in base-4.10] in Generics.Deriving.TH
-#if MIN_VERSION_base(4,10,0)
-                          map tyVarBndrToType headRequiredTvbs
-#else
-                          map (substNameWithKindStarInTyVarBndr _lakn)
-                              headRequiredTvbs
-#endif
-             in ( requiredTyVars
-                , Gen1 (tyVarBndrName lastRequiredTvb) mbLastArgKindName
-                )
-    return (requiredTyVars', argTys, gk)
+    mbLastArgKindName :: Maybe Name
+    mbLastArgKindName = starKindStatusToName
+                      $ canRealizeKindStar lastArg
 
--- | Indicates whether Generic(1) is being derived for a plain data type (DataPlain)
--- or a data family instance (DataFamily). DataFamily bundles the Name of the data
--- family instance's first constructor (for Name-generation purposes) and the types
--- used to instantiate the instance.
-data DataVariety = DataPlain | DataFamily Name [Type]
+-- | A version of 'DatatypeVariant' in which the data family instance
+-- constructors come equipped with the 'ConstructorInfo' of the first
+-- constructor in the family instance (for 'Name' generation purposes).
+data DatatypeVariant_
+  = Datatype_
+  | Newtype_
+  | DataInstance_    ConstructorInfo
+  | NewtypeInstance_ ConstructorInfo
 
-showsDataVariety :: DataVariety -> ShowS
-showsDataVariety dv = (++ '_':label dv)
+showsDatatypeVariant :: DatatypeVariant_ -> ShowS
+showsDatatypeVariant variant = (++ '_':label)
   where
-    label DataPlain        = "Plain"
-    label (DataFamily n _) = "Family_" ++ sanitizeName (nameBase n)
+    dataPlain :: String
+    dataPlain = "Plain"
 
+    dataFamily :: ConstructorInfo -> String
+    dataFamily con = "Family_" ++ sanitizeName (nameBase $ constructorName con)
+
+    label :: String
+    label = case variant of
+              Datatype_            -> dataPlain
+              Newtype_             -> dataPlain
+              DataInstance_    con -> dataFamily con
+              NewtypeInstance_ con -> dataFamily con
+
 showNameQual :: Name -> String
 showNameQual = sanitizeName . showQual
   where
@@ -577,15 +480,15 @@
 
 -- | One of the last type variables cannot be eta-reduced (see the canEtaReduce
 -- function for the criteria it would have to meet).
-etaReductionError :: Type -> a
-etaReductionError instanceType = error $
+etaReductionError :: Type -> Q a
+etaReductionError instanceType = fail $
   "Cannot eta-reduce to an instance of form \n\tinstance (...) => "
   ++ pprint instanceType
 
 -- | Either the given data type doesn't have enough type variables, or one of
 -- the type variables to be eta-reduced cannot realize kind *.
-derivingKindError :: Name -> a
-derivingKindError tyConName = error
+derivingKindError :: Name -> Q a
+derivingKindError tyConName = fail
   . showString "Cannot derive well-kinded instance of form ‘Generic1 "
   . showParen True
     ( showString (nameBase tyConName)
@@ -594,15 +497,10 @@
   . showString "‘\n\tClass Generic1 expects an argument of kind * -> *"
   $ ""
 
-outOfPlaceTyVarError :: a
-outOfPlaceTyVarError = error $
+outOfPlaceTyVarError :: Q a
+outOfPlaceTyVarError = fail
     "Type applied to an argument involving the last parameter is not of kind * -> *"
 
--- | Deriving Generic(1) doesn't work with ExistentialQuantification or GADTs
-gadtError :: Con -> a
-gadtError con = error $
-  nameBase (constructorName con) ++ " must be a vanilla data constructor"
-
 -- | Cannot have a constructor argument of form (forall a1 ... an. <type>)
 -- when deriving Generic(1)
 rankNError :: a
@@ -617,86 +515,42 @@
 --
 -- Any other value will result in an exception.
 reifyDataInfo :: Name
-              -> Q (Either String (Name, Bool, [TyVarBndr], [Con], DataVariety))
+              -> Q (Either String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
 reifyDataInfo name = do
-  info <- reify name
-  case info of
-    TyConI dec ->
-      return $ case dec of
-        DataD ctxt _ tvbs
-#if MIN_VERSION_template_haskell(2,11,0)
-              _
-#endif
-              cons _ -> Right $
-          checkDataContext name ctxt (name, False, tvbs, cons, DataPlain)
-        NewtypeD ctxt _ tvbs
-#if MIN_VERSION_template_haskell(2,11,0)
-                 _
-#endif
-                 con _ -> Right $
-          checkDataContext name ctxt (name, True, tvbs, [con], DataPlain)
-        TySynD{} -> Left $ ns ++ "Type synonyms are not supported."
-        _        -> Left $ ns ++ "Unsupported type: " ++ show dec
-#if MIN_VERSION_template_haskell(2,7,0)
-# if MIN_VERSION_template_haskell(2,11,0)
-    DataConI _ _ parentName   -> do
-# else
-    DataConI _ _ parentName _ -> do
-# endif
-      parentInfo <- reify parentName
-      return $ case parentInfo of
-# if MIN_VERSION_template_haskell(2,11,0)
-        FamilyI (DataFamilyD _ tvbs _) decs ->
-# else
-        FamilyI (FamilyD DataFam _ tvbs _) decs ->
-# endif
-          -- This isn't total, but the API requires that the data family instance have
-          -- at least one constructor anyways, so this will always succeed.
-          let instDec = flip find decs $ any ((name ==) . constructorName) . dataDecCons
-           in case instDec of
-                Just (DataInstD ctxt _ instTys
-# if MIN_VERSION_template_haskell(2,11,0)
-                                _
-# endif
-                                cons _) -> Right $
-                  checkDataContext parentName ctxt
-                    (parentName, False, tvbs, cons, DataFamily (constructorName $ head cons) instTys)
-                Just (NewtypeInstD ctxt _ instTys
-# if MIN_VERSION_template_haskell(2,11,0)
-                                   _
-# endif
-                                   con _) -> Right $
-                  checkDataContext parentName ctxt
-                    (parentName, True, tvbs, [con], DataFamily (constructorName con) instTys)
-                _ -> Left $ ns ++
-                  "Could not find data or newtype instance constructor."
-        _ -> Left $ ns ++ "Data constructor " ++ show name ++
-          " is not from a data family instance constructor."
-# if MIN_VERSION_template_haskell(2,11,0)
-    FamilyI DataFamilyD{} _ ->
-# else
-    FamilyI (FamilyD DataFam _ _ _) _ ->
-# endif
-      return . Left $
-        ns ++ "Cannot use a data family name. Use a data family instance constructor instead."
-    _ -> return . Left $ ns ++ "The name must be of a plain data type constructor, "
-                            ++ "or a data family instance constructor."
-#else
-    DataConI{} -> return . Left $ ns ++ "Cannot use a data constructor."
-        ++ "\n\t(Note: if you are trying to derive for a data family instance, use GHC >= 7.4 instead.)"
-    _          -> return . Left $ ns ++ "The name must be of a plain type constructor."
-#endif
+  return $ Left $ ns ++ " Could not reify " ++ nameBase name
+ `recover`
+  do DatatypeInfo { datatypeContext = ctxt
+                  , datatypeName    = parentName
+                  , datatypeVars    = tys
+                  , datatypeVariant = variant
+                  , datatypeCons    = cons
+                  } <- reifyDatatype name
+     let variant_ = case variant of
+                      Datatype        -> Datatype_
+                      Newtype         -> Newtype_
+                      -- This isn't total, but the API requires that the data
+                      -- family instance have at least one constructor anyways,
+                      -- so this will always succeed.
+                      DataInstance    -> DataInstance_    $ head cons
+                      NewtypeInstance -> NewtypeInstance_ $ head cons
+     checkDataContext parentName ctxt $ Right (parentName, tys, cons, variant_)
   where
     ns :: String
     ns = "Generics.Deriving.TH.reifyDataInfo: "
 
 -- | One cannot derive Generic(1) instance for anything that uses DatatypeContexts,
 -- so check to make sure the Cxt field of a datatype is null.
-checkDataContext :: Name -> Cxt -> a -> a
-checkDataContext _        [] x = x
-checkDataContext dataName _  _ = error $
+checkDataContext :: Name -> Cxt -> a -> Q a
+checkDataContext _        [] x = return x
+checkDataContext dataName _  _ = fail $
   nameBase dataName ++ " must not have a datatype context"
 
+-- | Deriving Generic(1) doesn't work with ExistentialQuantification or GADTs.
+checkExistentialContext :: Name -> [TyVarBndr] -> Cxt -> Q ()
+checkExistentialContext conName vars ctxt =
+  unless (null vars && null ctxt) $ fail $
+    nameBase conName ++ " must be a vanilla data constructor"
+
 -------------------------------------------------------------------------------
 -- Manually quoted names
 -------------------------------------------------------------------------------
@@ -983,7 +837,10 @@
 #endif
 
 nothingDataName, justDataName :: Name
-#if MIN_VERSION_base(4,8,0)
+#if MIN_VERSION_base(4,12,0)
+nothingDataName = mkBaseName_d "GHC.Maybe"  "Nothing"
+justDataName    = mkBaseName_d "GHC.Maybe"  "Just"
+#elif MIN_VERSION_base(4,8,0)
 nothingDataName = mkBaseName_d "GHC.Base"   "Nothing"
 justDataName    = mkBaseName_d "GHC.Base"   "Just"
 #else
diff --git a/src/Generics/Deriving/TH/Post4_9.hs b/src/Generics/Deriving/TH/Post4_9.hs
--- a/src/Generics/Deriving/TH/Post4_9.hs
+++ b/src/Generics/Deriving/TH/Post4_9.hs
@@ -27,22 +27,23 @@
 
 import Generics.Deriving.TH.Internal
 
+import Language.Haskell.TH.Datatype as THAbs
 import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Syntax
 
-mkMetaDataType :: DataVariety -> Name -> Bool -> Q Type
-mkMetaDataType _ n isNewtype =
+mkMetaDataType :: DatatypeVariant_ -> Name -> Q Type
+mkMetaDataType dv n =
            promotedT metaDataDataName
     `appT` litT (strTyLit (nameBase n))
     `appT` litT (strTyLit m)
     `appT` litT (strTyLit pkg)
-    `appT` promoteBool isNewtype
+    `appT` promoteBool (isNewtypeVariant dv)
   where
     m, pkg :: String
     m   = fromMaybe (error "Cannot fetch module name!")  (nameModule n)
     pkg = fromMaybe (error "Cannot fetch package name!") (namePackage n)
 
-mkMetaConsType :: DataVariety -> Name -> Name -> Bool -> Bool -> Q Type
+mkMetaConsType :: DatatypeVariant_ -> Name -> Name -> Bool -> Bool -> Q Type
 mkMetaConsType _ _ n conIsRecord conIsInfix = do
     mbFi <- reifyFixity n
     promotedT metaConsDataName
@@ -68,42 +69,41 @@
 promoteAssociativity InfixR = promotedT rightAssociativeDataName
 promoteAssociativity InfixN = promotedT notAssociativeDataName
 
-mkMetaSelType :: DataVariety -> Name -> Name -> Maybe Name -> SelStrictInfo -> Q Type
+mkMetaSelType :: DatatypeVariant_ -> Name -> Name -> Maybe Name
+              -> SelStrictInfo -> Q Type
 mkMetaSelType _ _ _ mbF (SelStrictInfo su ss ds) =
     let mbSelNameT = case mbF of
             Just f  -> promotedT justDataName `appT` litT (strTyLit (nameBase f))
             Nothing -> promotedT nothingDataName
     in promotedT metaSelDataName
         `appT` mbSelNameT
-        `appT` promoteSourceUnpackedness su
-        `appT` promoteSourceStrictness ss
+        `appT` promoteUnpackedness su
+        `appT` promoteStrictness ss
         `appT` promoteDecidedStrictness ds
 
-data SelStrictInfo = SelStrictInfo SourceUnpackedness SourceStrictness DecidedStrictness
+data SelStrictInfo = SelStrictInfo Unpackedness Strictness DecidedStrictness
 
-promoteSourceUnpackedness :: SourceUnpackedness -> Q Type
-promoteSourceUnpackedness NoSourceUnpackedness = promotedT noSourceUnpackednessDataName
-promoteSourceUnpackedness SourceNoUnpack       = promotedT sourceNoUnpackDataName
-promoteSourceUnpackedness SourceUnpack         = promotedT sourceUnpackDataName
+promoteUnpackedness :: Unpackedness -> Q Type
+promoteUnpackedness UnspecifiedUnpackedness = promotedT noSourceUnpackednessDataName
+promoteUnpackedness NoUnpack                = promotedT sourceNoUnpackDataName
+promoteUnpackedness Unpack                  = promotedT sourceUnpackDataName
 
-promoteSourceStrictness :: SourceStrictness -> Q Type
-promoteSourceStrictness NoSourceStrictness = promotedT noSourceStrictnessDataName
-promoteSourceStrictness SourceLazy         = promotedT sourceLazyDataName
-promoteSourceStrictness SourceStrict       = promotedT sourceStrictDataName
+promoteStrictness :: Strictness -> Q Type
+promoteStrictness UnspecifiedStrictness = promotedT noSourceStrictnessDataName
+promoteStrictness Lazy                  = promotedT sourceLazyDataName
+promoteStrictness THAbs.Strict          = promotedT sourceStrictDataName
 
 promoteDecidedStrictness :: DecidedStrictness -> Q Type
 promoteDecidedStrictness DecidedLazy   = promotedT decidedLazyDataName
 promoteDecidedStrictness DecidedStrict = promotedT decidedStrictDataName
 promoteDecidedStrictness DecidedUnpack = promotedT decidedUnpackDataName
 
-reifySelStrictInfo :: Name -> [Bang] -> Q [SelStrictInfo]
-reifySelStrictInfo conName bangs = do
+reifySelStrictInfo :: Name -> [FieldStrictness] -> Q [SelStrictInfo]
+reifySelStrictInfo conName fs = do
     dcdStrs <- reifyConStrictness conName
-    let (srcUnpks, srcStrs) = unzip $ map splitBang bangs
+    let srcUnpks = map fieldUnpackedness fs
+        srcStrs  = map fieldStrictness   fs
     return $ zipWith3 SelStrictInfo srcUnpks srcStrs dcdStrs
-
-splitBang :: Bang -> (SourceUnpackedness, SourceStrictness)
-splitBang (Bang su ss) = (su, ss)
 
 -- | Given the type and the name (as string) for the type to derive,
 -- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'
diff --git a/src/Generics/Deriving/TH/Pre4_9.hs b/src/Generics/Deriving/TH/Pre4_9.hs
--- a/src/Generics/Deriving/TH/Pre4_9.hs
+++ b/src/Generics/Deriving/TH/Pre4_9.hs
@@ -30,6 +30,7 @@
 
 import Generics.Deriving.TH.Internal
 
+import Language.Haskell.TH.Datatype
 import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Syntax
 
@@ -60,77 +61,83 @@
 dataInstance n = do
   i <- reifyDataInfo n
   case i of
-    Left  _                    -> return []
-    Right (n', isNT, _, _, dv) -> mkInstance n' dv isNT
+    Left  _              -> return []
+    Right (n', _, _, dv) -> mkInstance n' dv
   where
-    mkInstance n' dv isNT = do
+    mkInstance n' dv = do
       ds <- mkDataData dv n'
-      is <- mkDataInstance dv n' isNT
+      is <- mkDataInstance dv n'
       return $ [ds,is]
 
 constrInstance :: Name -> Q [Dec]
 constrInstance n = do
   i <- reifyDataInfo n
   case i of
-    Left  _               -> return []
-    Right (n', _, _, cs, dv) -> mkInstance n' cs dv
+    Left  _                 -> return []
+    Right (n', _, cons, dv) -> mkInstance n' cons dv
   where
-    mkInstance n' cs dv = do
-      ds <- mapM (mkConstrData dv n') cs
-      is <- mapM (mkConstrInstance dv n') cs
+    mkInstance n' cons dv = do
+      ds <- mapM (mkConstrData dv n') cons
+      is <- mapM (mkConstrInstance dv n') cons
       return $ ds ++ is
 
 selectInstance :: Name -> Q [Dec]
 selectInstance n = do
   i <- reifyDataInfo n
   case i of
-    Left  _               -> return []
-    Right (n', _, _, cs, dv) -> mkInstance n' cs dv
+    Left  _                 -> return []
+    Right (n', _, cons, dv) -> mkInstance n' cons dv
   where
-    mkInstance n' cs dv = do
-      ds <- mapM (mkSelectData dv n') cs
-      is <- mapM (mkSelectInstance dv n') cs
+    mkInstance n' cons dv = do
+      ds <- mapM (mkSelectData dv n') cons
+      is <- mapM (mkSelectInstance dv n') cons
       return $ concat (ds ++ is)
 
-mkDataData :: DataVariety -> Name -> Q Dec
-mkDataData dv n = dataD (cxt []) (genName dv [n]) []
+mkDataData :: DatatypeVariant_ -> Name -> Q Dec
+mkDataData dv n =
+  dataD (cxt []) (genName dv [n]) []
 #if MIN_VERSION_template_haskell(2,11,0)
-                        Nothing [] (cxt [])
+        Nothing [] (cxt [])
 #else
-                        [] []
+        [] []
 #endif
 
-mkConstrData :: DataVariety -> Name -> Con -> Q Dec
-mkConstrData dv dt (NormalC n _) =
+mkConstrData :: DatatypeVariant_ -> Name -> ConstructorInfo -> Q Dec
+mkConstrData dv dt
+  (ConstructorInfo { constructorName    = n
+                   , constructorVars    = vars
+                   , constructorContext = ctxt
+                   }) = do
+  checkExistentialContext n vars ctxt
   dataD (cxt []) (genName dv [dt, n]) []
 #if MIN_VERSION_template_haskell(2,11,0)
         Nothing [] (cxt [])
 #else
         [] []
 #endif
-mkConstrData dv dt (RecC n f) =
-  mkConstrData dv dt (NormalC n (map shrink f))
-mkConstrData dv dt (InfixC t1 n t2) =
-  mkConstrData dv dt (NormalC n [t1,t2])
-mkConstrData _ _ con = gadtError con
 
-mkSelectData :: DataVariety -> Name -> Con -> Q [Dec]
-mkSelectData dv dt (RecC n fs) = return (map one fs)
-  where one (f, _, _) = DataD [] (genName dv [dt, n, f]) []
+mkSelectData :: DatatypeVariant_ -> Name -> ConstructorInfo -> Q [Dec]
+mkSelectData dv dt
+  (ConstructorInfo { constructorName    = n
+                   , constructorVariant = cv
+                   }) =
+  case cv of
+    NormalConstructor    -> return []
+    InfixConstructor     -> return []
+    RecordConstructor fs -> return (map one fs)
+  where one f = DataD [] (genName dv [dt, n, f]) []
 #if MIN_VERSION_template_haskell(2,11,0)
-                              Nothing
+                      Nothing
 #endif
-                              [] []
-mkSelectData _ _ _ = return []
-
-mkDataInstance :: DataVariety -> Name -> Bool -> Q Dec
-mkDataInstance dv n isNewtype =
-  instanceD (cxt []) (appT (conT datatypeTypeName) (mkMetaDataType dv n isNewtype)) $
+                      [] []
+mkDataInstance :: DatatypeVariant_ -> Name -> Q Dec
+mkDataInstance dv n =
+  instanceD (cxt []) (appT (conT datatypeTypeName) (mkMetaDataType dv n)) $
     [ funD datatypeNameValName [clause [wildP] (normalB (stringE (nameBase n))) []]
     , funD moduleNameValName   [clause [wildP] (normalB (stringE name)) []]
     ]
 #if MIN_VERSION_base(4,7,0)
- ++ if isNewtype
+ ++ if isNewtypeVariant dv
        then [funD isNewtypeValName [clause [wildP] (normalB (conE trueDataName)) []]]
        else []
 #endif
@@ -147,26 +154,34 @@
 liftAssociativity InfixR = conE rightAssociativeDataName
 liftAssociativity InfixN = conE notAssociativeDataName
 
-mkConstrInstance :: DataVariety -> Name -> Con -> Q Dec
-mkConstrInstance dv dt (NormalC n _) = mkConstrInstanceWith dv dt n False False []
-mkConstrInstance dv dt (RecC    n _) =
-    mkConstrInstanceWith dv dt n True False
-      [funD conIsRecordValName [clause [wildP] (normalB (conE trueDataName)) []]]
-mkConstrInstance dv dt (InfixC _ n _) = do
-    i <- reify n
+mkConstrInstance :: DatatypeVariant_ -> Name
+                 -> ConstructorInfo -> Q Dec
+mkConstrInstance dv dt
+  (ConstructorInfo { constructorName    = n
+                   , constructorVars    = vars
+                   , constructorContext = ctxt
+                   , constructorVariant = cv
+                   }) = do
+  checkExistentialContext n vars ctxt
+  case cv of
+    NormalConstructor -> mkConstrInstanceWith dv dt n False False []
+    InfixConstructor -> do
+      i <- reify n
 #if MIN_VERSION_template_haskell(2,11,0)
-    fi <- case i of
-                  DataConI{} -> fromMaybe defaultFixity `fmap` reifyFixity n
+      fi <- case i of
+              DataConI{} -> fromMaybe defaultFixity `fmap` reifyFixity n
 #else
-    let fi = case i of
-                  DataConI _ _ _ f -> f
+      let fi = case i of
+                 DataConI _ _ _ f -> f
 #endif
-                  _ -> error $ "Not a data constructor name: " ++ show n
-    mkConstrInstanceWith dv dt n False True
-      [funD conFixityValName [clause [wildP] (normalB (liftFixity fi)) []]]
-mkConstrInstance _ _ con = gadtError con
+                 _ -> error $ "Not a data constructor name: " ++ show n
+      mkConstrInstanceWith dv dt n False True
+        [funD conFixityValName [clause [wildP] (normalB (liftFixity fi)) []]]
+    RecordConstructor _ ->
+      mkConstrInstanceWith dv dt n True False
+        [funD conIsRecordValName [clause [wildP] (normalB (conE trueDataName)) []]]
 
-mkConstrInstanceWith :: DataVariety
+mkConstrInstanceWith :: DatatypeVariant_
                      -> Name
                      -> Name
                      -> Bool
@@ -179,38 +194,48 @@
     (appT (conT constructorTypeName) (mkMetaConsType dv dt n isRecord isInfix))
     (funD conNameValName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)
 
-mkSelectInstance :: DataVariety -> Name -> Con -> Q [Dec]
-mkSelectInstance dv dt (RecC n fs) = mapM (one . fst3) fs where
+mkSelectInstance :: DatatypeVariant_ -> Name
+                 -> ConstructorInfo -> Q [Dec]
+mkSelectInstance dv dt
+  (ConstructorInfo { constructorName    = n
+                   , constructorVariant = cv
+                   }) =
+  case cv of
+    NormalConstructor    -> return []
+    InfixConstructor     -> return []
+    RecordConstructor fs -> mapM one fs
+  where
   one :: Name -> Q Dec
   one f =
     instanceD (cxt []) (appT (conT selectorTypeName) (mkMetaSelType dv dt n (Just f) ()))
       [funD selNameValName [clause [wildP]
         (normalB (litE (stringL (nameBase f)))) []]]
-mkSelectInstance _ _ _ = return []
 
-genName :: DataVariety -> [Name] -> Name
-genName dv ns = mkName
-              . showsDataVariety dv
-              . intercalate "_"
-              . consQualName
-              $ map (sanitizeName . nameBase) ns
+genName :: DatatypeVariant_ -> [Name] -> Name
+genName dv ns
+  = mkName
+  . showsDatatypeVariant dv
+  . intercalate "_"
+  . consQualName
+  $ map (sanitizeName . nameBase) ns
   where
     consQualName :: [String] -> [String]
     consQualName = case ns of
         []  -> id
         n:_ -> (showNameQual n :)
 
-mkMetaDataType :: DataVariety -> Name -> Bool -> Q Type
-mkMetaDataType dv n _ = conT $ genName dv [n]
+mkMetaDataType :: DatatypeVariant_ -> Name -> Q Type
+mkMetaDataType dv n = conT $ genName dv [n]
 
-mkMetaConsType :: DataVariety -> Name -> Name -> Bool -> Bool -> Q Type
+mkMetaConsType :: DatatypeVariant_ -> Name -> Name -> Bool -> Bool -> Q Type
 mkMetaConsType dv dt n _ _ = conT $ genName dv [dt, n]
 
-mkMetaSelType :: DataVariety -> Name -> Name -> Maybe Name -> SelStrictInfo -> Q Type
+mkMetaSelType :: DatatypeVariant_ -> Name -> Name -> Maybe Name
+              -> SelStrictInfo -> Q Type
 mkMetaSelType dv dt n (Just f) () = conT $ genName dv [dt, n, f]
 mkMetaSelType _  _  _ Nothing  () = conT noSelectorTypeName
 
 type SelStrictInfo = ()
 
-reifySelStrictInfo :: Name -> [Strict] -> Q [SelStrictInfo]
+reifySelStrictInfo :: Name -> [FieldStrictness] -> Q [SelStrictInfo]
 reifySelStrictInfo _ bangs = return (map (const ()) bangs)
diff --git a/src/Generics/Deriving/Traversable.hs b/src/Generics/Deriving/Traversable.hs
--- a/src/Generics/Deriving/Traversable.hs
+++ b/src/Generics/Deriving/Traversable.hs
@@ -7,7 +7,6 @@
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE Safe #-}
 #endif
 
 #if __GLASGOW_HASKELL__ >= 705
@@ -18,6 +17,12 @@
 {-# LANGUAGE EmptyCase #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 710
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 module Generics.Deriving.Traversable (
   -- * Generic Traversable class
     GTraversable(..)
@@ -46,6 +51,12 @@
 import           Data.Complex (Complex)
 #endif
 
+#if MIN_VERSION_base(4,6,0)
+import           Data.Ord (Down)
+#else
+import           GHC.Exts (Down)
+#endif
+
 #if MIN_VERSION_base(4,7,0)
 import           Data.Proxy (Proxy)
 #endif
@@ -159,6 +170,9 @@
 #endif
 
 instance GTraversable (Const m) where
+  gtraverse = gtraversedefault
+
+instance GTraversable Down where
   gtraverse = gtraversedefault
 
 instance GTraversable Dual where
diff --git a/tests/ExampleSpec.hs b/tests/ExampleSpec.hs
--- a/tests/ExampleSpec.hs
+++ b/tests/ExampleSpec.hs
@@ -342,6 +342,11 @@
                | MyType1Cons2 (f :/: a) Int a (f a)
                | (f :/: a) :/: MyType2
 
+infixr 5 :!@!:
+data GADTSyntax a b where
+  GADTPrefix :: d -> c -> GADTSyntax c d
+  (:!@!:)    :: e -> f -> GADTSyntax e f
+
 data MyType2 = MyType2 Float ([] :/: Int)
 data PlainHash a = Hash a Addr# Char# Double# Float# Int# Word#
 
@@ -388,6 +393,7 @@
 
 $(deriveAll0And1 ''Empty)
 $(deriveAll0And1 ''(:/:))
+$(deriveAll0And1 ''GADTSyntax)
 $(deriveAll0     ''MyType2)
 $(deriveAll0And1 ''PlainHash)
 $(deriveAll0     ''ExampleSpec.Lexeme)