diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,10 @@
+Version 1.4.5
+---------------
+* Added the `Logistic` type class, `getters` and `setters`
+* Added `Rank2.TH.deriveLogistic`, included it in `deriveAll`
+* Compiling with GHC 9.4.2
+* Forward compatibility with `TypeFamilies`
+
 Version 1.4.4
 ---------------
 * Tested with GHC 9.2.1, incremented the upper `template-haskell` dependency bound
diff --git a/rank2classes.cabal b/rank2classes.cabal
--- a/rank2classes.cabal
+++ b/rank2classes.cabal
@@ -1,5 +1,5 @@
 name:                rank2classes
-version:             1.4.4
+version:             1.4.5
 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
@@ -40,10 +40,11 @@
   ghc-options:         -Wall
   build-depends:       base >=4.10 && <5,
                        transformers >= 0.5 && < 0.7,
-                       distributive < 0.7
+                       distributive < 0.7,
+                       data-functor-logistic < 0.1
 
   if flag(use-template-haskell)
-    build-depends: template-haskell >= 2.11 && < 2.19
+    build-depends: template-haskell >= 2.11 && < 2.20
     exposed-modules: Rank2.TH
 
 test-suite doctests
diff --git a/src/Rank2.hs b/src/Rank2.hs
--- a/src/Rank2.hs
+++ b/src/Rank2.hs
@@ -8,16 +8,18 @@
 {-# LANGUAGE DefaultSignatures, InstanceSigs, KindSignatures, PolyKinds, Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
 {-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE TypeApplications #-}
 module Rank2 (
 -- * Rank 2 classes
    Functor(..), Apply(..), Applicative(..),
-   Foldable(..), Traversable(..), Distributive(..), DistributiveTraversable(..), distributeJoin,
+   Foldable(..), Traversable(..), Distributive(..), DistributiveTraversable(..), Logistic(..), distributeJoin,
 -- * Rank 2 data types
    Compose(..), Empty(..), Only(..), Flip(..), Identity(..), Product(..), Sum(..), Arrow(..), type (~>),
 -- * Method synonyms and helper functions
    ($), fst, snd, ap, fmap, liftA4, liftA5,
    fmapTraverse, liftA2Traverse1, liftA2Traverse2, liftA2TraverseBoth,
-   distributeWith, distributeWithTraversable)
+   distributeWith, distributeWithTraversable,
+   getters, setters)
 where
 
 import qualified Control.Applicative as Rank1
@@ -25,6 +27,8 @@
 import qualified Data.Foldable as Rank1
 import qualified Data.Traversable as Rank1
 import qualified Data.Functor.Compose as Rank1
+import qualified Data.Functor.Contravariant as Rank1
+import qualified Data.Functor.Logistic as Rank1
 import qualified Data.Distributive as Rank1
 import Data.Coerce (coerce)
 import Data.Semigroup (Semigroup(..))
@@ -32,6 +36,7 @@
 import Data.Functor.Const (Const(..))
 import Data.Functor.Product (Product(Pair))
 import Data.Functor.Sum (Sum(InL, InR))
+import Data.Kind (Type)
 import Data.Proxy (Proxy(..))
 import qualified GHC.Generics as Generics
 
@@ -69,7 +74,6 @@
    sequence :: Rank1.Applicative m => g (Rank1.Compose m p) -> m (g p)
    traverse f = sequence . fmap (Rank1.Compose . f)
    sequence = traverse Rank1.getCompose
-
 -- | Wrapper for functions that map the argument constructor type
 newtype Arrow p q a = Arrow{apply :: p a -> q a}
 
@@ -113,17 +117,17 @@
 -- | Equivalent of 'Rank1.Distributive' for rank 2 data types
 class DistributiveTraversable g => Distributive g where
    {-# MINIMAL cotraverse|distribute #-}
-   collect :: Rank1.Functor f1 => (a -> g f2) -> f1 a -> g (Rank1.Compose f1 f2)
-   distribute :: Rank1.Functor f1 => f1 (g f2) -> g (Rank1.Compose f1 f2)
+   collect :: Rank1.Functor p => (a -> g q) -> p a -> g (Rank1.Compose p q)
+   distribute :: Rank1.Functor p => p (g q) -> g (Rank1.Compose p q)
    -- | Dual of 'traverse', equivalent of 'Rank1.cotraverse' for rank 2 data types 
    cotraverse :: Rank1.Functor m => (forall a. m (p a) -> q a) -> m (g p) -> g q
 
    collect f = distribute . Rank1.fmap f
    distribute = cotraverse Rank1.Compose
-   cotraverse f = (fmap (f . Rank1.getCompose)) . distribute
+   cotraverse f = fmap (f . Rank1.getCompose) . distribute
 
 -- | A weaker 'Distributive' that requires 'Rank1.Traversable' to use, not just a 'Rank1.Functor'.
-class Functor g => DistributiveTraversable (g :: (k -> *) -> *) where
+class Functor g => DistributiveTraversable (g :: (k -> Type) -> Type) where
    collectTraversable :: Rank1.Traversable f1 => (a -> g f2) -> f1 a -> g (Rank1.Compose f1 f2)   
    distributeTraversable :: Rank1.Traversable f1 => f1 (g f2) -> g (Rank1.Compose f1 f2)
    cotraverseTraversable :: Rank1.Traversable f1 => (forall x. f1 (f2 x) -> f x) -> f1 (g f2) -> g f
@@ -135,6 +139,10 @@
                                     (forall a. m (p a) -> q a) -> m (g p) -> g q
    cotraverseTraversable = cotraverse
 
+-- | Equivalent of 'Rank1.Logistic' for rank 2 data types
+class Functor g => Logistic g where
+   deliver :: Rank1.Contravariant p => p (g q -> g q) -> g (Rank1.Compose p (q ~> q))
+
 -- | A variant of 'distribute' convenient with 'Rank1.Monad' instances
 distributeJoin :: (Distributive g, Rank1.Monad f) => f (g f) -> g f
 distributeJoin = cotraverse Rank1.join
@@ -154,11 +162,21 @@
 liftA2Traverse2 f x y = liftA2 (\x' y' -> f x' (Rank1.getCompose y')) x (distributeTraversable y)
 
 -- | Like 'liftA2', but traverses over both its arguments
-liftA2TraverseBoth :: (Apply g, DistributiveTraversable g, Rank1.Traversable f1, Rank1.Traversable f2) =>
+liftA2TraverseBoth :: forall f1 f2 g t u v.
+                      (Apply g, DistributiveTraversable g, Rank1.Traversable f1, Rank1.Traversable f2) =>
                       (forall a. f1 (t a) -> f2 (u a) -> v a) -> f1 (g t) -> f2 (g u) -> g v
 liftA2TraverseBoth f x y = liftA2 applyCompose (distributeTraversable x) (distributeTraversable y)
-   where applyCompose x' y' = f (Rank1.getCompose x') (Rank1.getCompose y')
+   where applyCompose :: forall a. Rank1.Compose f1 t a -> Rank1.Compose f2 u a -> v a
+         applyCompose x' y' = f (Rank1.getCompose x') (Rank1.getCompose y')
 
+-- | Enumerate getters for each element
+getters :: Distributive g => g (Rank1.Compose ((->) (g f)) f)
+getters = distribute id
+
+-- | Enumerate setters for each element
+setters :: Logistic g => g ((f ~> f) ~> Const (g f -> g f))
+setters = Arrow . (Const .) . Rank1.getOp . Rank1.getCompose <$> deliver (Rank1.Op id)
+
 {-# DEPRECATED distributeWith "Use cotraverse instead." #-}
 -- | Synonym for 'cotraverse'
 distributeWith :: (Distributive g, Rank1.Functor f) => (forall i. f (a i) -> b i) -> f (g a) -> g b
@@ -194,7 +212,7 @@
 
 instance Monoid (g (f a)) => Monoid (Flip g a f) where
    mempty = Flip mempty
-   Flip x `mappend` Flip y = Flip (x `mappend` y)
+   mappend = (<>)
 
 instance Rank1.Functor g => Rank2.Functor (Flip g a) where
    f <$> Flip g = Flip (f Rank1.<$> g)
@@ -498,3 +516,49 @@
    cotraverse w f = Generics.Rec1 (cotraverse w (Rank1.fmap Generics.unRec1 f))
 instance (Distributive f, Distributive g) => Distributive ((Generics.:*:) f g) where
    cotraverse w f = cotraverse w (Rank1.fmap (\(a Generics.:*: _) -> a) f) Generics.:*: cotraverse w (Rank1.fmap (\(_ Generics.:*: b) -> b) f)
+
+instance Logistic Empty where
+   deliver _ = Empty
+
+instance Logistic Proxy where
+   deliver _ = Proxy
+
+instance Logistic (Only x) where
+   deliver f = Only (Rank1.Compose (Rank1.contramap coerce f))
+
+instance Logistic g => Logistic (Identity g) where
+   deliver f = Identity (deliver (Rank1.contramap coerce f))
+
+instance (Logistic g, Rank1.Logistic p) => Logistic (Compose g p) where
+   deliver = Compose
+             . fmap (inRank1Compose (Rank1.fmap (Rank1.Compose . Rank1.contramap apply)
+                                     . Rank1.deliver
+                                     . Rank1.contramap (Arrow . inRank1Compose)))
+             . deliver
+             . Rank1.contramap inCompose
+
+inCompose :: (g (Rank1.Compose p q) -> g' (Rank1.Compose p' q')) -> Compose g p q -> Compose g' p' q'
+inCompose f = Compose . f . getCompose
+
+inRank1Compose :: (p (q a) -> p' (q' a')) -> Rank1.Compose p q a -> Rank1.Compose p' q' a'
+inRank1Compose f = Rank1.Compose . f . Rank1.getCompose
+
+instance (Logistic g, Logistic h) => Logistic (Product g h) where
+   deliver f = Pair (deliver (Rank1.contramap first f)) (deliver (Rank1.contramap second f))
+
+first :: (g p -> g' p) -> Product g h p -> Product g' h p
+first f (Pair g h) = Pair (f g) h
+
+second :: (h p -> h' p) -> Product g h p -> Product g h' p
+second f (Pair g h) = Pair g (f h)
+
+instance Logistic f => Logistic (Generics.M1 i c f) where
+   deliver f = Generics.M1 (deliver (Rank1.contramap (\f'-> Generics.M1 . f' . Generics.unM1) f))
+
+instance Logistic f => Logistic (Generics.Rec1 f) where
+   deliver f = Generics.Rec1 (deliver (Rank1.contramap (\f'-> Generics.Rec1 . f' . Generics.unRec1) f))
+
+instance (Logistic f, Logistic g) => Logistic ((Generics.:*:) f g) where
+   deliver f = deliver (Rank1.contramap (\f' (a Generics.:*: b) -> f' a Generics.:*: b) f)
+               Generics.:*:
+               deliver (Rank1.contramap (\f' (a Generics.:*: b) -> a Generics.:*: f' b) f)
diff --git a/src/Rank2/TH.hs b/src/Rank2/TH.hs
--- a/src/Rank2/TH.hs
+++ b/src/Rank2/TH.hs
@@ -12,15 +12,22 @@
 -- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial
 
 module Rank2.TH (deriveAll, deriveFunctor, deriveApply, unsafeDeriveApply, deriveApplicative,
-                 deriveFoldable, deriveTraversable, deriveDistributive, deriveDistributiveTraversable)
+                 deriveFoldable, deriveTraversable,
+                 deriveDistributive, deriveDistributiveTraversable, deriveLogistic)
 where
 
 import Control.Applicative (liftA2, liftA3)
 import Control.Monad (replicateM)
 import Data.Distributive (cotraverse)
+import Data.Functor.Compose (Compose (Compose))
+import Data.Functor.Contravariant (contramap)
+import Data.Functor.Logistic (deliver)
 import Data.Monoid ((<>))
-import Language.Haskell.TH
-import Language.Haskell.TH.Syntax (BangType, VarBangType, getQ, putQ)
+import qualified Language.Haskell.TH as TH
+import Language.Haskell.TH (Q, TypeQ, Name, TyVarBndr(KindedTV, PlainTV), Clause, Dec(..), Con(..), Type(..), Exp(..),
+                            Inline(Inlinable, Inline), RuleMatch(FunLike), Phases(AllPhases),
+                            appE, conE, conP, instanceD, varE, varP, normalB, pragInlD, recConE, recUpdE, wildP)
+import Language.Haskell.TH.Syntax (BangType, VarBangType, Info(TyConI), getQ, putQ, newName)
 
 import qualified Rank2
 
@@ -28,21 +35,22 @@
 
 deriveAll :: Name -> Q [Dec]
 deriveAll ty = foldr f (pure []) [deriveFunctor, deriveApply, deriveApplicative,
-                                  deriveFoldable, deriveTraversable, deriveDistributive, deriveDistributiveTraversable]
+                                  deriveFoldable, deriveTraversable,
+                                  deriveDistributive, deriveDistributiveTraversable, deriveLogistic]
    where f derive rest = (<>) <$> derive ty <*> rest
 
 deriveFunctor :: Name -> Q [Dec]
 deriveFunctor ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Functor ty
    (constraints, dec) <- genFmap cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType
+   sequence [instanceD (TH.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
    (constraints, dec) <- genAp cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType
+   sequence [instanceD (TH.cxt $ map pure constraints) instanceType
              [pure dec, genLiftA2 cs, genLiftA3 cs,
               pragInlD '(Rank2.<*>) Inlinable FunLike AllPhases,
               pragInlD 'Rank2.liftA2 Inlinable FunLike AllPhases]]
@@ -52,7 +60,7 @@
 unsafeDeriveApply ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Apply ty
    (constraints, dec) <- genApUnsafely cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType
+   sequence [instanceD (TH.cxt $ map pure constraints) instanceType
              [pure dec, genLiftA2Unsafely cs, genLiftA3Unsafely cs,
               pragInlD '(Rank2.<*>) Inlinable FunLike AllPhases,
               pragInlD 'Rank2.liftA2 Inlinable FunLike AllPhases]]
@@ -61,39 +69,46 @@
 deriveApplicative ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Applicative ty
    (constraints, dec) <- genPure cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType
+   sequence [instanceD (TH.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
    (constraints, dec) <- genFoldMap cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType
+   sequence [instanceD (TH.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
    (constraints, dec) <- genTraverse cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType
+   sequence [instanceD (TH.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
    (constraints, dec) <- genCotraverse cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType
+   sequence [instanceD (TH.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
    (constraints, dec) <- genCotraverseTraversable cs
-   sequence [instanceD (cxt $ map pure constraints) instanceType [pure dec]]
+   sequence [instanceD (TH.cxt $ map pure constraints) instanceType [pure dec]]
 
+deriveLogistic :: Name -> Q [Dec]
+deriveLogistic ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.Logistic ty
+   (constraints, dec) <- genDeliver cs
+   sequence [instanceD (TH.cxt $ map pure constraints) instanceType
+             [pure dec, pragInlD 'Rank2.deliver Inline FunLike AllPhases]]
+
 reifyConstructors :: Name -> Name -> Q (TypeQ, [Con])
 reifyConstructors cls ty = do
-   (TyConI tyCon) <- reify ty
+   (TyConI tyCon) <- TH.reify ty
    (tyConName, tyVars, _kind, cs) <- case tyCon of
       DataD _ nm tyVars kind cs _   -> return (nm, tyVars, kind, cs)
       NewtypeD _ nm tyVars kind c _ -> return (nm, tyVars, kind, [c])
@@ -101,14 +116,14 @@
  
 #if MIN_VERSION_template_haskell(2,17,0)
    let (KindedTV tyVar () (AppT (AppT ArrowT _) StarT)) = last tyVars
-       instanceType           = conT cls `appT` foldl apply (conT tyConName) (init tyVars)
-       apply t (PlainTV name _)    = appT t (varT name)
-       apply t (KindedTV name _ _) = appT t (varT name)
+       instanceType           = TH.conT cls `TH.appT` foldl apply (TH.conT tyConName) (init tyVars)
+       apply t (PlainTV name _)    = TH.appT t (TH.varT name)
+       apply t (KindedTV name _ _) = TH.appT t (TH.varT name)
 #else
    let (KindedTV tyVar (AppT (AppT ArrowT _) StarT)) = last tyVars
-       instanceType           = conT cls `appT` foldl apply (conT tyConName) (init tyVars)
-       apply t (PlainTV name)    = appT t (varT name)
-       apply t (KindedTV name _) = appT t (varT name)
+       instanceType           = TH.conT cls `TH.appT` foldl apply (TH.conT tyConName) (init tyVars)
+       apply t (PlainTV name)    = TH.appT t (TH.varT name)
+       apply t (KindedTV name _) = TH.appT t (TH.varT name)
 #endif
  
    putQ (Deriving tyConName tyVar)
@@ -123,20 +138,20 @@
                  return (constraints, FunD '(Rank2.<*>) [clause])
 
 genLiftA2 :: [Con] -> Q Dec
-genLiftA2 [con] = funD 'Rank2.liftA2 [genLiftA2Clause False con]
+genLiftA2 [con] = TH.funD 'Rank2.liftA2 [genLiftA2Clause False con]
 
 genLiftA3 :: [Con] -> Q Dec
-genLiftA3 [con] = funD 'Rank2.liftA3 [genLiftA3Clause False con]
+genLiftA3 [con] = TH.funD 'Rank2.liftA3 [genLiftA3Clause False con]
 
 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)
+genLiftA2Unsafely cons = TH.funD 'Rank2.liftA2 (genLiftA2Clause True <$> cons)
 
 genLiftA3Unsafely :: [Con] -> Q Dec
-genLiftA3Unsafely cons = funD 'Rank2.liftA3 (genLiftA3Clause True <$> cons)
+genLiftA3Unsafely cons = TH.funD 'Rank2.liftA3 (genLiftA3Clause True <$> cons)
 
 genPure :: [Con] -> Q ([Type], Dec)
 genPure cs = do (constraints, clauses) <- unzip <$> mapM genPureClause cs
@@ -158,6 +173,10 @@
 genCotraverseTraversable [con] = do (constraints, clause) <- genCotraverseTraversableClause con
                                     return (constraints, FunD 'Rank2.cotraverseTraversable [clause])
 
+genDeliver :: [Con] -> Q ([Type], Dec)
+genDeliver [con] = do (constraints, clause) <- genDeliverClause con
+                      return (constraints, FunD 'Rank2.deliver [clause])
+
 genFmapClause :: Con -> Q ([Type], Clause)
 genFmapClause (NormalC name fieldTypes) = do
    f          <- newName "f"
@@ -165,11 +184,11 @@
    let pats = [varP f, conP name (map varP fieldNames)]
        constraintsAndFields = zipWith newField fieldNames fieldTypes
        newFields = map (snd <$>) constraintsAndFields
-       body = normalB $ appsE $ conE name : newFields
+       body = normalB $ TH.appsE $ conE name : newFields
        newField :: Name -> BangType -> Q ([Type], Exp)
        newField x (_, fieldType) = genFmapField (varE f) fieldType (varE x) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause pats body []
+   (,) constraints <$> TH.clause pats body []
 genFmapClause (RecC name fields) = do
    f <- newName "f"
    x <- newName "x"
@@ -180,7 +199,7 @@
           ((,) fieldName <$>)
           <$> genFmapField (varE f) fieldType (appE (varE fieldName) (varE x)) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause [varP f, x `asP` recP name []] body []
+   (,) constraints <$> TH.clause [varP f, x `TH.asP` TH.recP name []] body []
 genFmapClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
    do Just (Deriving tyConName _tyVar) <- getQ
       putQ (Deriving tyConName tyVar)
@@ -209,10 +228,10 @@
    y <- newName "y"
    fieldNames2 <- replicateM (length fieldTypes) (newName "y")
    let pats = [varP f, conP name (map varP fieldNames1), varP y]
-       body = normalB $ appsE $ conE name : zipWith newField (zip fieldNames1 fieldNames2) fieldTypes
+       body = normalB $ TH.appsE $ conE name : zipWith newField (zip fieldNames1 fieldNames2) fieldTypes
        newField :: (Name, Name) -> BangType -> Q Exp
        newField (x, y) (_, fieldType) = genLiftA2Field unsafely (varE f) fieldType (varE x) (varE y) id
-   clause pats body [valD (conP name $ map varP fieldNames2) (normalB $ varE y) []]
+   TH.clause pats body [TH.valD (conP name $ map varP fieldNames2) (normalB $ varE y) []]
 genLiftA2Clause unsafely (RecC name fields) = do
    f <- newName "f"
    x <- newName "x"
@@ -220,9 +239,9 @@
    let body = normalB $ recConE name $ map newNamedField fields
        newNamedField :: VarBangType -> Q (Name, Exp)
        newNamedField (fieldName, _, fieldType) =
-          fieldExp fieldName (genLiftA2Field unsafely (varE f) fieldType (getFieldOf x) (getFieldOf y) id)
+          TH.fieldExp fieldName (genLiftA2Field unsafely (varE f) fieldType (getFieldOf x) (getFieldOf y) id)
           where getFieldOf = appE (varE fieldName) . varE
-   clause [varP f, x `asP` recP name [], varP y] body []
+   TH.clause [varP f, x `TH.asP` TH.recP name [], varP y] body []
 genLiftA2Clause unsafely (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
    do Just (Deriving tyConName _tyVar) <- getQ
       putQ (Deriving tyConName tyVar)
@@ -255,11 +274,11 @@
    fieldNames2 <- replicateM (length fieldTypes) (newName "y")
    fieldNames3 <- replicateM (length fieldTypes) (newName "z")
    let pats = [varP f, conP name (map varP fieldNames1), varP y, varP z]
-       body = normalB $ appsE $ conE name : zipWith newField (zip3 fieldNames1 fieldNames2 fieldNames3) fieldTypes
+       body = normalB $ TH.appsE $ conE name : zipWith newField (zip3 fieldNames1 fieldNames2 fieldNames3) fieldTypes
        newField :: (Name, Name, Name) -> BangType -> Q Exp
        newField (x, y, z) (_, fieldType) = genLiftA3Field unsafely (varE f) fieldType (varE x) (varE y) (varE z) id
-   clause pats body [valD (conP name $ map varP fieldNames2) (normalB $ varE y) [],
-                     valD (conP name $ map varP fieldNames3) (normalB $ varE z) []]
+   TH.clause pats body [TH.valD (conP name $ map varP fieldNames2) (normalB $ varE y) [],
+                        TH.valD (conP name $ map varP fieldNames3) (normalB $ varE z) []]
 genLiftA3Clause unsafely (RecC name fields) = do
    f <- newName "f"
    x <- newName "x"
@@ -268,9 +287,10 @@
    let body = normalB $ recConE name $ map newNamedField fields
        newNamedField :: VarBangType -> Q (Name, Exp)
        newNamedField (fieldName, _, fieldType) =
-          fieldExp fieldName (genLiftA3Field unsafely (varE f) fieldType (getFieldOf x) (getFieldOf y) (getFieldOf z) id)
+          TH.fieldExp fieldName
+             (genLiftA3Field unsafely (varE f) fieldType (getFieldOf x) (getFieldOf y) (getFieldOf z) id)
           where getFieldOf = appE (varE fieldName) . varE
-   clause [varP f, x `asP` recP name [], varP y, varP z] body []
+   TH.clause [varP f, x `TH.asP` TH.recP name [], varP y, varP z] body []
 genLiftA3Clause unsafely (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
    do Just (Deriving tyConName _tyVar) <- getQ
       putQ (Deriving tyConName tyVar)
@@ -305,11 +325,11 @@
    let pats = [conP name (map varP fieldNames1), varP rhsName]
        constraintsAndFields = zipWith newField (zip fieldNames1 fieldNames2) fieldTypes
        newFields = map (snd <$>) constraintsAndFields
-       body = normalB $ appsE $ conE name : newFields
+       body = normalB $ TH.appsE $ conE name : newFields
        newField :: (Name, Name) -> BangType -> Q ([Type], Exp)
        newField (x, y) (_, fieldType) = genApField unsafely fieldType (varE x) (varE y) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause pats body [valD (conP name $ map varP fieldNames2) (normalB $ varE rhsName) []]
+   (,) constraints <$> TH.clause pats body [TH.valD (conP name $ map varP fieldNames2) (normalB $ varE rhsName) []]
 genApClause unsafely (RecC name fields) = do
    x <- newName "x"
    y <- newName "y"
@@ -320,7 +340,7 @@
           ((,) fieldName <$>) <$> genApField unsafely fieldType (getFieldOf x) (getFieldOf y) id
           where getFieldOf = appE (varE fieldName) . varE
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause [x `asP` recP name [], varP y] body []
+   (,) constraints <$> TH.clause [x `TH.asP` TH.recP name [], varP y] body []
 genApClause unsafely (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
    do Just (Deriving tyConName _tyVar) <- getQ
       putQ (Deriving tyConName tyVar)
@@ -347,12 +367,12 @@
 genPureClause :: Con -> Q ([Type], Clause)
 genPureClause (NormalC name fieldTypes) = do
    argName <- newName "f"
-   let body = normalB $ appsE $ conE name : ((snd <$>) <$> constraintsAndFields)
+   let body = normalB $ TH.appsE $ conE name : ((snd <$>) <$> constraintsAndFields)
        constraintsAndFields = map newField fieldTypes
        newField :: BangType -> Q ([Type], Exp)
        newField (_, fieldType) = genPureField fieldType (varE argName) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause [varP argName] body []
+   (,) constraints <$> TH.clause [varP argName] body []
 genPureClause (RecC name fields) = do
    argName <- newName "f"
    let body = normalB $ recConE name $ (snd <$>) <$> constraintsAndFields
@@ -360,7 +380,7 @@
        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 []
+   (,) constraints <$> TH.clause [varP argName] body []
 
 genPureField :: Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
 genPureField fieldType pureValue wrap = do
@@ -385,7 +405,7 @@
        newField :: Name -> BangType -> Q ([Type], Exp)
        newField x (_, fieldType) = genFoldMapField f fieldType (varE x) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause pats (normalB body) []
+   (,) constraints <$> TH.clause pats (normalB body) []
 genFoldMapClause (RecC name fields) = do
    f <- newName "f"
    x <- newName "x"
@@ -396,7 +416,7 @@
        newField :: VarBangType -> Q ([Type], Exp)
        newField (fieldName, _, fieldType) = genFoldMapField f fieldType (appE (varE fieldName) (varE x)) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause [varP f, x `asP` recP name []] (normalB body) []
+   (,) constraints <$> TH.clause [varP f, x `TH.asP` TH.recP name []] (normalB body) []
 genFoldMapClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
    do Just (Deriving tyConName _tyVar) <- getQ
       putQ (Deriving tyConName tyVar)
@@ -421,7 +441,7 @@
 
 genTraverseClause :: Con -> Q ([Type], Clause)
 genTraverseClause (NormalC name []) =
-   (,) [] <$> clause [wildP, conP name []] (normalB [| pure $(conE name) |]) []
+   (,) [] <$> TH.clause [wildP, conP name []] (normalB [| pure $(conE name) |]) []
 genTraverseClause (NormalC name fieldTypes) = do
    f          <- newName "f"
    fieldNames <- replicateM (length fieldTypes) (newName "x")
@@ -434,7 +454,7 @@
        newField :: Name -> BangType -> Q ([Type], Exp)
        newField x (_, fieldType) = genTraverseField (varE f) fieldType (varE x) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause pats body []
+   (,) constraints <$> TH.clause pats body []
 genTraverseClause (RecC name fields) = do
    f <- newName "f"
    x <- newName "x"
@@ -445,7 +465,7 @@
        newField :: VarBangType -> Q ([Type], Exp)
        newField (fieldName, _, fieldType) = genTraverseField (varE f) fieldType (appE (varE fieldName) (varE x)) id
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause [varP f, x `asP` recP name []] body []
+   (,) constraints <$> TH.clause [varP f, x `TH.asP` TH.recP name []] body []
 genTraverseClause (GadtC [name] fieldTypes _resultType@(AppT _ (VarT tyVar))) =
    do Just (Deriving tyConName _tyVar) <- getQ
       putQ (Deriving tyConName tyVar)
@@ -480,7 +500,7 @@
           ((,) 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 []
+   (,) constraints <$> TH.clause [varP withName, varP argName] body []
 
 genCotraverseTraversableClause :: Con -> Q ([Type], Clause)
 genCotraverseTraversableClause (NormalC name []) = genCotraverseTraversableClause (RecC name [])
@@ -495,8 +515,25 @@
                                    (varE 'Rank2.cotraverseTraversable) (varE withName) fieldType
                                    [| $(varE fieldName) <$> $(varE argName) |] id)
    constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
-   (,) constraints <$> clause [varP withName, varP argName] body []
+   (,) constraints <$> TH.clause [varP withName, varP argName] body []
 
+genDeliverClause :: Con -> Q ([Type], Clause)
+genDeliverClause (NormalC name []) = genDeliverClause (RecC name [])
+genDeliverClause (RecC name fields) = do
+   argName <- newName "f"
+   let constraintsAndFields = map newNamedField fields
+       body = normalB $ recConE name $ (snd <$>) <$> constraintsAndFields
+       newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
+       newNamedField (fieldName, _, fieldType) =
+          ((,) fieldName <$>)
+          <$> (genDeliverField ''Rank2.Logistic [| contramap |] fieldType
+               [| \set g-> $(TH.recUpdE [|g|] [(,) fieldName <$> [| Rank2.apply set $ $(varE fieldName) g |]]) |]
+               [| \set g-> $(TH.recUpdE [|g|] [(,) fieldName <$> [| set $ $(varE fieldName) g |]]) |]
+               (varE argName)
+               id)
+   constraints <- (concat . (fst <$>)) <$> sequence constraintsAndFields
+   (,) constraints <$> TH.clause [varP argName] body []
+
 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
@@ -507,6 +544,18 @@
                   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
+
+genDeliverField :: Name -> Q Exp -> Type -> Q Exp -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
+genDeliverField className fun fieldType fieldUpdate subRecordUpdate arg wrap = do
+   Just (Deriving _ typeVar) <- getQ
+   case fieldType of
+     AppT ty _ | ty == VarT typeVar -> (,) [] <$> appE [|Compose|] (wrap fun `appE` fieldUpdate `appE` arg)
+     AppT t1 t2 | t2 == VarT typeVar ->
+                  (,) (constrain className t1) <$> appE [| Rank2.deliver |] (wrap fun `appE` subRecordUpdate `appE` arg)
+     AppT t1 t2 | t1 /= VarT typeVar ->
+                  genDeliverField className fun t2 fieldUpdate subRecordUpdate arg (wrap . appE (varE 'deliver))
+     SigT ty _kind -> genDeliverField className fun ty fieldUpdate subRecordUpdate arg wrap
+     ParensT ty -> genDeliverField className fun ty fieldUpdate subRecordUpdate arg wrap
 
 constrain :: Name -> Type -> [Type]
 constrain _ ConT{} = []