diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,9 @@
+Version 1.3
+---------------
+* Added `newtype Flip` to exports - PR by Jeremy List
+* Generating INLINE pragmas from Rank2.TH
+* Generating the proper constraints on derived instances where needed
+
 Version 1.2.1
 ---------------
 * Added unsafeDeriveApply
diff --git a/rank2classes.cabal b/rank2classes.cabal
--- a/rank2classes.cabal
+++ b/rank2classes.cabal
@@ -1,5 +1,5 @@
 name:                rank2classes
-version:             1.2.1
+version:             1.3
 synopsis:            standard type constructor class hierarchy, only with methods of rank 2 types
 description:
   A mirror image of the standard type constructor class hierarchy rooted in 'Functor', except with methods of rank 2
diff --git a/src/Rank2.hs b/src/Rank2.hs
--- a/src/Rank2.hs
+++ b/src/Rank2.hs
@@ -12,7 +12,7 @@
    Functor(..), Apply(..), Applicative(..),
    Foldable(..), Traversable(..), Distributive(..), DistributiveTraversable(..), distributeJoin,
 -- * Rank 2 data types
-   Compose(..), Empty(..), Only(..), Identity(..), Product(..), Sum(..), Arrow(..), type (~>),
+   Compose(..), Empty(..), Only(..), Flip(..), Identity(..), Product(..), Sum(..), Arrow(..), type (~>),
 -- * Method synonyms and helper functions
    fst, snd, ap, fmap, liftA4, liftA5,
    fmapTraverse, liftA2Traverse1, liftA2Traverse2, liftA2TraverseBoth,
@@ -26,10 +26,10 @@
 import Data.Coerce (coerce)
 import Data.Semigroup (Semigroup(..))
 import Data.Monoid (Monoid(..))
-import Data.Functor.Compose (Compose(..))
+import Data.Functor.Compose (Compose(Compose, getCompose))
 import Data.Functor.Const (Const(..))
-import Data.Functor.Product (Product(..))
-import Data.Functor.Sum (Sum(..))
+import Data.Functor.Product (Product(Pair))
+import Data.Functor.Sum (Sum(InL, InR))
 
 import Prelude hiding (Foldable(..), Traversable(..), Functor(..), Applicative(..), (<$>), fst, snd)
 
@@ -170,7 +170,8 @@
 -- | Equivalent of 'Data.Functor.Identity' for rank 2 data types
 newtype Identity g f = Identity {runIdentity :: g f} deriving (Eq, Ord, Show)
 
-newtype Flip g a f = Flip (g (f a)) deriving (Eq, Ord, Show)
+-- | A nested parametric type represented as a rank-2 type
+newtype Flip g a f = Flip {unFlip :: g (f a)} deriving (Eq, Ord, Show)
 
 instance Semigroup (g (f a)) => Semigroup (Flip g a f) where
    Flip x <> Flip y = Flip (x <> y)
diff --git a/src/Rank2/TH.hs b/src/Rank2/TH.hs
--- a/src/Rank2/TH.hs
+++ b/src/Rank2/TH.hs
@@ -23,7 +23,7 @@
 
 import qualified Rank2
 
