    -- | This module exports the templates for automatic instance deriving of "Rank2" type classes. The most common way to
    -- use it would be
    --
    -- > import qualified Rank2.TH
    -- > data MyDataType f = ...
    -- > $(Rank2.TH.deriveAll ''MyDataType)
    --
    -- or, if you're picky, you can invoke only 'deriveFunctor' and whichever other instances you need instead.

    {-# Language CPP #-}
    {-# Language TemplateHaskell #-}
    {-# Language TypeOperators #-}
    -- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial

    module Rank2.TH (deriveAll, deriveFunctor, deriveApply, unsafeDeriveApply, deriveApplicative,
                     deriveFoldable, deriveTraversable,
                     deriveDistributive, deriveDistributiveTraversable, deriveLogistic)
    where

    import Control.Applicative (liftA2, liftA3)
    import Control.Monad (replicateM)
    import Data.Bifunctor (first)
    import Data.Distributive (cotraverse)
    import Data.Functor.Compose (Compose (Compose))
    import Data.Functor.Contravariant (Contravariant, contramap)
    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, conT, instanceD, varE, varP, varT, normalB, pragInlD, recConE, wildP)
    import Language.Haskell.TH.Syntax (BangType, VarBangType, Info(TyConI), getQ, putQ, newName)

    import qualified Rank2

    data Deriving = Deriving { Deriving -> Name
    _derivingConstructor :: Name, Deriving -> Name
    _derivingVariable :: Name } deriving Int -> Deriving -> ShowS
    [Deriving] -> ShowS
    Deriving -> [Char]
    (Int -> Deriving -> ShowS)
    -> (Deriving -> [Char]) -> ([Deriving] -> ShowS) -> Show Deriving
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Deriving -> ShowS
    showsPrec :: Int -> Deriving -> ShowS
    $cshow :: Deriving -> [Char]
    show :: Deriving -> [Char]
    $cshowList :: [Deriving] -> ShowS
    showList :: [Deriving] -> ShowS
    Show

    deriveAll :: Name -> Q [Dec]
    deriveAll :: Name -> Q [Dec]
    deriveAll Name
    ty = ((Name -> Q [Dec]) -> Q [Dec] -> Q [Dec])
    -> Q [Dec] -> [Name -> Q [Dec]] -> Q [Dec]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Name -> Q [Dec]) -> Q [Dec] -> Q [Dec]
    forall {f :: * -> *} {b}.
    (Applicative f, Semigroup b) =>
    (Name -> f b) -> f b -> f b
    f ([Dec] -> Q [Dec]
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []) [Name -> Q [Dec]
    deriveFunctor, Name -> Q [Dec]
    deriveApply, Name -> Q [Dec]
    deriveApplicative,
                                      Name -> Q [Dec]
    deriveFoldable, Name -> Q [Dec]
    deriveTraversable,
                                      Name -> Q [Dec]
    deriveDistributive, Name -> Q [Dec]
    deriveDistributiveTraversable, Name -> Q [Dec]
    deriveLogistic]
       where f :: (Name -> f b) -> f b -> f b
    f Name -> f b
    derive f b
    rest = b -> b -> b
    forall a. Semigroup a => a -> a -> a
    (<>) (b -> b -> b) -> f b -> f (b -> b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> f b
    derive Name
    ty f (b -> b) -> f b -> f b
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> f b
    rest

    deriveFunctor :: Name -> Q [Dec]
    deriveFunctor :: Name -> Q [Dec]
    deriveFunctor Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Functor Name
    ty
       ([Type]
    constraints, Dec
    dec) <- TypeQ -> [Con] -> Q ([Type], Dec)
    genFmap TypeQ
    instanceType [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD '(Rank2.<$>) Inline
    Inline RuleMatch
    FunLike Phases
    AllPhases]]

    deriveApply :: Name -> Q [Dec]
    deriveApply :: Name -> Q [Dec]
    deriveApply Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Apply Name
    ty
       ([Type]
    constraints, Dec
    dec) <- TypeQ -> [Con] -> Q ([Type], Dec)
    genAp TypeQ
    instanceType [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, [Con] -> Q Dec
    genLiftA2 [Con]
    cs, [Con] -> Q Dec
    genLiftA3 [Con]
    cs,
                  Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD '(Rank2.<*>) Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases,
                  Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD 'Rank2.liftA2 Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases]]

    -- | This function always succeeds, but the methods it generates may be partial. Use with care.
    unsafeDeriveApply :: Name -> Q [Dec]
    unsafeDeriveApply :: Name -> Q [Dec]
    unsafeDeriveApply Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Apply Name
    ty
       ([Type]
    constraints, Dec
    dec) <- TypeQ -> [Con] -> Q ([Type], Dec)
    genApUnsafely TypeQ
    instanceType [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, [Con] -> Q Dec
    genLiftA2Unsafely [Con]
    cs, [Con] -> Q Dec
    genLiftA3Unsafely [Con]
    cs,
                  Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD '(Rank2.<*>) Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases,
                  Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD 'Rank2.liftA2 Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases]]

    deriveApplicative :: Name -> Q [Dec]
    deriveApplicative :: Name -> Q [Dec]
    deriveApplicative Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Applicative Name
    ty
       ([Type]
    constraints, Dec
    dec) <- [Con] -> Q ([Type], Dec)
    genPure [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD 'Rank2.pure Inline
    Inline RuleMatch
    FunLike Phases
    AllPhases]]

    deriveFoldable :: Name -> Q [Dec]
    deriveFoldable :: Name -> Q [Dec]
    deriveFoldable Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Foldable Name
    ty
       ([Type]
    constraints, Dec
    dec) <- TypeQ -> [Con] -> Q ([Type], Dec)
    genFoldMap TypeQ
    instanceType [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD 'Rank2.foldMap Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases]]

    deriveTraversable :: Name -> Q [Dec]
    deriveTraversable :: Name -> Q [Dec]
    deriveTraversable Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Traversable Name
    ty
       ([Type]
    constraints, Dec
    dec) <- TypeQ -> [Con] -> Q ([Type], Dec)
    genTraverse TypeQ
    instanceType [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD 'Rank2.traverse Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases]]

    deriveDistributive :: Name -> Q [Dec]
    deriveDistributive :: Name -> Q [Dec]
    deriveDistributive Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Distributive Name
    ty
       ([Type]
    constraints, Dec
    dec) <- [Con] -> Q ([Type], Dec)
    genCotraverse [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD 'Rank2.cotraverse Inline
    Inline RuleMatch
    FunLike Phases
    AllPhases]]

    deriveDistributiveTraversable :: Name -> Q [Dec]
    deriveDistributiveTraversable :: Name -> Q [Dec]
    deriveDistributiveTraversable Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.DistributiveTraversable Name
    ty
       ([Type]
    constraints, Dec
    dec) <- [Con] -> Q ([Type], Dec)
    genCotraverseTraversable [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType [Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec]]

    deriveLogistic :: Name -> Q [Dec]
    deriveLogistic :: Name -> Q [Dec]
    deriveLogistic Name
    ty = do
       (TypeQ
    instanceType, [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Logistic Name
    ty
       ([Type]
    constraints, [Dec]
    decs) <- TypeQ -> [Con] -> Q ([Type], [Dec])
    genDeliver TypeQ
    instanceType [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m [Type] -> m Type -> [m Dec] -> m Dec
    instanceD ([TypeQ] -> Q [Type]
    forall (m :: * -> *). Quote m => [m Type] -> m [Type]
    TH.cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                  ((Dec -> Q Dec) -> [Dec] -> [Q Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Dec]
    decs [Q Dec] -> [Q Dec] -> [Q Dec]
    forall a. Semigroup a => a -> a -> a
    <> [Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD 'Rank2.deliver Inline
    Inline RuleMatch
    FunLike Phases
    AllPhases])]

    reifyConstructors :: Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors :: Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors Name
    cls Name
    ty = do
       (TyConI Dec
    tyCon) <- Name -> Q Info
    TH.reify Name
    ty
       (Name
    tyConName, [TyVarBndr ()]
    tyVars, Maybe Type
    _kind, [Con]
    cs) <- case Dec
    tyCon of
          DataD [Type]
    _ Name
    nm [TyVarBndr ()]
    tyVars Maybe Type
    kind [Con]
    cs [DerivClause]
    _   -> (Name, [TyVarBndr ()], Maybe Type, [Con])
    -> Q (Name, [TyVarBndr ()], Maybe Type, [Con])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    nm, [TyVarBndr ()]
    tyVars, Maybe Type
    kind, [Con]
    cs)
          NewtypeD [Type]
    _ Name
    nm [TyVarBndr ()]
    tyVars Maybe Type
    kind Con
    c [DerivClause]
    _ -> (Name, [TyVarBndr ()], Maybe Type, [Con])
    -> Q (Name, [TyVarBndr ()], Maybe Type, [Con])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    nm, [TyVarBndr ()]
    tyVars, Maybe Type
    kind, [Con
    c])
          Dec
    _ -> [Char] -> Q (Name, [TyVarBndr ()], Maybe Type, [Con])
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "deriveApply: tyCon may not be a type synonym."

    #if MIN_VERSION_template_haskell(2,17,0)
       let (KindedTV Name
    tyVar () (AppT (AppT Type
    ArrowT Type
    _) Type
    StarT)) = [TyVarBndr ()] -> TyVarBndr ()
    forall a. HasCallStack => [a] -> a
    last [TyVarBndr ()]
    tyVars
           instanceType :: TypeQ
    instanceType           = Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    cls TypeQ -> TypeQ -> TypeQ
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `TH.appT` (TypeQ -> TyVarBndr () -> TypeQ)
    -> TypeQ -> [TyVarBndr ()] -> TypeQ
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl TypeQ -> TyVarBndr () -> TypeQ
    forall {m :: * -> *} {flag}.
    Quote m =>
    m Type -> TyVarBndr flag -> m Type
    apply (Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    tyConName) ([TyVarBndr ()] -> [TyVarBndr ()]
    forall a. HasCallStack => [a] -> [a]
    init [TyVarBndr ()]
    tyVars)
           apply :: m Type -> TyVarBndr flag -> m Type
    apply m Type
    t (PlainTV Name
    name flag
    _)    = m Type -> m Type -> m Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    TH.appT m Type
    t (Name -> m Type
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    name)
           apply m Type
    t (KindedTV Name
    name flag
    _ Type
    _) = m Type -> m Type -> m Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    TH.appT m Type
    t (Name -> m Type
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    name)
    #else
       let (KindedTV tyVar (AppT (AppT ArrowT _) StarT)) = last tyVars
           instanceType           = conT cls `TH.appT` foldl apply (conT tyConName) (init tyVars)
           apply t (PlainTV name)    = TH.appT t (varT name)
           apply t (KindedTV name _) = TH.appT t (varT name)
    #endif

       Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
       (TypeQ, [Con]) -> Q (TypeQ, [Con])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQ
    instanceType, [Con]
    cs)

    genFmap :: TypeQ -> [Con] -> Q ([Type], Dec)
    genFmap :: TypeQ -> [Con] -> Q ([Type], Dec)
    genFmap TypeQ
    instanceType [Con]
    cs = do
       Type
    it <- TypeQ
    instanceType
       ([[Type]]
    constraints, [Clause]
    clauses) <- [([Type], Clause)] -> ([[Type]], [Clause])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([Type], Clause)] -> ([[Type]], [Clause]))
    -> Q [([Type], Clause)] -> Q ([[Type]], [Clause])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Con -> Q ([Type], Clause)) -> [Con] -> Q [([Type], Clause)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Type -> Con -> Q ([Type], Clause)
    genFmapClause Type
    it) [Con]
    cs
       ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Type]]
    constraints, Name -> [Clause] -> Dec
    FunD '(Rank2.<$>) [Clause]
    clauses)

    genAp :: TypeQ -> [Con] -> Q ([Type], Dec)
    genAp :: TypeQ -> [Con] -> Q ([Type], Dec)
    genAp TypeQ
    instanceType [Con
    con] = do
       Type
    it <- TypeQ
    instanceType
       ([Type]
    constraints, Clause
    clause) <- Bool -> Type -> Con -> Q ([Type], Clause)
    genApClause Bool
    False Type
    it Con
    con
       ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Type]
    constraints, Name -> [Clause] -> Dec
    FunD '(Rank2.<*>) [Clause
    clause])

    genLiftA2 :: [Con] -> Q Dec
    genLiftA2 :: [Con] -> Q Dec
    genLiftA2 [Con
    con] = Name -> [Q Clause] -> Q Dec
    forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
    TH.funD 'Rank2.liftA2 [Bool -> Con -> Q Clause
    genLiftA2Clause Bool
    False Con
    con]

    genLiftA3 :: [Con] -> Q Dec
    genLiftA3 :: [Con] -> Q Dec
    genLiftA3 [Con
    con] = Name -> [Q Clause] -> Q Dec
    forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
    TH.funD 'Rank2.liftA3 [Bool -> Con -> Q Clause
    genLiftA3Clause Bool
    False Con
    con]

    genApUnsafely :: TypeQ -> [Con] -> Q ([Type], Dec)
    genApUnsafely :: TypeQ -> [Con] -> Q ([Type], Dec)
    genApUnsafely TypeQ
    instanceType [Con]
    cons = do
       Type
    it <- TypeQ
    instanceType
       ([[Type]]
    constraints, [Clause]
    clauses) <- [([Type], Clause)] -> ([[Type]], [Clause])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([Type], Clause)] -> ([[Type]], [Clause]))
    -> Q [([Type], Clause)] -> Q ([[Type]], [Clause])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Con -> Q ([Type], Clause)) -> [Con] -> Q [([Type], Clause)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Bool -> Type -> Con -> Q ([Type], Clause)
    genApClause Bool
    True Type
    it) [Con]
    cons
       ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Type]]
    constraints, Name -> [Clause] -> Dec
    FunD '(Rank2.<*>) [Clause]
    clauses)

    genLiftA2Unsafely :: [Con] -> Q Dec
    genLiftA2Unsafely :: [Con] -> Q Dec
    genLiftA2Unsafely [Con]
    cons = Name -> [Q Clause] -> Q Dec
    forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
    TH.funD 'Rank2.liftA2 (Bool -> Con -> Q Clause
    genLiftA2Clause Bool
    True (Con -> Q Clause) -> [Con] -> [Q Clause]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Con]
    cons)

    genLiftA3Unsafely :: [Con] -> Q Dec
    genLiftA3Unsafely :: [Con] -> Q Dec
    genLiftA3Unsafely [Con]
    cons = Name -> [Q Clause] -> Q Dec
    forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
    TH.funD 'Rank2.liftA3 (Bool -> Con -> Q Clause
    genLiftA3Clause Bool
    True (Con -> Q Clause) -> [Con] -> [Q Clause]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Con]
    cons)

    genPure :: [Con] -> Q ([Type], Dec)
    genPure :: [Con] -> Q ([Type], Dec)
    genPure [Con]
    cs = do ([[Type]]
    constraints, [Clause]
    clauses) <- [([Type], Clause)] -> ([[Type]], [Clause])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([Type], Clause)] -> ([[Type]], [Clause]))
    -> Q [([Type], Clause)] -> Q ([[Type]], [Clause])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Con -> Q ([Type], Clause)) -> [Con] -> Q [([Type], Clause)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Con -> Q ([Type], Clause)
    genPureClause [Con]
    cs
                    ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Type]]
    constraints, Name -> [Clause] -> Dec
    FunD 'Rank2.pure [Clause]
    clauses)

    genFoldMap :: TypeQ -> [Con] -> Q ([Type], Dec)
    genFoldMap :: TypeQ -> [Con] -> Q ([Type], Dec)
    genFoldMap TypeQ
    instanceType [Con]
    cs = do
       Type
    it <- TypeQ
    instanceType
       ([[Type]]
    constraints, [Clause]
    clauses) <- [([Type], Clause)] -> ([[Type]], [Clause])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([Type], Clause)] -> ([[Type]], [Clause]))
    -> Q [([Type], Clause)] -> Q ([[Type]], [Clause])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Con -> Q ([Type], Clause)) -> [Con] -> Q [([Type], Clause)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Type -> Con -> Q ([Type], Clause)
    genFoldMapClause Type
    it) [Con]
    cs
       ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Type]]
    constraints, Name -> [Clause] -> Dec
    FunD 'Rank2.foldMap [Clause]
    clauses)

    genTraverse :: TypeQ -> [Con] -> Q ([Type], Dec)
    genTraverse :: TypeQ -> [Con] -> Q ([Type], Dec)
    genTraverse TypeQ
    instanceType [Con]
    cs = do
       Type
    it <- TypeQ
    instanceType
       ([[Type]]
    constraints, [Clause]
    clauses) <- [([Type], Clause)] -> ([[Type]], [Clause])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([Type], Clause)] -> ([[Type]], [Clause]))
    -> Q [([Type], Clause)] -> Q ([[Type]], [Clause])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Con -> Q ([Type], Clause)) -> [Con] -> Q [([Type], Clause)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Type -> Con -> Q ([Type], Clause)
    genTraverseClause Type
    it) [Con]
    cs
       ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Type]]
    constraints, Name -> [Clause] -> Dec
    FunD 'Rank2.traverse [Clause]
    clauses)

    genCotraverse :: [Con] -> Q ([Type], Dec)
    genCotraverse :: [Con] -> Q ([Type], Dec)
    genCotraverse [Con
    con] = do ([Type]
    constraints, Clause
    clause) <- Con -> Q ([Type], Clause)
    genCotraverseClause Con
    con
                             ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Type]
    constraints, Name -> [Clause] -> Dec
    FunD 'Rank2.cotraverse [Clause
    clause])

    genCotraverseTraversable :: [Con] -> Q ([Type], Dec)
    genCotraverseTraversable :: [Con] -> Q ([Type], Dec)
    genCotraverseTraversable [Con
    con] = do ([Type]
    constraints, Clause
    clause) <- Con -> Q ([Type], Clause)
    genCotraverseTraversableClause Con
    con
                                        ([Type], Dec) -> Q ([Type], Dec)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Type]
    constraints, Name -> [Clause] -> Dec
    FunD 'Rank2.cotraverseTraversable [Clause
    clause])

    genDeliver :: TypeQ -> [Con] -> Q ([Type], [Dec])
    genDeliver :: TypeQ -> [Con] -> Q ([Type], [Dec])
    genDeliver TypeQ
    instanceType [Con
    con] = do
       Type
    it <- TypeQ
    instanceType
       let AppT Type
    _classType Type
    rt = Type
    it
           recType :: TypeQ
    recType = Type -> TypeQ
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    rt
       Bool
    signable <- Extension -> Q Bool
    TH.isExtEnabled Extension
    TH.InstanceSigs
       Bool
    scopable <- Extension -> Q Bool
    TH.isExtEnabled Extension
    TH.ScopedTypeVariables
       if Bool
    signable Bool -> Bool -> Bool
    && Bool
    scopable then do
          Name
    p <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "p"
          Name
    q <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "q"
          ([Type]
    constraints, Clause
    clause) <- TypeQ -> Maybe Name -> Con -> Q ([Type], Clause)
    genDeliverClause TypeQ
    recType (Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    q) Con
    con
          Type
    ctx <- [t| Contravariant $(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    p) |]
          Type
    methodType <- [t| $(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    p) ($(TypeQ
    recType) $(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    q) -> $(TypeQ
    recType) $(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    q)) -> $(TypeQ
    recType) (Compose $(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    p) ($(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    q) Rank2.~> $(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    q))) |]
          ([Type], [Dec]) -> Q ([Type], [Dec])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Type]
    constraints,
                  [Name -> Type -> Dec
    SigD 'Rank2.deliver ([TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT [Name -> TyVarBndr Specificity
    binder Name
    p, Name -> TyVarBndr Specificity
    binder Name
    q] [Type
    ctx] Type
    methodType),
                   Name -> [Clause] -> Dec
    FunD 'Rank2.deliver [Clause
    clause]])
       else do
          ([Type]
    constraints, Clause
    clause) <- TypeQ -> Maybe Name -> Con -> Q ([Type], Clause)
    genDeliverClause TypeQ
    recType Maybe Name
    forall a. Maybe a
    Nothing Con
    con
          ([Type], [Dec]) -> Q ([Type], [Dec])
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Type]
    constraints, [Name -> [Clause] -> Dec
    FunD 'Rank2.deliver [Clause
    clause]])

    genFmapClause :: Type -> Con -> Q ([Type], Clause)
    genFmapClause :: Type -> Con -> Q ([Type], Clause)
    genFmapClause Type
    _ (NormalC Name
    name [BangType]
    fieldTypes) = do
       Name
    f          <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       [Name]
    fieldNames <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x")
       let pats :: [Q Pat]
    pats = [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames)]
           constraintsAndFields :: [Q ([Type], Exp)]
    constraintsAndFields = (Name -> BangType -> Q ([Type], Exp))
    -> [Name] -> [BangType] -> [Q ([Type], Exp)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Name -> BangType -> Q ([Type], Exp)
    newField [Name]
    fieldNames [BangType]
    fieldTypes
           newFields :: [Q Exp]
    newFields = (Q ([Type], Exp) -> Q Exp) -> [Q ([Type], Exp)] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (([Type], Exp) -> Exp
    forall a b. (a, b) -> b
    snd (([Type], Exp) -> Exp) -> Q ([Type], Exp) -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) [Q ([Type], Exp)]
    constraintsAndFields
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    TH.appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    : [Q Exp]
    newFields
           newField :: Name -> BangType -> Q ([Type], Exp)
           newField :: Name -> BangType -> Q ([Type], Exp)
    newField Name
    x (Bang
    _, Type
    fieldType) = Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], Exp)] -> [[Type]]) -> [([Type], Exp)] -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], Exp) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], Exp) -> [Type]) -> [([Type], Exp)] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], Exp)] -> [Type]) -> Q [([Type], Exp)] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)] -> Q [([Type], Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Q Pat]
    pats Q Body
    body []
    genFmapClause Type
    _ (RecC Name
    name [VarBangType]
    fields) = do
       Name
    f <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
       let body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], (Name, Exp)) -> (Name, Exp)
    forall a b. (a, b) -> b
    snd (([Type], (Name, Exp)) -> (Name, Exp))
    -> Q ([Type], (Name, Exp)) -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], (Name, Exp)) -> Q (Name, Exp))
    -> [Q ([Type], (Name, Exp))] -> [Q (Name, Exp)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))]
    constraintsAndFields
           constraintsAndFields :: [Q ([Type], (Name, Exp))]
    constraintsAndFields = (VarBangType -> Q ([Type], (Name, Exp)))
    -> [VarBangType] -> [Q ([Type], (Name, Exp))]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], (Name, Exp))
    newNamedField [VarBangType]
    fields
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) =
              ((,) Name
    fieldName (Exp -> (Name, Exp)) -> ([Type], Exp) -> ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)
              (([Type], Exp) -> ([Type], (Name, Exp)))
    -> Q ([Type], Exp) -> Q ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Name -> Q Exp
    getFieldOf Name
    x Name
    fieldName) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], (Name, Exp))] -> [[Type]])
    -> [([Type], (Name, Exp))]
    -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], (Name, Exp)) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], (Name, Exp)) -> [Type])
    -> [([Type], (Name, Exp))] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], (Name, Exp))] -> [Type])
    -> Q [([Type], (Name, Exp))] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))] -> Q [([Type], (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name
    x Name -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat -> m Pat
    `TH.asP` Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    TH.recP Name
    name []] Q Body
    body []
    genFmapClause Type
    instanceType (GadtC [Name
    name] [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Con -> Q ([Type], Clause)
    genFmapClause Type
    instanceType (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genFmapClause Type
    instanceType (RecGadtC [Name
    name] [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Con -> Q ([Type], Clause)
    genFmapClause Type
    instanceType (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genFmapClause Type
    instanceType (ForallC [TyVarBndr Specificity]
    _vars [Type]
    _cxt Con
    con) = Type -> Con -> Q ([Type], Clause)
    genFmapClause Type
    instanceType Con
    con

    genFmapField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField Q Exp
    fun Type
    fieldType Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _  | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap Q Exp
    fun) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t2 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) (Name -> Type -> [Type]
    constrain ''Rank2.Functor Type
    t1) (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap [| ($Q Exp
    fun Rank2.<$>) |]) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField Q Exp
    fun Type
    t2 Q Exp
    fieldAccess (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE '(<$>)))
         SigT Type
    ty Type
    _kind -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField Q Exp
    fun Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField Q Exp
    fun Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap
         Type
    _ -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp
    fieldAccess

    genLiftA2Clause :: Bool -> Con -> Q Clause
    genLiftA2Clause :: Bool -> Con -> Q Clause
    genLiftA2Clause Bool
    unsafely (NormalC Name
    name [BangType]
    fieldTypes) = do
       Name
    f          <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       [Name]
    fieldNames1 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x")
       Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
       [Name]
    fieldNames2 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y")
       let pats :: [Q Pat]
    pats = [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames1), Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y]
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    TH.appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    : ((Name, Name) -> BangType -> Q Exp)
    -> [(Name, Name)] -> [BangType] -> [Q Exp]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Name, Name) -> BangType -> Q Exp
    newField ([Name] -> [Name] -> [(Name, Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    fieldNames1 [Name]
    fieldNames2) [BangType]
    fieldTypes
           newField :: (Name, Name) -> BangType -> Q Exp
           newField :: (Name, Name) -> BangType -> Q Exp
    newField (Name
    x, Name
    y) (Bang
    _, Type
    fieldType) = Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Q Pat]
    pats Q Body
    body [Q Pat -> Q Body -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Dec
    TH.valD (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames2) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y) []]
    genLiftA2Clause Bool
    unsafely (RecC Name
    name [VarBangType]
    fields) = do
       Name
    f <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
       Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
       let body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (VarBangType -> Q (Name, Exp)) -> [VarBangType] -> [Q (Name, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q (Name, Exp)
    newNamedField [VarBangType]
    fields
           newNamedField :: VarBangType -> Q (Name, Exp)
           newNamedField :: VarBangType -> Q (Name, Exp)
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) =
              Name -> Q Exp -> Q (Name, Exp)
    forall (m :: * -> *). Quote m => Name -> m Exp -> m (Name, Exp)
    TH.fieldExp Name
    fieldName (Q Exp -> Q (Name, Exp)) -> Q Exp -> Q (Name, Exp)
    forall a b. (a -> b) -> a -> b
    $
                 Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Name -> Q Exp
    getFieldOf Name
    x Name
    fieldName) (Name -> Name -> Q Exp
    getFieldOf Name
    y Name
    fieldName) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name
    x Name -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat -> m Pat
    `TH.asP` Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    TH.recP Name
    name [], Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y] Q Body
    body []
    genLiftA2Clause Bool
    unsafely (GadtC [Name
    name] [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT Type
    _ (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          Bool -> Con -> Q Clause
    genLiftA2Clause Bool
    unsafely (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genLiftA2Clause Bool
    unsafely (RecGadtC [Name
    name] [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT Type
    _ (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          Bool -> Con -> Q Clause
    genLiftA2Clause Bool
    unsafely (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genLiftA2Clause Bool
    unsafely (ForallC [TyVarBndr Specificity]
    _vars [Type]
    _cxt Con
    con) = Bool -> Con -> Q Clause
    genLiftA2Clause Bool
    unsafely Con
    con

    genLiftA2Field :: Bool -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field :: Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely Q Exp
    fun Type
    fieldType Q Exp
    field1Access Q Exp
    field2Access Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(Q Exp -> Q Exp
    wrap Q Exp
    fun) $Q Exp
    field1Access $Q Exp
    field2Access |]
         AppT Type
    _ Type
    ty | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.liftA2) Q Exp
    fun) $Q Exp
    field1Access $Q Exp
    field2Access |]
         AppT Type
    t1 Type
    t2
            | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar -> Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely Q Exp
    fun Type
    t2 Q Exp
    field1Access Q Exp
    field2Access (Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'liftA2) (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp
    wrap)
         SigT Type
    ty Type
    _kind -> Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely Q Exp
    fun Type
    ty Q Exp
    field1Access Q Exp
    field2Access Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely Q Exp
    fun Type
    ty Q Exp
    field1Access Q Exp
    field2Access Q Exp -> Q Exp
    wrap
         Type
    _ | Bool
    unsafely -> Q Exp
    field1Access
           | Bool
    otherwise -> [Char] -> Q Exp
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Cannot apply liftA2 to field of type " [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    fieldType)

    genLiftA3Clause :: Bool -> Con -> Q Clause
    genLiftA3Clause :: Bool -> Con -> Q Clause
    genLiftA3Clause Bool
    unsafely (NormalC Name
    name [BangType]
    fieldTypes) = do
       Name
    f          <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       [Name]
    fieldNames1 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x")
       Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
       Name
    z <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "z"
       [Name]
    fieldNames2 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y")
       [Name]
    fieldNames3 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "z")
       let pats :: [Q Pat]
    pats = [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames1), Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    z]
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    TH.appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    : ((Name, Name, Name) -> BangType -> Q Exp)
    -> [(Name, Name, Name)] -> [BangType] -> [Q Exp]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Name, Name, Name) -> BangType -> Q Exp
    newField ([Name] -> [Name] -> [Name] -> [(Name, Name, Name)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Name]
    fieldNames1 [Name]
    fieldNames2 [Name]
    fieldNames3) [BangType]
    fieldTypes
           newField :: (Name, Name, Name) -> BangType -> Q Exp
           newField :: (Name, Name, Name) -> BangType -> Q Exp
    newField (Name
    x, Name
    y, Name
    z) (Bang
    _, Type
    fieldType) = Bool
    -> Q Exp
    -> Type
    -> Q Exp
    -> Q Exp
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q Exp
    genLiftA3Field Bool
    unsafely (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    z) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Q Pat]
    pats Q Body
    body [Q Pat -> Q Body -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Dec
    TH.valD (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames2) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y) [],
                            Q Pat -> Q Body -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Dec
    TH.valD (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames3) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    z) []]
    genLiftA3Clause Bool
    unsafely (RecC Name
    name [VarBangType]
    fields) = do
       Name
    f <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
       Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
       Name
    z <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "z"
       let body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (VarBangType -> Q (Name, Exp)) -> [VarBangType] -> [Q (Name, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q (Name, Exp)
    newNamedField [VarBangType]
    fields
           newNamedField :: VarBangType -> Q (Name, Exp)
           newNamedField :: VarBangType -> Q (Name, Exp)
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) =
              Name -> Q Exp -> Q (Name, Exp)
    forall (m :: * -> *). Quote m => Name -> m Exp -> m (Name, Exp)
    TH.fieldExp Name
    fieldName
                 (Bool
    -> Q Exp
    -> Type
    -> Q Exp
    -> Q Exp
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q Exp
    genLiftA3Field Bool
    unsafely (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Name -> Q Exp
    getFieldOf Name
    x Name
    fieldName) (Name -> Name -> Q Exp
    getFieldOf Name
    y Name
    fieldName) (Name -> Name -> Q Exp
    getFieldOf Name
    z Name
    fieldName) Q Exp -> Q Exp
    forall a. a -> a
    id)
       [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name
    x Name -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat -> m Pat
    `TH.asP` Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    TH.recP Name
    name [], Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    z] Q Body
    body []
    genLiftA3Clause Bool
    unsafely (GadtC [Name
    name] [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT Type
    _ (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          Bool -> Con -> Q Clause
    genLiftA3Clause Bool
    unsafely (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genLiftA3Clause Bool
    unsafely (RecGadtC [Name
    name] [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT Type
    _ (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          Bool -> Con -> Q Clause
    genLiftA3Clause Bool
    unsafely (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genLiftA3Clause Bool
    unsafely (ForallC [TyVarBndr Specificity]
    _vars [Type]
    _cxt Con
    con) = Bool -> Con -> Q Clause
    genLiftA3Clause Bool
    unsafely Con
    con

    genLiftA3Field :: Bool -> Q Exp -> Type -> Q Exp -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA3Field :: Bool
    -> Q Exp
    -> Type
    -> Q Exp
    -> Q Exp
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q Exp
    genLiftA3Field Bool
    unsafely Q Exp
    fun Type
    fieldType Q Exp
    field1Access Q Exp
    field2Access Q Exp
    field3Access Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _
            | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(Q Exp -> Q Exp
    wrap Q Exp
    fun) $(Q Exp
    field1Access) $(Q Exp
    field2Access) $(Q Exp
    field3Access) |]
         AppT Type
    _ Type
    ty
            | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.liftA3) Q Exp
    fun) $(Q Exp
    field1Access) $(Q Exp
    field2Access) $(Q Exp
    field3Access) |]
         AppT Type
    t1 Type
    t2
            | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar
              -> Bool
    -> Q Exp
    -> Type
    -> Q Exp
    -> Q Exp
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q Exp
    genLiftA3Field Bool
    unsafely Q Exp
    fun Type
    t2 Q Exp
    field1Access Q Exp
    field2Access Q Exp
    field3Access (Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'liftA3) (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp
    wrap)
         SigT Type
    ty Type
    _kind -> Bool
    -> Q Exp
    -> Type
    -> Q Exp
    -> Q Exp
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q Exp
    genLiftA3Field Bool
    unsafely Q Exp
    fun Type
    ty Q Exp
    field1Access Q Exp
    field2Access Q Exp
    field3Access Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Bool
    -> Q Exp
    -> Type
    -> Q Exp
    -> Q Exp
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q Exp
    genLiftA3Field Bool
    unsafely Q Exp
    fun Type
    ty Q Exp
    field1Access Q Exp
    field2Access Q Exp
    field3Access Q Exp -> Q Exp
    wrap
         Type
    _ | Bool
    unsafely -> Q Exp
    field1Access
           | Bool
    otherwise -> [Char] -> Q Exp
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Cannot apply liftA3 to field of type " [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    fieldType)

    genApClause :: Bool -> Type -> Con -> Q ([Type], Clause)
    genApClause :: Bool -> Type -> Con -> Q ([Type], Clause)
    genApClause Bool
    unsafely Type
    _ (NormalC Name
    name [BangType]
    fieldTypes) = do
       [Name]
    fieldNames1 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x")
       [Name]
    fieldNames2 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y")
       Name
    rhsName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "rhs"
       let pats :: [Q Pat]
    pats = [Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames1), Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    rhsName]
           constraintsAndFields :: [Q ([Type], Exp)]
    constraintsAndFields = ((Name, Name) -> BangType -> Q ([Type], Exp))
    -> [(Name, Name)] -> [BangType] -> [Q ([Type], Exp)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Name, Name) -> BangType -> Q ([Type], Exp)
    newField ([Name] -> [Name] -> [(Name, Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    fieldNames1 [Name]
    fieldNames2) [BangType]
    fieldTypes
           newFields :: [Q Exp]
    newFields = (Q ([Type], Exp) -> Q Exp) -> [Q ([Type], Exp)] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (([Type], Exp) -> Exp
    forall a b. (a, b) -> b
    snd (([Type], Exp) -> Exp) -> Q ([Type], Exp) -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) [Q ([Type], Exp)]
    constraintsAndFields
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    TH.appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    : [Q Exp]
    newFields
           newField :: (Name, Name) -> BangType -> Q ([Type], Exp)
           newField :: (Name, Name) -> BangType -> Q ([Type], Exp)
    newField (Name
    x, Name
    y) (Bang
    _, Type
    fieldType) = Bool
    -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField Bool
    unsafely Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], Exp)] -> [[Type]]) -> [([Type], Exp)] -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], Exp) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], Exp) -> [Type]) -> [([Type], Exp)] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], Exp)] -> [Type]) -> Q [([Type], Exp)] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)] -> Q [([Type], Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Q Pat]
    pats Q Body
    body [Q Pat -> Q Body -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Dec
    TH.valD (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames2) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    rhsName) []]
    genApClause Bool
    unsafely Type
    _ (RecC Name
    name [VarBangType]
    fields) = do
       Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
       Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
       let body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], (Name, Exp)) -> (Name, Exp)
    forall a b. (a, b) -> b
    snd (([Type], (Name, Exp)) -> (Name, Exp))
    -> Q ([Type], (Name, Exp)) -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], (Name, Exp)) -> Q (Name, Exp))
    -> [Q ([Type], (Name, Exp))] -> [Q (Name, Exp)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))]
    constraintsAndFields
           constraintsAndFields :: [Q ([Type], (Name, Exp))]
    constraintsAndFields = (VarBangType -> Q ([Type], (Name, Exp)))
    -> [VarBangType] -> [Q ([Type], (Name, Exp))]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], (Name, Exp))
    newNamedField [VarBangType]
    fields
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) =
              ((,) Name
    fieldName (Exp -> (Name, Exp)) -> ([Type], Exp) -> ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Exp) -> ([Type], (Name, Exp)))
    -> Q ([Type], Exp) -> Q ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool
    -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField Bool
    unsafely Type
    fieldType (Name -> Name -> Q Exp
    getFieldOf Name
    x Name
    fieldName) (Name -> Name -> Q Exp
    getFieldOf Name
    y Name
    fieldName) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], (Name, Exp))] -> [[Type]])
    -> [([Type], (Name, Exp))]
    -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], (Name, Exp)) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], (Name, Exp)) -> [Type])
    -> [([Type], (Name, Exp))] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], (Name, Exp))] -> [Type])
    -> Q [([Type], (Name, Exp))] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))] -> Q [([Type], (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name
    x Name -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat -> m Pat
    `TH.asP` Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    TH.recP Name
    name [], Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y] Q Body
    body []
    genApClause Bool
    unsafely Type
    instanceType (GadtC [Name
    name] [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> Type -> Con -> Q ([Type], Clause)
    genApClause Bool
    unsafely Type
    instanceType (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genApClause Bool
    unsafely Type
    instanceType (RecGadtC [Name
    name] [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> Type -> Con -> Q ([Type], Clause)
    genApClause Bool
    unsafely Type
    instanceType (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genApClause Bool
    unsafely Type
    instanceType (ForallC [TyVarBndr Specificity]
    _vars [Type]
    _cxt Con
    con) = Bool -> Type -> Con -> Q ([Type], Clause)
    genApClause Bool
    unsafely Type
    instanceType Con
    con

    genApField :: Bool -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField :: Bool
    -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField Bool
    unsafely Type
    fieldType Q Exp
    field1Access Q Exp
    field2Access Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [| $(Q Exp -> Q Exp
    wrap (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.apply)) $(Q Exp
    field1Access) $(Q Exp
    field2Access) |]
         AppT Type
    t1 Type
    t2 | Type
    t2 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar ->
                      (,) (Name -> Type -> [Type]
    constrain ''Rank2.Apply Type
    t1) (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [| $(Q Exp -> Q Exp
    wrap (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.ap)) $(Q Exp
    field1Access) $(Q Exp
    field2Access) |]
         AppT Type
    t1 Type
    t2 | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar -> Bool
    -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField Bool
    unsafely Type
    t2 Q Exp
    field1Access Q Exp
    field2Access (Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'liftA2) (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp
    wrap)
         SigT Type
    ty Type
    _kind -> Bool
    -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField Bool
    unsafely Type
    ty Q Exp
    field1Access Q Exp
    field2Access Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Bool
    -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField Bool
    unsafely Type
    ty Q Exp
    field1Access Q Exp
    field2Access Q Exp -> Q Exp
    wrap
         Type
    _ | Bool
    unsafely -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp
    field1Access
           | Bool
    otherwise -> [Char] -> Q ([Type], Exp)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Cannot apply ap to field of type " [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    fieldType)

    genPureClause :: Con -> Q ([Type], Clause)
    genPureClause :: Con -> Q ([Type], Clause)
    genPureClause (NormalC Name
    name [BangType]
    fieldTypes) = do
       Name
    argName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       let body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    TH.appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    : ((([Type], Exp) -> Exp
    forall a b. (a, b) -> b
    snd (([Type], Exp) -> Exp) -> Q ([Type], Exp) -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], Exp) -> Q Exp) -> [Q ([Type], Exp)] -> [Q Exp]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)]
    constraintsAndFields)
           constraintsAndFields :: [Q ([Type], Exp)]
    constraintsAndFields = (BangType -> Q ([Type], Exp)) -> [BangType] -> [Q ([Type], Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map BangType -> Q ([Type], Exp)
    newField [BangType]
    fieldTypes
           newField :: BangType -> Q ([Type], Exp)
           newField :: BangType -> Q ([Type], Exp)
    newField (Bang
    _, Type
    fieldType) = Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    argName) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], Exp)] -> [[Type]]) -> [([Type], Exp)] -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], Exp) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], Exp) -> [Type]) -> [([Type], Exp)] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], Exp)] -> [Type]) -> Q [([Type], Exp)] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)] -> Q [([Type], Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    argName] Q Body
    body []
    genPureClause (RecC Name
    name [VarBangType]
    fields) = do
       Name
    argName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       let body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], (Name, Exp)) -> (Name, Exp)
    forall a b. (a, b) -> b
    snd (([Type], (Name, Exp)) -> (Name, Exp))
    -> Q ([Type], (Name, Exp)) -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], (Name, Exp)) -> Q (Name, Exp))
    -> [Q ([Type], (Name, Exp))] -> [Q (Name, Exp)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))]
    constraintsAndFields
           constraintsAndFields :: [Q ([Type], (Name, Exp))]
    constraintsAndFields = (VarBangType -> Q ([Type], (Name, Exp)))
    -> [VarBangType] -> [Q ([Type], (Name, Exp))]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], (Name, Exp))
    newNamedField [VarBangType]
    fields
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) = ((,) Name
    fieldName (Exp -> (Name, Exp)) -> ([Type], Exp) -> ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Exp) -> ([Type], (Name, Exp)))
    -> Q ([Type], Exp) -> Q ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    argName) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], (Name, Exp))] -> [[Type]])
    -> [([Type], (Name, Exp))]
    -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], (Name, Exp)) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], (Name, Exp)) -> [Type])
    -> [([Type], (Name, Exp))] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], (Name, Exp))] -> [Type])
    -> Q [([Type], (Name, Exp))] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))] -> Q [([Type], (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    argName] Q Body
    body []

    genPureField :: Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField :: Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    fieldType Q Exp
    pureValue Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp
    wrap Q Exp
    pureValue
         AppT Type
    t1 Type
    t2 | Type
    t2 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) (Name -> Type -> [Type]
    constrain ''Rank2.Applicative Type
    t1) (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.pure) Q Exp
    pureValue)
         AppT Type
    t1 Type
    t2 | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    t2 Q Exp
    pureValue (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'pure))
         SigT Type
    ty Type
    _kind -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    ty Q Exp
    pureValue Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    ty Q Exp
    pureValue Q Exp -> Q Exp
    wrap
         Type
    _ -> [Char] -> Q ([Type], Exp)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Cannot create a pure field of type " [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    fieldType)

    genFoldMapClause :: Type -> Con -> Q ([Type], Clause)
    genFoldMapClause :: Type -> Con -> Q ([Type], Clause)
    genFoldMapClause Type
    _ (NormalC Name
    name [BangType]
    fieldTypes) = do
       Name
    f          <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       [Name]
    fieldNames <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x")
       let pats :: [Q Pat]
    pats = [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames)]
           constraintsAndFields :: [Q ([Type], Exp)]
    constraintsAndFields = (Name -> BangType -> Q ([Type], Exp))
    -> [Name] -> [BangType] -> [Q ([Type], Exp)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Name -> BangType -> Q ([Type], Exp)
    newField [Name]
    fieldNames [BangType]
    fieldTypes
           body :: Q Exp
    body | [Name] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    fieldNames = [| mempty |]
                | Bool
    otherwise = (Q Exp -> Q Exp -> Q Exp) -> [Q Exp] -> Q Exp
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    append ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], Exp) -> Exp
    forall a b. (a, b) -> b
    snd (([Type], Exp) -> Exp) -> Q ([Type], Exp) -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], Exp) -> Q Exp) -> [Q ([Type], Exp)] -> [Q Exp]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)]
    constraintsAndFields
           append :: m Exp -> m Exp -> m Exp
    append m Exp
    a m Exp
    b = [| $(m Exp
    a) <> $(m Exp
    b) |]
           newField :: Name -> BangType -> Q ([Type], Exp)
           newField :: Name -> BangType -> Q ([Type], Exp)
    newField Name
    x (Bang
    _, Type
    fieldType) = Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    f Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], Exp)] -> [[Type]]) -> [([Type], Exp)] -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], Exp) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], Exp) -> [Type]) -> [([Type], Exp)] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], Exp)] -> [Type]) -> Q [([Type], Exp)] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)] -> Q [([Type], Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Q Pat]
    pats (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    body) []
    genFoldMapClause Type
    _ (RecC Name
    name [VarBangType]
    fields) = do
       Name
    f <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
       let body :: Q Exp
    body | [VarBangType] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [VarBangType]
    fields = [| mempty |]
                | Bool
    otherwise = (Q Exp -> Q Exp -> Q Exp) -> [Q Exp] -> Q Exp
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    append ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], Exp) -> Exp
    forall a b. (a, b) -> b
    snd (([Type], Exp) -> Exp) -> Q ([Type], Exp) -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], Exp) -> Q Exp) -> [Q ([Type], Exp)] -> [Q Exp]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)]
    constraintsAndFields
           constraintsAndFields :: [Q ([Type], Exp)]
    constraintsAndFields = (VarBangType -> Q ([Type], Exp))
    -> [VarBangType] -> [Q ([Type], Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], Exp)
    newField [VarBangType]
    fields
           append :: m Exp -> m Exp -> m Exp
    append m Exp
    a m Exp
    b = [| $(m Exp
    a) <> $(m Exp
    b) |]
           newField :: VarBangType -> Q ([Type], Exp)
           newField :: VarBangType -> Q ([Type], Exp)
    newField (Name
    fieldName, Bang
    _, Type
    fieldType) = Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    f Type
    fieldType (Name -> Name -> Q Exp
    getFieldOf Name
    x Name
    fieldName) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], Exp)] -> [[Type]]) -> [([Type], Exp)] -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], Exp) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], Exp) -> [Type]) -> [([Type], Exp)] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], Exp)] -> [Type]) -> Q [([Type], Exp)] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)] -> Q [([Type], Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name
    x Name -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat -> m Pat
    `TH.asP` Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    TH.recP Name
    name []] (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    body) []
    genFoldMapClause Type
    instanceType (GadtC [Name
    name] [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Con -> Q ([Type], Clause)
    genFoldMapClause Type
    instanceType (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genFoldMapClause Type
    instanceType (RecGadtC [Name
    name] [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Con -> Q ([Type], Clause)
    genFoldMapClause Type
    instanceType (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genFoldMapClause Type
    instanceType (ForallC [TyVarBndr Specificity]
    _vars [Type]
    _cxt Con
    con) = Type -> Con -> Q ([Type], Clause)
    genFoldMapClause Type
    instanceType Con
    con

    genFoldMapField :: Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField :: Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    funcName Type
    fieldType Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    funcName) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t2 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar ->
                      (,) (Name -> Type -> [Type]
    constrain ''Rank2.Foldable Type
    t1) (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.foldMap) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    funcName)) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar -> Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    funcName Type
    t2 Q Exp
    fieldAccess (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'foldMap))
         SigT Type
    ty Type
    _kind -> Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    funcName Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    funcName Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap
         Type
    _ -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [| mempty |]

    genTraverseClause :: Type -> Con -> Q ([Type], Clause)
    genTraverseClause :: Type -> Con -> Q ([Type], Clause)
    genTraverseClause Type
    _ (NormalC Name
    name []) =
       (,) [] (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP, Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name []] (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB [| pure $(Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name) |]) []
    genTraverseClause Type
    _ (NormalC Name
    name [BangType]
    fieldTypes) = do
       Name
    f          <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       [Name]
    fieldNames <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) ([Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x")
       let pats :: [Q Pat]
    pats = [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    name ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    fieldNames)]
           constraintsAndFields :: [Q ([Type], Exp)]
    constraintsAndFields = (Name -> BangType -> Q ([Type], Exp))
    -> [Name] -> [BangType] -> [Q ([Type], Exp)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Name -> BangType -> Q ([Type], Exp)
    newField [Name]
    fieldNames [BangType]
    fieldTypes
           newFields :: [Q Exp]
    newFields = (Q ([Type], Exp) -> Q Exp) -> [Q ([Type], Exp)] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (([Type], Exp) -> Exp
    forall a b. (a, b) -> b
    snd (([Type], Exp) -> Exp) -> Q ([Type], Exp) -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) [Q ([Type], Exp)]
    constraintsAndFields
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ (Q Exp, Bool) -> Q Exp
    forall a b. (a, b) -> a
    fst ((Q Exp, Bool) -> Q Exp) -> (Q Exp, Bool) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ((Q Exp, Bool) -> Q Exp -> (Q Exp, Bool))
    -> (Q Exp, Bool) -> [Q Exp] -> (Q Exp, Bool)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (Q Exp, Bool) -> Q Exp -> (Q Exp, Bool)
    forall {m :: * -> *}.
    Quote m =>
    (m Exp, Bool) -> m Exp -> (m Exp, Bool)
    apply (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name, Bool
    False) [Q Exp]
    newFields
           apply :: (m Exp, Bool) -> m Exp -> (m Exp, Bool)
    apply (m Exp
    a, Bool
    False) m Exp
    b = ([| $(m Exp
    a) <$> $(m Exp
    b) |], Bool
    True)
           apply (m Exp
    a, Bool
    True) m Exp
    b = ([| $(m Exp
    a) <*> $(m Exp
    b) |], Bool
    True)
           newField :: Name -> BangType -> Q ([Type], Exp)
           newField :: Name -> BangType -> Q ([Type], Exp)
    newField Name
    x (Bang
    _, Type
    fieldType) = Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], Exp)] -> [[Type]]) -> [([Type], Exp)] -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], Exp) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], Exp) -> [Type]) -> [([Type], Exp)] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], Exp)] -> [Type]) -> Q [([Type], Exp)] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)] -> Q [([Type], Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Q Pat]
    pats Q Body
    body []
    genTraverseClause Type
    _ (RecC Name
    name [VarBangType]
    fields) = do
       Name
    f <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
       let constraintsAndFields :: [Q ([Type], Exp)]
    constraintsAndFields = (VarBangType -> Q ([Type], Exp))
    -> [VarBangType] -> [Q ([Type], Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], Exp)
    newField [VarBangType]
    fields
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ (Q Exp, Bool) -> Q Exp
    forall a b. (a, b) -> a
    fst ((Q Exp, Bool) -> Q Exp) -> (Q Exp, Bool) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ ((Q Exp, Bool) -> Q Exp -> (Q Exp, Bool))
    -> (Q Exp, Bool) -> [Q Exp] -> (Q Exp, Bool)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (Q Exp, Bool) -> Q Exp -> (Q Exp, Bool)
    forall {m :: * -> *}.
    Quote m =>
    (m Exp, Bool) -> m Exp -> (m Exp, Bool)
    apply (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    name, Bool
    False) ([Q Exp] -> (Q Exp, Bool)) -> [Q Exp] -> (Q Exp, Bool)
    forall a b. (a -> b) -> a -> b
    $ (([Type], Exp) -> Exp
    forall a b. (a, b) -> b
    snd (([Type], Exp) -> Exp) -> Q ([Type], Exp) -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], Exp) -> Q Exp) -> [Q ([Type], Exp)] -> [Q Exp]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)]
    constraintsAndFields
           apply :: (m Exp, Bool) -> m Exp -> (m Exp, Bool)
    apply (m Exp
    a, Bool
    False) m Exp
    b = ([| $(m Exp
    a) <$> $(m Exp
    b) |], Bool
    True)
           apply (m Exp
    a, Bool
    True) m Exp
    b = ([| $(m Exp
    a) <*> $(m Exp
    b) |], Bool
    True)
           newField :: VarBangType -> Q ([Type], Exp)
           newField :: VarBangType -> Q ([Type], Exp)
    newField (Name
    fieldName, Bang
    _, Type
    fieldType) = Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    f) Type
    fieldType (Name -> Name -> Q Exp
    getFieldOf Name
    x Name
    fieldName) Q Exp -> Q Exp
    forall a. a -> a
    id
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], Exp)] -> [[Type]]) -> [([Type], Exp)] -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], Exp) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], Exp) -> [Type]) -> [([Type], Exp)] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], Exp)] -> [Type]) -> Q [([Type], Exp)] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], Exp)] -> Q [([Type], Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name
    x Name -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat -> m Pat
    `TH.asP` Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    TH.recP Name
    name []] Q Body
    body []
    genTraverseClause Type
    instanceType (GadtC [Name
    name] [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Con -> Q ([Type], Clause)
    genTraverseClause Type
    instanceType (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genTraverseClause Type
    instanceType (RecGadtC [Name
    name] [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT Type
    initType (VarT Name
    tyVar))) =
       do Just (Deriving Name
    tyConName Name
    _tyVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
          Deriving -> Q ()
    forall a. Typeable a => a -> Q ()
    putQ (Name -> Name -> Deriving
    Deriving Name
    tyConName Name
    tyVar)
          let AppT Type
    classType Type
    t = Type
    instanceType
          ([Type] -> [Type]) -> ([Type], Clause) -> ([Type], Clause)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (Type -> Type -> Type -> Type
    renameConstraintVars Type
    t Type
    initType (Type -> Type) -> [Type] -> [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Clause) -> ([Type], Clause))
    -> Q ([Type], Clause) -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type -> Con -> Q ([Type], Clause)
    genTraverseClause Type
    instanceType (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genTraverseClause Type
    instanceType (ForallC [TyVarBndr Specificity]
    _vars [Type]
    _cxt Con
    con) = Type -> Con -> Q ([Type], Clause)
    genTraverseClause Type
    instanceType Con
    con

    genTraverseField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField :: Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField Q Exp
    fun Type
    fieldType Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap Q Exp
    fun) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t2 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar ->
                      (,) (Name -> Type -> [Type]
    constrain ''Rank2.Traversable Type
    t1) (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap [| Rank2.traverse $Q Exp
    fun |]) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField Q Exp
    fun Type
    t2 Q Exp
    fieldAccess (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'traverse))
         SigT Type
    ty Type
    _kind -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField Q Exp
    fun Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField Q Exp
    fun Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap
         Type
    _ -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [| pure $Q Exp
    fieldAccess |]

    genCotraverseClause :: Con -> Q ([Type], Clause)
    genCotraverseClause :: Con -> Q ([Type], Clause)
    genCotraverseClause (NormalC Name
    name []) = Con -> Q ([Type], Clause)
    genCotraverseClause (Name -> [VarBangType] -> Con
    RecC Name
    name [])
    genCotraverseClause (RecC Name
    name [VarBangType]
    fields) = do
       Name
    withName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "w"
       Name
    argName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       let constraintsAndFields :: [Q ([Type], (Name, Exp))]
    constraintsAndFields = (VarBangType -> Q ([Type], (Name, Exp)))
    -> [VarBangType] -> [Q ([Type], (Name, Exp))]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], (Name, Exp))
    newNamedField [VarBangType]
    fields
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], (Name, Exp)) -> (Name, Exp)
    forall a b. (a, b) -> b
    snd (([Type], (Name, Exp)) -> (Name, Exp))
    -> Q ([Type], (Name, Exp)) -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], (Name, Exp)) -> Q (Name, Exp))
    -> [Q ([Type], (Name, Exp))] -> [Q (Name, Exp)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))]
    constraintsAndFields
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) =
              ((,) Name
    fieldName (Exp -> (Name, Exp)) -> ([Type], Exp) -> ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Exp) -> ([Type], (Name, Exp)))
    -> Q ([Type], Exp) -> Q ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name
    -> Q Exp
    -> Q Exp
    -> Type
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genCotraverseField ''Rank2.Distributive (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.cotraverse) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    withName)
                                       Type
    fieldType [| $(Name -> Q Exp
    projectField Name
    fieldName) <$> $(Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    argName) |] Q Exp -> Q Exp
    forall a. a -> a
    id)
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], (Name, Exp))] -> [[Type]])
    -> [([Type], (Name, Exp))]
    -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], (Name, Exp)) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], (Name, Exp)) -> [Type])
    -> [([Type], (Name, Exp))] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], (Name, Exp))] -> [Type])
    -> Q [([Type], (Name, Exp))] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))] -> Q [([Type], (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    withName, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    argName] Q Body
    body []

    genCotraverseTraversableClause :: Con -> Q ([Type], Clause)
    genCotraverseTraversableClause :: Con -> Q ([Type], Clause)
    genCotraverseTraversableClause (NormalC Name
    name []) = Con -> Q ([Type], Clause)
    genCotraverseTraversableClause (Name -> [VarBangType] -> Con
    RecC Name
    name [])
    genCotraverseTraversableClause (RecC Name
    name [VarBangType]
    fields) = do
       Name
    withName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "w"
       Name
    argName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       let constraintsAndFields :: [Q ([Type], (Name, Exp))]
    constraintsAndFields = (VarBangType -> Q ([Type], (Name, Exp)))
    -> [VarBangType] -> [Q ([Type], (Name, Exp))]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], (Name, Exp))
    newNamedField [VarBangType]
    fields
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], (Name, Exp)) -> (Name, Exp)
    forall a b. (a, b) -> b
    snd (([Type], (Name, Exp)) -> (Name, Exp))
    -> Q ([Type], (Name, Exp)) -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], (Name, Exp)) -> Q (Name, Exp))
    -> [Q ([Type], (Name, Exp))] -> [Q (Name, Exp)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))]
    constraintsAndFields
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) =
              ((,) Name
    fieldName (Exp -> (Name, Exp)) -> ([Type], Exp) -> ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Type], Exp) -> ([Type], (Name, Exp)))
    -> Q ([Type], Exp) -> Q ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name
    -> Q Exp
    -> Q Exp
    -> Type
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genCotraverseField ''Rank2.DistributiveTraversable
                                       (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'Rank2.cotraverseTraversable) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    withName) Type
    fieldType
                                       [| $(Name -> Q Exp
    projectField Name
    fieldName) <$> $(Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    argName) |] Q Exp -> Q Exp
    forall a. a -> a
    id)
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], (Name, Exp))] -> [[Type]])
    -> [([Type], (Name, Exp))]
    -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], (Name, Exp)) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], (Name, Exp)) -> [Type])
    -> [([Type], (Name, Exp))] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], (Name, Exp))] -> [Type])
    -> Q [([Type], (Name, Exp))] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))] -> Q [([Type], (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    withName, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    argName] Q Body
    body []

    genDeliverClause :: TypeQ -> Maybe Name -> Con -> Q ([Type], Clause)
    genDeliverClause :: TypeQ -> Maybe Name -> Con -> Q ([Type], Clause)
    genDeliverClause TypeQ
    recType Maybe Name
    typeVar (NormalC Name
    name []) = TypeQ -> Maybe Name -> Con -> Q ([Type], Clause)
    genDeliverClause TypeQ
    recType Maybe Name
    typeVar (Name -> [VarBangType] -> Con
    RecC Name
    name [])
    genDeliverClause TypeQ
    recType Maybe Name
    typeVar (RecC Name
    name [VarBangType]
    fields) = do
       Name
    argName <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "f"
       let constraintsAndFields :: [Q ([Type], (Name, Exp))]
    constraintsAndFields = (VarBangType -> Q ([Type], (Name, Exp)))
    -> [VarBangType] -> [Q ([Type], (Name, Exp))]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> Q ([Type], (Name, Exp))
    newNamedField [VarBangType]
    fields
           body :: Q Body
    body = Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
    recConE Name
    name ([Q (Name, Exp)] -> Q Exp) -> [Q (Name, Exp)] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (([Type], (Name, Exp)) -> (Name, Exp)
    forall a b. (a, b) -> b
    snd (([Type], (Name, Exp)) -> (Name, Exp))
    -> Q ([Type], (Name, Exp)) -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (Q ([Type], (Name, Exp)) -> Q (Name, Exp))
    -> [Q ([Type], (Name, Exp))] -> [Q (Name, Exp)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))]
    constraintsAndFields
           recExp :: Q Exp -> Q Exp
    recExp Q Exp
    g = Q Exp -> (Name -> Q Exp) -> Maybe Name -> Q Exp
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Q Exp
    g (\Name
    v-> [|($Q Exp
    g :: $(TypeQ
    recType) $(Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    varT Name
    v))|]) Maybe Name
    typeVar
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
           newNamedField :: VarBangType -> Q ([Type], (Name, Exp))
    newNamedField (Name
    fieldName, Bang
    _, Type
    fieldType) =
              ((,) Name
    fieldName (Exp -> (Name, Exp)) -> ([Type], Exp) -> ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)
              (([Type], Exp) -> ([Type], (Name, Exp)))
    -> Q ([Type], Exp) -> Q ([Type], (Name, Exp))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name
    -> Type
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genDeliverField ''Rank2.Logistic Type
    fieldType
                   (\Q Exp -> Q Exp
    wrap-> [| \set g-> $(Q Exp -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m (Name, Exp)] -> m Exp
    TH.recUpdE (Q Exp -> Q Exp
    recExp [|g|]) [(,) Name
    fieldName (Exp -> (Name, Exp)) -> Q Exp -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap [| Rank2.apply set |]) (Q Exp -> Name -> Q Exp
    getFieldOfE [|g|] Name
    fieldName)]) |])
                   (\Q Exp -> Q Exp
    wrap-> [| \set g-> $(Q Exp -> [Q (Name, Exp)] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m (Name, Exp)] -> m Exp
    TH.recUpdE (Q Exp -> Q Exp
    recExp [|g|]) [(,) Name
    fieldName (Exp -> (Name, Exp)) -> Q Exp -> Q (Name, Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap [| set |]) (Q Exp -> Name -> Q Exp
    getFieldOfE [|g|] Name
    fieldName)]) |])
                   (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    argName)
                   Q Exp -> Q Exp
    forall a. a -> a
    id
                   Q Exp -> Q Exp
    forall a. a -> a
    id)
       [Type]
    constraints <- ([[Type]] -> [Type]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Type]] -> [Type])
    -> ([([Type], (Name, Exp))] -> [[Type]])
    -> [([Type], (Name, Exp))]
    -> [Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Type], (Name, Exp)) -> [Type]
    forall a b. (a, b) -> a
    fst (([Type], (Name, Exp)) -> [Type])
    -> [([Type], (Name, Exp))] -> [[Type]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>)) ([([Type], (Name, Exp))] -> [Type])
    -> Q [([Type], (Name, Exp))] -> Q [Type]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q ([Type], (Name, Exp))] -> Q [([Type], (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> Q Clause -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    TH.clause [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    argName] Q Body
    body []

    genCotraverseField :: Name -> Q Exp -> Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genCotraverseField :: Name
    -> Q Exp
    -> Q Exp
    -> Type
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genCotraverseField Name
    className Q Exp
    method Q Exp
    fun Type
    fieldType Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap Q Exp
    fun) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t2 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) (Name -> Type -> [Type]
    constrain Name
    className Type
    t1) (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE Q Exp
    method Q Exp
    fun) Q Exp
    fieldAccess
         AppT Type
    t1 Type
    t2 | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar ->
                      Name
    -> Q Exp
    -> Q Exp
    -> Type
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genCotraverseField Name
    className Q Exp
    method Q Exp
    fun Type
    t2 Q Exp
    fieldAccess (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'cotraverse))
         SigT Type
    ty Type
    _kind -> Name
    -> Q Exp
    -> Q Exp
    -> Type
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genCotraverseField Name
    className Q Exp
    method Q Exp
    fun Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap
         ParensT Type
    ty -> Name
    -> Q Exp
    -> Q Exp
    -> Type
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genCotraverseField Name
    className Q Exp
    method Q Exp
    fun Type
    ty Q Exp
    fieldAccess Q Exp -> Q Exp
    wrap

    genDeliverField :: Name
                    -> Type
                    -> ((Q Exp -> Q Exp) -> Q Exp)
                    -> ((Q Exp -> Q Exp) -> Q Exp)
                    -> Q Exp
                    -> (Q Exp -> Q Exp)
                    -> (Q Exp -> Q Exp)
                    -> Q ([Type], Exp)
    genDeliverField :: Name
    -> Type
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genDeliverField Name
    className Type
    fieldType (Q Exp -> Q Exp) -> Q Exp
    fieldUpdate (Q Exp -> Q Exp) -> Q Exp
    subRecordUpdate Q Exp
    arg Q Exp -> Q Exp
    outer Q Exp -> Q Exp
    inner = do
       Just (Deriving Name
    _ Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT Type
    ty Type
    _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp
    outer (Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE [|Compose|] ([|contramap|] Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` (Q Exp -> Q Exp) -> Q Exp
    fieldUpdate Q Exp -> Q Exp
    inner Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    arg))
         AppT Type
    t1 Type
    t2 | Type
    t2 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar ->
                      (,) (Name -> Type -> [Type]
    constrain Name
    className Type
    t1) (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Exp -> Q Exp
    outer (Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE [| Rank2.deliver |] ([|contramap|] Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` (Q Exp -> Q Exp) -> Q Exp
    subRecordUpdate Q Exp -> Q Exp
    inner Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    arg))
         AppT Type
    t1 Type
    t2 | Type
    t1 Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name -> Type
    VarT Name
    typeVar ->
                      Name
    -> Type
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genDeliverField Name
    className Type
    t2 (Q Exp -> Q Exp) -> Q Exp
    fieldUpdate (Q Exp -> Q Exp) -> Q Exp
    subRecordUpdate Q Exp
    arg (Q Exp -> Q Exp
    outer (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'pure)) (Q Exp -> Q Exp
    inner (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'fmap))
         SigT Type
    ty Type
    _kind -> Name
    -> Type
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genDeliverField Name
    className Type
    ty (Q Exp -> Q Exp) -> Q Exp
    fieldUpdate (Q Exp -> Q Exp) -> Q Exp
    subRecordUpdate Q Exp
    arg Q Exp -> Q Exp
    outer Q Exp -> Q Exp
    inner
         ParensT Type
    ty -> Name
    -> Type
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> ((Q Exp -> Q Exp) -> Q Exp)
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> (Q Exp -> Q Exp)
    -> Q ([Type], Exp)
    genDeliverField Name
    className Type
    ty (Q Exp -> Q Exp) -> Q Exp
    fieldUpdate (Q Exp -> Q Exp) -> Q Exp
    subRecordUpdate Q Exp
    arg Q Exp -> Q Exp
    outer Q Exp -> Q Exp
    inner

    renameConstraintVars :: Type -> Type -> Type -> Type
    renameConstraintVars :: Type -> Type -> Type -> Type
    renameConstraintVars (AppT Type
    instanceType (VarT Name
    instanceVar)) (AppT Type
    returnType (VarT Name
    returnVar)) Type
    constrainedType =
       Type -> Type -> Type -> Type
    renameConstraintVars Type
    instanceType Type
    returnType (Name -> Name -> Type -> Type
    renameConstraintVar Name
    returnVar Name
    instanceVar Type
    constrainedType)
    renameConstraintVars (AppT Type
    instanceType Type
    _) (AppT Type
    returnType Type
    _) Type
    constrainedType =
       Type -> Type -> Type -> Type
    renameConstraintVars Type
    instanceType Type
    returnType Type
    constrainedType
    renameConstraintVars Type
    _ Type
    _ Type
    constrainedType = Type
    constrainedType

    renameConstraintVar :: Name -> Name -> Type -> Type
    renameConstraintVar :: Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to (VarT Name
    name)
       | Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    from = Name -> Type
    VarT Name
    to
       | Bool
    otherwise = Name -> Type
    VarT Name
    name
    renameConstraintVar Name
    from Name
    to (AppT Type
    a Type
    b) = Type -> Type -> Type
    AppT (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    a) (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    b)
    renameConstraintVar Name
    from Name
    to (AppKindT Type
    t Type
    k) = Type -> Type -> Type
    AppT (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    t) (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    k)
    renameConstraintVar Name
    from Name
    to (InfixT Type
    a Name
    op Type
    b) = Type -> Name -> Type -> Type
    InfixT (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    a) Name
    op (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    b)
    renameConstraintVar Name
    from Name
    to (UInfixT Type
    a Name
    op Type
    b) = Type -> Name -> Type -> Type
    UInfixT (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    a) Name
    op (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    b)
    renameConstraintVar Name
    from Name
    to (SigT Type
    t Type
    k) = Type -> Type -> Type
    SigT (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    t) (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    k)
    renameConstraintVar Name
    from Name
    to (ParensT Type
    t) = Type -> Type
    ParensT (Name -> Name -> Type -> Type
    renameConstraintVar Name
    from Name
    to Type
    t)
    renameConstraintVar Name
    _ Name
    _ Type
    t = Type
    t

    projectField :: Name -> Q Exp
    projectField :: Name -> Q Exp
    projectField Name
    field = do
    #if MIN_VERSION_template_haskell(2,19,0)
      Bool
    dotty <- Extension -> Q Bool
    TH.isExtEnabled Extension
    TH.OverloadedRecordDot
      if Bool
    dotty
         then NonEmpty [Char] -> Q Exp
    forall (m :: * -> *). Quote m => NonEmpty [Char] -> m Exp
    TH.projectionE ([Char] -> NonEmpty [Char]
    forall a. a -> NonEmpty a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Char] -> NonEmpty [Char]) -> [Char] -> NonEmpty [Char]
    forall a b. (a -> b) -> a -> b
    $ Name -> [Char]
    TH.nameBase Name
    field)
         else Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    field
    #else
      varE field
    #endif

    getFieldOf :: Name -> Name -> Q Exp
    getFieldOf :: Name -> Name -> Q Exp
    getFieldOf = Q Exp -> Name -> Q Exp
    getFieldOfE (Q Exp -> Name -> Q Exp)
    -> (Name -> Q Exp) -> Name -> Name -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE

    getFieldOfE :: Q Exp -> Name -> Q Exp
    getFieldOfE :: Q Exp -> Name -> Q Exp
    getFieldOfE Q Exp
    record Name
    field = do
    #if MIN_VERSION_template_haskell(2,19,0)
      Bool
    dotty <- Extension -> Q Bool
    TH.isExtEnabled Extension
    TH.OverloadedRecordDot
      if Bool
    dotty
         then Q Exp -> [Char] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [Char] -> m Exp
    TH.getFieldE Q Exp
    record (Name -> [Char]
    TH.nameBase Name
    field)
         else Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    field) Q Exp
    record
    #else
      appE (varE field) record
    #endif

    constrain :: Name -> Type -> [Type]
    constrain :: Name -> Type -> [Type]
    constrain Name
    _ ConT{} = []
    constrain Name
    cls Type
    t = [Name -> Type
    ConT Name
    cls Type -> Type -> Type
    `AppT` Type
    t]

    #if MIN_VERSION_template_haskell(2,17,0)
    binder :: Name -> TyVarBndr TH.Specificity
    binder :: Name -> TyVarBndr Specificity
    binder Name
    name = Name -> Specificity -> TyVarBndr Specificity
    forall flag. Name -> flag -> TyVarBndr flag
    TH.PlainTV Name
    name Specificity
    TH.SpecifiedSpec
    #else
    binder :: Name -> TyVarBndr
    binder = TH.PlainTV
    #endif