-data Deriving = Deriving { _derivingConstructor :: Name, _derivingVariable :: Name }
+data Deriving = Deriving { _derivingConstructor :: Name, _derivingVariable :: Name } deriving Show
 
 deriveAll :: Name -> Q [Dec]
 deriveAll ty = foldr f (pure []) [deriveFunctor, deriveApply, deriveApplicative,
@@ -33,42 +33,61 @@
 deriveFunctor :: Name -> Q [Dec]
 deriveFunctor ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Functor ty
-   sequence [instanceD (return []) instanceType [genFmap cs]]
+   (constraints, dec) <- genFmap cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType
+             [pure dec, pragInlD '(Rank2.<$>) Inline FunLike AllPhases]]
 
 deriveApply :: Name -> Q [Dec]
 deriveApply ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Apply ty
-   sequence [instanceD (return []) instanceType [genAp cs, genLiftA2 cs, genLiftA3 cs]]
+   (constraints, dec) <- genAp cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType
+             [pure dec, genLiftA2 cs, genLiftA3 cs,
+              pragInlD '(Rank2.<*>) Inlinable FunLike AllPhases,
+              pragInlD 'Rank2.liftA2 Inlinable FunLike AllPhases]]
 
 unsafeDeriveApply :: Name -> Q [Dec]
 unsafeDeriveApply ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Apply ty
-   sequence [instanceD (return []) instanceType [genApUnsafely cs, genLiftA2Unsafely cs, genLiftA3Unsafely cs]]
+   (constraints, dec) <- genApUnsafely cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType
+             [pure dec, genLiftA2Unsafely cs, genLiftA3Unsafely cs,
+              pragInlD '(Rank2.<*>) Inlinable FunLike AllPhases,
+              pragInlD 'Rank2.liftA2 Inlinable FunLike AllPhases]]
 
 deriveApplicative :: Name -> Q [Dec]
 deriveApplicative ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Applicative ty
-   sequence [instanceD (return []) instanceType [genPure cs]]
+   (constraints, dec) <- genPure cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType
+             [pure dec, pragInlD 'Rank2.pure Inline FunLike AllPhases]]
 
 deriveFoldable :: Name -> Q [Dec]
 deriveFoldable ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Foldable ty
-   sequence [instanceD (return []) instanceType [genFoldMap cs]]
+   (constraints, dec) <- genFoldMap cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType
+             [pure dec, pragInlD 'Rank2.foldMap Inlinable FunLike AllPhases]]
 
 deriveTraversable :: Name -> Q [Dec]
 deriveTraversable ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Traversable ty
-   sequence [instanceD (return []) instanceType [genTraverse cs]]
+   (constraints, dec) <- genTraverse cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType
+             [pure dec, pragInlD 'Rank2.traverse Inlinable FunLike AllPhases]]
 
 deriveDistributive :: Name -> Q [Dec]
 deriveDistributive ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Distributive ty
-   sequence [instanceD (return []) instanceType [genCotraverse cs]]
+   (constraints, dec) <- genCotraverse cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType
+             [pure dec, pragInlD 'Rank2.cotraverse Inline FunLike AllPhases]]
 
 deriveDistributiveTraversable :: Name -> Q [Dec]
 deriveDistributiveTraversable ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.DistributiveTraversable ty
-   sequence [instanceD (return []) instanceType [genCotraverseTraversable cs]]
+   (constraints, dec) <- genCotraverseTraversable cs
+   sequence [instanceD (cxt $ map pure constraints) instanceType [pure dec]]
 
 reifyConstructors :: Name -> Name -> Q (TypeQ, [Con])
 reifyConstructors cls ty = do
@@ -86,11 +105,13 @@
    putQ (Deriving tyConName tyVar)
    return (instanceType, cs)
 
-genFmap :: [Con] -> Q Dec
-genFmap cs = funD '(Rank2.<$>) (map genFmapClause cs)
+genFmap :: [Con] -> Q ([Type], Dec)
+genFmap cs = do (constraints, clauses) <- unzip <$> mapM genFmapClause cs
+                return (concat constraints, FunD '(Rank2.<$>) clauses)
 
-genAp :: [Con] -> Q Dec
-genAp [con] = funD '(Rank2.<*>) [genApClause False con]
+genAp :: [Con] -> Q ([Type], Dec)
+genAp [con] = do (constraints, clause) <- genApClause False con
+                 return (constraints, FunD '(Rank2.<*>) [clause])
 
 genLiftA2 :: [Con] -> Q Dec
 genLiftA2 [con] = funD 'Rank2.liftA2 [genLiftA2Clause False con]
@@ -98,8 +119,9 @@
 genLiftA3 :: [Con] -> Q Dec
 genLiftA3 [con] = funD 'Rank2.liftA3 [genLiftA3Clause False con]
 
-genApUnsafely :: [Con] -> Q Dec
-genApUnsafely cons = funD '(Rank2.<*>) (genApClause True <$> cons)
+genApUnsafely :: [Con] -> Q ([Type], Dec)
+genApUnsafely cons = do (constraints, clauses) <- unzip <$> mapM (genApClause True) cons
+                        return (concat constraints, FunD '(Rank2.<*>) clauses)
 
 genLiftA2Unsafely :: [Con] -> Q Dec
 genLiftA2Unsafely cons = funD 'Rank2.liftA2 (genLiftA2Clause True <$> cons)
@@ -107,49 +129,69 @@
 genLiftA3Unsafely :: [Con] -> Q Dec
 genLiftA3Unsafely cons = funD 'Rank2.liftA3 (genLiftA3Clause True <$> cons)
 
-genPure :: [Con] -> Q Dec
-genPure cs = funD 'Rank2.pure (map genPureClause cs)
+genPure :: [Con] -> Q ([Type], Dec)
+genPure cs = do (constraints, clauses) <- unzip <$> mapM genPureClause cs
+                return (concat constraints, FunD 'Rank2.pure clauses)
 
-genFoldMap :: [Con] -> Q Dec
-genFoldMap cs = funD 'Rank2.foldMap (map genFoldMapClause cs)
+genFoldMap :: [Con] -> Q ([Type], Dec)
+genFoldMap cs = do (constraints, clauses) <- unzip <$> mapM genFoldMapClause cs
+                   return (concat constraints, FunD 'Rank2.foldMap clauses)
 
-genTraverse :: [Con] -> Q Dec
-genTraverse cs = funD 'Rank2.traverse (map genTraverseClause cs)
+genTraverse :: [Con] -> Q ([Type], Dec)
+genTraverse cs = do (constraints, clauses) <- unzip <$> mapM genTraverseClause cs
+                    return (concat constraints, FunD 'Rank2.traverse clauses)
 
-genCotraverse :: [Con] -> Q Dec
-genCotraverse [con] = funD 'Rank2.cotraverse [genCotraverseClause con]
+genCotraverse :: [Con] -> Q ([Type], Dec)
+genCotraverse [con] = do (constraints, clause) <- genCotraverseClause con
+                         return (constraints, FunD 'Rank2.cotraverse [clause])
 
-genCotraverseTraversable :: [Con] -> Q Dec
-genCotraverseTraversable [con] = funD 'Rank2.cotraverseTraversable [genCotraverseTraversableClause con]
+genCotraverseTraversable :: [Con] -> Q ([Type], Dec)
+genCotraverseTraversable [con] = do (constraints, clause) <- genCotraverseTraversableClause con
+                                    return (constraints, FunD 'Rank2.cotraverseTraversable [clause])
 
-genFmapClause :: Con -> Q Clause
+genFmapClause :: Con -> Q ([Type], Clause)
 genFmapClause (NormalC name fieldTypes) = do
    f          <- newName "f"
    fieldNames <- replicateM (length fieldTypes) (newName "x")
-   let pats = [varP f, tildeP (conP name $ map varP fieldNames)]
-       body = normalB $ appsE $ conE name : zipWith newField fieldNames fieldTypes
-       newField :: Name -> BangType -> Q Exp
+   let pats = [varP f, conP name (map varP fieldNames)]
+       constraintsAndFields = zipWith newField fieldNames fieldTypes
+       newFields = map (snd <$>) constraintsAndFields
+       body = normalB $ appsE $ conE name : newFields
+       newField :: Name -> BangType -> Q ([Type], Exp)
        newField x (_, fieldType) = genFmapField (varE f) fieldType (varE x) id
-   clause pats body []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause pats body []
 genFmapClause (RecC name fields) = do
    f <- newName "f"
    x <- newName "x"
-   let body = normalB $ recConE name $ map newNamedField fields
-       newNamedField :: VarBangType -> Q (Name, Exp)
+   let body = normalB $ recConE name $ (snd <$>) <$> constraintsAndFields
+       constraintsAndFields = map newNamedField fields
+       newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
        newNamedField (fieldName, _, fieldType) =
-          fieldExp fieldName (genFmapField (varE f) fieldType (appE (varE fieldName) (varE x)) id)
-   clause [varP f, varP x] body []
+          ((,) fieldName <$>)
+          <$> genFmapField (varE f) fieldType (appE (varE fieldName) (varE x)) id
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP f, varP x] body []
+genFmapClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genFmapClause (NormalC name fieldTypes)
+genFmapClause (RecGadtC [name] fields _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genFmapClause (RecC name fields)
+genFmapClause (ForallC _vars _cxt con) = genFmapClause con
 
-genFmapField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
+genFmapField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
 genFmapField fun fieldType fieldAccess wrap = do
    Just (Deriving _ typeVar) <- getQ
    case fieldType of
-     AppT ty _  | ty == VarT typeVar -> appE (wrap fun) fieldAccess
-     AppT _ ty  | ty == VarT typeVar -> appE (wrap [| ($fun Rank2.<$>) |]) fieldAccess
+     AppT ty _  | ty == VarT typeVar -> (,) [] <$> appE (wrap fun) fieldAccess
+     AppT t1 t2 | t2 == VarT typeVar -> (,) (constrain ''Rank2.Functor t1) <$> appE (wrap [| ($fun Rank2.<$>) |]) fieldAccess
      AppT t1 t2 | t1 /= VarT typeVar -> genFmapField fun t2 fieldAccess (wrap . appE (varE '(<$>)))
      SigT ty _kind -> genFmapField fun ty fieldAccess wrap
      ParensT ty -> genFmapField fun ty fieldAccess wrap
-     _ -> fieldAccess
+     _ -> (,) [] <$> fieldAccess
 
 genLiftA2Clause :: Bool -> Con -> Q Clause
 genLiftA2Clause unsafely (NormalC name fieldTypes) = do
@@ -157,7 +199,7 @@
    fieldNames1 <- replicateM (length fieldTypes) (newName "x")
    fieldNames2 <- replicateM (length fieldTypes) (newName "y")
    let pats = [varP f,
-               (if unsafely then id else tildeP) (conP name $ map varP fieldNames1),
+               conP name (map varP fieldNames1),
                tildeP (conP name $ map varP fieldNames2)]
        body = normalB $ appsE $ conE name : zipWith newField (zip fieldNames1 fieldNames2) fieldTypes
        newField :: (Name, Name) -> BangType -> Q Exp
@@ -194,7 +236,7 @@
    fieldNames2 <- replicateM (length fieldTypes) (newName "y")
    fieldNames3 <- replicateM (length fieldTypes) (newName "z")
    let pats = [varP f,
-               (if unsafely then id else tildeP) (conP name $ map varP fieldNames1),
+               conP name (map varP fieldNames1),
                tildeP (conP name $ map varP fieldNames2), 
                tildeP (conP name $ map varP fieldNames3)]
        body = normalB $ appsE $ conE name : zipWith newField (zip3 fieldNames1 fieldNames2 fieldNames3) fieldTypes
@@ -229,159 +271,217 @@
      _ | unsafely -> [| error "Cannot apply liftA3 to field" |]
        | otherwise -> error ("Cannot apply liftA3 to field of type " <> show fieldType)
 
-genApClause :: Bool -> Con -> Q Clause
+genApClause :: Bool -> Con -> Q ([Type], Clause)
 genApClause unsafely (NormalC name fieldTypes) = do
    fieldNames1 <- replicateM (length fieldTypes) (newName "x")
    fieldNames2 <- replicateM (length fieldTypes) (newName "y")
-   let pats = [(if unsafely then id else tildeP) (conP name $ map varP fieldNames1),
+   let pats = [conP name (map varP fieldNames1),
                tildeP (conP name $ map varP fieldNames2)]
-       body = normalB $ appsE $ conE name : zipWith newField (zip fieldNames1 fieldNames2) fieldTypes
-       newField :: (Name, Name) -> BangType -> Q Exp
+       constraintsAndFields = zipWith newField (zip fieldNames1 fieldNames2) fieldTypes
+       newFields = map (snd <$>) constraintsAndFields
+       body = normalB $ appsE $ conE name : newFields
+       newField :: (Name, Name) -> BangType -> Q ([Type], Exp)
        newField (x, y) (_, fieldType) = genApField unsafely fieldType (varE x) (varE y) id
-   clause pats body []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause pats body []
 genApClause unsafely (RecC name fields) = do
    x <- newName "x"
    y <- newName "y"
-   let body = normalB $ recConE name $ map newNamedField fields
-       newNamedField :: VarBangType -> Q (Name, Exp)
+   let body = normalB $ recConE name $ (snd <$>) <$> constraintsAndFields
+       constraintsAndFields = map newNamedField fields
+       newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
        newNamedField (fieldName, _, fieldType) =
-          fieldExp fieldName (genApField unsafely fieldType (getFieldOf x) (getFieldOf y) id)
+          ((,) fieldName <$>) <$> genApField unsafely fieldType (getFieldOf x) (getFieldOf y) id
           where getFieldOf = appE (varE fieldName) . varE
-   clause [varP x, varP y] body []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP x, varP y] body []
+genApClause unsafely (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genApClause unsafely (NormalC name fieldTypes)
+genApClause unsafely (RecGadtC [name] fields _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genApClause unsafely (RecC name fields)
+genApClause unsafely (ForallC _vars _cxt con) = genApClause unsafely con
 
-genApField :: Bool -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
+genApField :: Bool -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
 genApField unsafely fieldType field1Access field2Access wrap = do
    Just (Deriving _ typeVar) <- getQ
    case fieldType of
-     AppT ty _ | ty == VarT typeVar -> [| $(wrap (varE 'Rank2.apply)) $(field1Access) $(field2Access) |]
-     AppT _ ty | ty == VarT typeVar -> [| $(wrap (varE 'Rank2.ap)) $(field1Access) $(field2Access) |]
+     AppT ty _ | ty == VarT typeVar -> (,) [] <$> [| $(wrap (varE 'Rank2.apply)) $(field1Access) $(field2Access) |]
+     AppT t1 t2 | t2 == VarT typeVar ->
+                  (,) (constrain ''Rank2.Apply t1) <$> [| $(wrap (varE 'Rank2.ap)) $(field1Access) $(field2Access) |]
      AppT t1 t2 | t1 /= VarT typeVar -> genApField unsafely t2 field1Access field2Access (appE (varE 'liftA2) . wrap)
      SigT ty _kind -> genApField unsafely ty field1Access field2Access wrap
      ParensT ty -> genApField unsafely ty field1Access field2Access wrap
-     _ | unsafely -> [| error ("Cannot apply ap to field" <> $(pure $ LitE $ StringL $ show fieldType)) |]
+     _ | unsafely -> (,) [] <$> [| error ("Cannot apply ap to field" <> $(pure $ LitE $ StringL $ show fieldType)) |]
        | otherwise -> error ("Cannot apply ap to field of type " <> show fieldType)
 
-genPureClause :: Con -> Q Clause
+genPureClause :: Con -> Q ([Type], Clause)
 genPureClause (NormalC name fieldTypes) = do
    argName <- newName "f"
-   let body = normalB $ appsE $ conE name : map newField fieldTypes
-       newField :: BangType -> Q Exp
+   let body = normalB $ appsE $ conE name : ((snd <$>) <$> constraintsAndFields)
+       constraintsAndFields = map newField fieldTypes
+       newField :: BangType -> Q ([Type], Exp)
        newField (_, fieldType) = genPureField fieldType (varE argName) id
-   clause [varP argName] body []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP argName] body []
 genPureClause (RecC name fields) = do
    argName <- newName "f"
-   let body = normalB $ recConE name $ map newNamedField fields
-       newNamedField :: VarBangType -> Q (Name, Exp)
-       newNamedField (fieldName, _, fieldType) = fieldExp fieldName (genPureField fieldType (varE argName) id)
-   clause [varP argName] body []
+   let body = normalB $ recConE name $ (snd <$>) <$> constraintsAndFields
+       constraintsAndFields = map newNamedField fields
+       newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
+       newNamedField (fieldName, _, fieldType) = ((,) fieldName <$>) <$> genPureField fieldType (varE argName) id
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP argName] body []
 
-genPureField :: Type -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
+genPureField :: Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
 genPureField fieldType pureValue wrap = do
    Just (Deriving _ typeVar) <- getQ
    case fieldType of
-     AppT ty _ | ty == VarT typeVar -> wrap pureValue
-     AppT _ ty | ty == VarT typeVar -> wrap (appE (varE 'Rank2.pure) pureValue)
+     AppT ty _ | ty == VarT typeVar -> (,) [] <$> wrap pureValue
+     AppT t1 t2 | t2 == VarT typeVar -> (,) (constrain ''Rank2.Applicative t1) <$> wrap (appE (varE 'Rank2.pure) pureValue)
      AppT t1 t2 | t1 /= VarT typeVar -> genPureField t2 pureValue (wrap . appE (varE 'pure))
      SigT ty _kind -> genPureField ty pureValue wrap
      ParensT ty -> genPureField ty pureValue wrap
      _ -> error ("Cannot create a pure field of type " <> show fieldType)
 
-genFoldMapClause :: Con -> Q Clause
+genFoldMapClause :: Con -> Q ([Type], Clause)
 genFoldMapClause (NormalC name fieldTypes) = do
    f          <- newName "f"
    fieldNames <- replicateM (length fieldTypes) (newName "x")
-   let pats = [varP f, tildeP (conP name $ map varP fieldNames)]
+   let pats = [varP f, conP name (map varP fieldNames)]
+       constraintsAndFields = zipWith newField fieldNames fieldTypes
        body | null fieldNames = [| mempty |]
-            | otherwise = foldr1 append $ zipWith newField fieldNames fieldTypes
+            | otherwise = foldr1 append $ (snd <$>) <$> constraintsAndFields
        append a b = [| $(a) <> $(b) |]
-       newField :: Name -> BangType -> Q Exp
+       newField :: Name -> BangType -> Q ([Type], Exp)
        newField x (_, fieldType) = genFoldMapField f fieldType (varE x) id
-   clause pats (normalB body) []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause pats (normalB body) []
 genFoldMapClause (RecC _name fields) = do
    f <- newName "f"
    x <- newName "x"
    let body | null fields = [| mempty |]
-            | otherwise = foldr1 append $ map newField fields
+            | otherwise = foldr1 append $ (snd <$>) <$> constraintsAndFields
+       constraintsAndFields = map newField fields
        append a b = [| $(a) <> $(b) |]
-       newField :: VarBangType -> Q Exp
+       newField :: VarBangType -> Q ([Type], Exp)
        newField (fieldName, _, fieldType) = genFoldMapField f fieldType (appE (varE fieldName) (varE x)) id
-   clause [varP f, varP x] (normalB body) []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP f, varP x] (normalB body) []
+genFoldMapClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genFoldMapClause (NormalC name fieldTypes)
+genFoldMapClause (RecGadtC [name] fields _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genFoldMapClause (RecC name fields)
+genFoldMapClause (ForallC _vars _cxt con) = genFoldMapClause con
 
-genFoldMapField :: Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
+genFoldMapField :: Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
 genFoldMapField funcName fieldType fieldAccess wrap = do
    Just (Deriving _ typeVar) <- getQ
    case fieldType of
-     AppT ty _ | ty == VarT typeVar -> appE (wrap $ varE funcName) fieldAccess
-     AppT _ ty | ty == VarT typeVar -> appE (wrap $ appE (varE 'Rank2.foldMap) (varE funcName)) fieldAccess
+     AppT ty _ | ty == VarT typeVar -> (,) [] <$> appE (wrap $ varE funcName) fieldAccess
+     AppT t1 t2 | t2 == VarT typeVar ->
+                  (,) (constrain ''Rank2.Foldable t1) <$> appE (wrap $ appE (varE 'Rank2.foldMap) (varE funcName)) fieldAccess
      AppT t1 t2 | t1 /= VarT typeVar -> genFoldMapField funcName t2 fieldAccess (wrap . appE (varE 'foldMap))
      SigT ty _kind -> genFoldMapField funcName ty fieldAccess wrap
      ParensT ty -> genFoldMapField funcName ty fieldAccess wrap
-     _ -> [| mempty |]
+     _ -> (,) [] <$> [| mempty |]
 
-genTraverseClause :: Con -> Q Clause
+genTraverseClause :: Con -> Q ([Type], Clause)
 genTraverseClause (NormalC name []) =
-   clause [wildP, wildP] (normalB [| pure $(conE name) |]) []
+   (,) [] <$> clause [wildP, wildP] (normalB [| pure $(conE name) |]) []
 genTraverseClause (NormalC name fieldTypes) = do
    f          <- newName "f"
    fieldNames <- replicateM (length fieldTypes) (newName "x")
-   let pats = [varP f, tildeP (conP name $ map varP fieldNames)]
-       body = normalB $ fst $ foldl apply (conE name, False) $ zipWith newField fieldNames fieldTypes
+   let pats = [varP f, conP name (map varP fieldNames)]
+       constraintsAndFields = zipWith newField fieldNames fieldTypes
+       newFields = map (snd <$>) constraintsAndFields
+       body = normalB $ fst $ foldl apply (conE name, False) newFields
        apply (a, False) b = ([| $(a) <$> $(b) |], True)
        apply (a, True) b = ([| $(a) <*> $(b) |], True)
-       newField :: Name -> BangType -> Q Exp
+       newField :: Name -> BangType -> Q ([Type], Exp)
        newField x (_, fieldType) = genTraverseField (varE f) fieldType (varE x) id
-   clause pats body []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause pats body []
 genTraverseClause (RecC name fields) = do
    f <- newName "f"
    x <- newName "x"
-   let body = normalB $ fst $ foldl apply (conE name, False) $ map newField fields
+   let constraintsAndFields = map newField fields
+       body = normalB $ fst $ foldl apply (conE name, False) $ (snd <$>) <$> constraintsAndFields
        apply (a, False) b = ([| $(a) <$> $(b) |], True)
        apply (a, True) b = ([| $(a) <*> $(b) |], True)
-       newField :: VarBangType -> Q Exp
+       newField :: VarBangType -> Q ([Type], Exp)
        newField (fieldName, _, fieldType) = genTraverseField (varE f) fieldType (appE (varE fieldName) (varE x)) id
-   clause [varP f, varP x] body []
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP f, varP x] body []
+genTraverseClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genTraverseClause (NormalC name fieldTypes)
+genTraverseClause (RecGadtC [name] fields _resultType@(AppT _ (VarT tyVar))) =
+   do Just (Deriving tyConName _tyVar) <- getQ
+      putQ (Deriving tyConName tyVar)
+      genTraverseClause (RecC name fields)
+genTraverseClause (ForallC _vars _cxt con) = genTraverseClause con
 
-genTraverseField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
+genTraverseField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
 genTraverseField fun fieldType fieldAccess wrap = do
    Just (Deriving _ typeVar) <- getQ
    case fieldType of
-     AppT ty _ | ty == VarT typeVar -> appE (wrap fun) fieldAccess
-     AppT _ ty | ty == VarT typeVar -> appE (wrap [| Rank2.traverse $fun |]) fieldAccess
+     AppT ty _ | ty == VarT typeVar -> (,) [] <$> appE (wrap fun) fieldAccess
+     AppT t1 t2 | t2 == VarT typeVar ->
+                  (,) (constrain ''Rank2.Traversable t1) <$> appE (wrap [| Rank2.traverse $fun |]) fieldAccess
      AppT t1 t2 | t1 /= VarT typeVar -> genTraverseField fun t2 fieldAccess (wrap . appE (varE 'traverse))
      SigT ty _kind -> genTraverseField fun ty fieldAccess wrap
      ParensT ty -> genTraverseField fun ty fieldAccess wrap
-     _ -> [| pure $fieldAccess |]
+     _ -> (,) [] <$> [| pure $fieldAccess |]
 
-genCotraverseClause :: Con -> Q Clause
+genCotraverseClause :: Con -> Q ([Type], Clause)
 genCotraverseClause (NormalC name []) = genCotraverseClause (RecC name [])
 genCotraverseClause (RecC name fields) = do
    withName <- newName "w"
    argName <- newName "f"
-   let body = normalB $ recConE name $ map newNamedField fields
-       newNamedField :: VarBangType -> Q (Name, Exp)
+   let constraintsAndFields = map newNamedField fields
+       body = normalB $ recConE name $ (snd <$>) <$> constraintsAndFields
+       newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
        newNamedField (fieldName, _, fieldType) =
-          fieldExp fieldName (genCotraverseField (varE 'Rank2.cotraverse) (varE withName) fieldType
-                              [| $(varE fieldName) <$> $(varE argName) |] id)
-   clause [varP withName, varP argName] body []
+          ((,) fieldName <$>) <$> (genCotraverseField ''Rank2.Distributive (varE 'Rank2.cotraverse) (varE withName)
+                                   fieldType [| $(varE fieldName) <$> $(varE argName) |] id)
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP withName, varP argName] body []
 
-genCotraverseTraversableClause :: Con -> Q Clause
+genCotraverseTraversableClause :: Con -> Q ([Type], Clause)
 genCotraverseTraversableClause (NormalC name []) = genCotraverseTraversableClause (RecC name [])
 genCotraverseTraversableClause (RecC name fields) = do
    withName <- newName "w"
    argName <- newName "f"
-   let body = normalB $ recConE name $ map newNamedField fields
-       newNamedField :: VarBangType -> Q (Name, Exp)
+   let constraintsAndFields = map newNamedField fields
+       body = normalB $ recConE name $ (snd <$>) <$> constraintsAndFields
+       newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
        newNamedField (fieldName, _, fieldType) =
-          fieldExp fieldName (genCotraverseField (varE 'Rank2.cotraverseTraversable) (varE withName) fieldType
-                              [| $(varE fieldName) <$> $(varE argName) |] id)
-   clause [varP withName, varP argName] body []
+          ((,) fieldName <$>) <$> (genCotraverseField ''Rank2.DistributiveTraversable
+                                   (varE 'Rank2.cotraverseTraversable) (varE withName) fieldType
+                                   [| $(varE fieldName) <$> $(varE argName) |] id)
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> clause [varP withName, varP argName] body []
 
-genCotraverseField :: Q Exp -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
-genCotraverseField method fun fieldType fieldAccess wrap = do
+genCotraverseField :: Name -> Q Exp -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
+genCotraverseField className method fun fieldType fieldAccess wrap = do
    Just (Deriving _ typeVar) <- getQ
    case fieldType of
-     AppT ty _ | ty == VarT typeVar -> appE (wrap fun) fieldAccess
-     AppT _ ty | ty == VarT typeVar -> appE (wrap $ appE method fun) fieldAccess
-     AppT t1 t2 | t1 /= VarT typeVar -> genCotraverseField method fun t2 fieldAccess (wrap . appE (varE 'cotraverse))
-     SigT ty _kind -> genCotraverseField method fun ty fieldAccess wrap
-     ParensT ty -> genCotraverseField method fun ty fieldAccess wrap
+     AppT ty _ | ty == VarT typeVar -> (,) [] <$> appE (wrap fun) fieldAccess
+     AppT t1 t2 | t2 == VarT typeVar -> (,) (constrain className t1) <$> appE (wrap $ appE method fun) fieldAccess
+     AppT t1 t2 | t1 /= VarT typeVar ->
+                  genCotraverseField className method fun t2 fieldAccess (wrap . appE (varE 'cotraverse))
+     SigT ty _kind -> genCotraverseField className method fun ty fieldAccess wrap
+     ParensT ty -> genCotraverseField className method fun ty fieldAccess wrap
+
+constrain :: Name -> Type -> [Type]
+constrain _ ConT{} = []
+constrain cls t = [ConT cls `AppT` t]