    -- | 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 TemplateHaskell #-}
    -- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial

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

    import Control.Applicative (liftA2, liftA3)
    import Control.Monad (replicateM)
    import Data.Distributive (cotraverse)
    import Data.Monoid ((<>))
    import Language.Haskell.TH
    import Language.Haskell.TH.Syntax (BangType, VarBangType, getQ, putQ)

    import qualified Rank2

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

    deriveAll :: Name -> Q [Dec]
    deriveAll :: Name -> Q [Dec]
    deriveAll ty :: Name
    ty = ((Name -> Q [Dec]) -> Q [Dec] -> Q [Dec])
    -> Q [Dec] -> [Name -> Q [Dec]] -> Q [Dec]
    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 (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]
       where f :: (Name -> f b) -> f b -> f b
    f derive :: Name -> f b
    derive rest :: 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> f b
    rest

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

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

    unsafeDeriveApply :: Name -> Q [Dec]
    unsafeDeriveApply :: Name -> Q [Dec]
    unsafeDeriveApply ty :: Name
    ty = do
       (instanceType :: TypeQ
    instanceType, cs :: [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Apply Name
    ty
       (constraints :: [Type]
    constraints, dec :: Dec
    dec) <- [Con] -> Q ([Type], Dec)
    genApUnsafely [Con]
    cs
       [Q Dec] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [CxtQ -> TypeQ -> [Q Dec] -> Q Dec
    instanceD ([TypeQ] -> CxtQ
    cxt ([TypeQ] -> CxtQ) -> [TypeQ] -> CxtQ
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    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
    pragInlD '(Rank2.<*>) Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases,
                  Name -> Inline -> RuleMatch -> Phases -> Q Dec
    pragInlD 'Rank2.liftA2 Inline
    Inlinable RuleMatch
    FunLike Phases
    AllPhases]]

    deriveApplicative :: Name -> Q [Dec]
    deriveApplicative :: Name -> Q [Dec]
    deriveApplicative ty :: Name
    ty = do
       (instanceType :: TypeQ
    instanceType, cs :: [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Applicative Name
    ty
       (constraints :: [Type]
    constraints, dec :: 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)
    sequence [CxtQ -> TypeQ -> [Q Dec] -> Q Dec
    instanceD ([TypeQ] -> CxtQ
    cxt ([TypeQ] -> CxtQ) -> [TypeQ] -> CxtQ
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, Name -> Inline -> RuleMatch -> Phases -> Q Dec
    pragInlD 'Rank2.pure Inline
    Inline RuleMatch
    FunLike Phases
    AllPhases]]

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

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

    deriveDistributive :: Name -> Q [Dec]
    deriveDistributive :: Name -> Q [Dec]
    deriveDistributive ty :: Name
    ty = do
       (instanceType :: TypeQ
    instanceType, cs :: [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.Distributive Name
    ty
       (constraints :: [Type]
    constraints, dec :: 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)
    sequence [CxtQ -> TypeQ -> [Q Dec] -> Q Dec
    instanceD ([TypeQ] -> CxtQ
    cxt ([TypeQ] -> CxtQ) -> [TypeQ] -> CxtQ
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType
                 [Dec -> Q Dec
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec, Name -> Inline -> RuleMatch -> Phases -> Q Dec
    pragInlD 'Rank2.cotraverse Inline
    Inline RuleMatch
    FunLike Phases
    AllPhases]]

    deriveDistributiveTraversable :: Name -> Q [Dec]
    deriveDistributiveTraversable :: Name -> Q [Dec]
    deriveDistributiveTraversable ty :: Name
    ty = do
       (instanceType :: TypeQ
    instanceType, cs :: [Con]
    cs) <- Name -> Name -> Q (TypeQ, [Con])
    reifyConstructors ''Rank2.DistributiveTraversable Name
    ty
       (constraints :: [Type]
    constraints, dec :: 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)
    sequence [CxtQ -> TypeQ -> [Q Dec] -> Q Dec
    instanceD ([TypeQ] -> CxtQ
    cxt ([TypeQ] -> CxtQ) -> [TypeQ] -> CxtQ
    forall a b. (a -> b) -> a -> b
    $ (Type -> TypeQ) -> [Type] -> [TypeQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> TypeQ
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Type]
    constraints) TypeQ
    instanceType [Dec -> Q Dec
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec]]

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

       let (KindedTV tyVar :: Name
    tyVar (AppT (AppT ArrowT StarT) StarT)) = [TyVarBndr] -> TyVarBndr
    forall a. [a] -> a
    last [TyVarBndr]
    tyVars
           instanceType :: TypeQ
    instanceType           = Name -> TypeQ
    conT Name
    cls TypeQ -> TypeQ -> TypeQ
    `appT` (TypeQ -> TyVarBndr -> TypeQ) -> TypeQ -> [TyVarBndr] -> TypeQ
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl TypeQ -> TyVarBndr -> TypeQ
    apply (Name -> TypeQ
    conT Name
    tyConName) ([TyVarBndr] -> [TyVarBndr]
    forall a. [a] -> [a]
    init [TyVarBndr]
    tyVars)
           apply :: TypeQ -> TyVarBndr -> TypeQ
    apply t :: TypeQ
    t (PlainTV name :: Name
    name)    = TypeQ -> TypeQ -> TypeQ
    appT TypeQ
    t (Name -> TypeQ
    varT Name
    name)
           apply t :: TypeQ
    t (KindedTV name :: Name
    name _) = TypeQ -> TypeQ -> TypeQ
    appT TypeQ
    t (Name -> TypeQ
    varT Name
    name)

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

    genFmap :: [Con] -> Q ([Type], Dec)
    genFmap :: [Con] -> Q ([Type], Dec)
    genFmap cs :: [Con]
    cs = do (constraints :: [[Type]]
    constraints, clauses :: [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)
    mapM Con -> Q ([Type], Clause)
    genFmapClause [Con]
    cs
                    ([Type], Dec) -> Q ([Type], Dec)
    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 :: [Con] -> Q ([Type], Dec)
    genAp :: [Con] -> Q ([Type], Dec)
    genAp [con :: Con
    con] = do (constraints :: [Type]
    constraints, clause :: Clause
    clause) <- Bool -> Con -> Q ([Type], Clause)
    genApClause Bool
    False Con
    con
                     ([Type], Dec) -> Q ([Type], Dec)
    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
    con] = Name -> [ClauseQ] -> Q Dec
    funD 'Rank2.liftA2 [Bool -> Con -> ClauseQ
    genLiftA2Clause Bool
    False Con
    con]

    genLiftA3 :: [Con] -> Q Dec
    genLiftA3 :: [Con] -> Q Dec
    genLiftA3 [con :: Con
    con] = Name -> [ClauseQ] -> Q Dec
    funD 'Rank2.liftA3 [Bool -> Con -> ClauseQ
    genLiftA3Clause Bool
    False Con
    con]

    genApUnsafely :: [Con] -> Q ([Type], Dec)
    genApUnsafely :: [Con] -> Q ([Type], Dec)
    genApUnsafely cons :: [Con]
    cons = do (constraints :: [[Type]]
    constraints, clauses :: [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)
    mapM (Bool -> Con -> Q ([Type], Clause)
    genApClause Bool
    True) [Con]
    cons
                            ([Type], Dec) -> Q ([Type], Dec)
    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 cons :: [Con]
    cons = Name -> [ClauseQ] -> Q Dec
    funD 'Rank2.liftA2 (Bool -> Con -> ClauseQ
    genLiftA2Clause Bool
    True (Con -> ClauseQ) -> [Con] -> [ClauseQ]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Con]
    cons)

    genLiftA3Unsafely :: [Con] -> Q Dec
    genLiftA3Unsafely :: [Con] -> Q Dec
    genLiftA3Unsafely cons :: [Con]
    cons = Name -> [ClauseQ] -> Q Dec
    funD 'Rank2.liftA3 (Bool -> Con -> ClauseQ
    genLiftA3Clause Bool
    True (Con -> ClauseQ) -> [Con] -> [ClauseQ]
    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 cs :: [Con]
    cs = do (constraints :: [[Type]]
    constraints, clauses :: [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)
    mapM Con -> Q ([Type], Clause)
    genPureClause [Con]
    cs
                    ([Type], Dec) -> Q ([Type], Dec)
    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 :: [Con] -> Q ([Type], Dec)
    genFoldMap :: [Con] -> Q ([Type], Dec)
    genFoldMap cs :: [Con]
    cs = do (constraints :: [[Type]]
    constraints, clauses :: [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)
    mapM Con -> Q ([Type], Clause)
    genFoldMapClause [Con]
    cs
                       ([Type], Dec) -> Q ([Type], Dec)
    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 :: [Con] -> Q ([Type], Dec)
    genTraverse :: [Con] -> Q ([Type], Dec)
    genTraverse cs :: [Con]
    cs = do (constraints :: [[Type]]
    constraints, clauses :: [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)
    mapM Con -> Q ([Type], Clause)
    genTraverseClause [Con]
    cs
                        ([Type], Dec) -> Q ([Type], Dec)
    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
    con] = do (constraints :: [Type]
    constraints, clause :: Clause
    clause) <- Con -> Q ([Type], Clause)
    genCotraverseClause Con
    con
                             ([Type], Dec) -> Q ([Type], Dec)
    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
    con] = do (constraints :: [Type]
    constraints, clause :: Clause
    clause) <- Con -> Q ([Type], Clause)
    genCotraverseTraversableClause Con
    con
                                        ([Type], Dec) -> Q ([Type], Dec)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Type]
    constraints, Name -> [Clause] -> Dec
    FunD 'Rank2.cotraverseTraversable [Clause
    clause])

    genFmapClause :: Con -> Q ([Type], Clause)
    genFmapClause :: Con -> Q ([Type], Clause)
    genFmapClause (NormalC name :: Name
    name fieldTypes :: [BangType]
    fieldTypes) = do
       Name
    f          <- String -> Q Name
    newName "f"
       [Name]
    fieldNames <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "x")
       let pats :: [PatQ]
    pats = [Name -> PatQ
    varP Name
    f, Name -> [PatQ] -> PatQ
    conP Name
    name ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    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 :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q 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 x :: Name
    x (_, fieldType :: Type
    fieldType) = Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFmapField (Name -> Q Exp
    varE Name
    f) Type
    fieldType (Name -> Q 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)] -> CxtQ
    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)
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ]
    pats BodyQ
    body []
    genFmapClause (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    f <- String -> Q Name
    newName "f"
       Name
    x <- String -> Q Name
    newName "x"
       let body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q 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 (fieldName :: Name
    fieldName, _, fieldType :: 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
    varE Name
    f) Type
    fieldType (Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE Name
    fieldName) (Name -> Q 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], (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))] -> CxtQ
    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)
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    f, PatQ -> PatQ
    bangP (Name -> PatQ
    varP Name
    x)] BodyQ
    body []
    genFmapClause (GadtC [name :: Name
    name] fieldTypes :: [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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)
          Con -> Q ([Type], Clause)
    genFmapClause (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genFmapClause (RecGadtC [name :: Name
    name] fields :: [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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)
          Con -> Q ([Type], Clause)
    genFmapClause (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genFmapClause (ForallC _vars :: [TyVarBndr]
    _vars _cxt :: [Type]
    _cxt con :: Con
    con) = Con -> Q ([Type], Clause)
    genFmapClause 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 fun :: Q Exp
    fun fieldType :: Type
    fieldType fieldAccess :: Q Exp
    fieldAccess wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _  | 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
    appE (Q Exp -> Q Exp
    wrap Q Exp
    fun) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Q Exp -> Q Exp
    wrap [| ($fun Rank2.<$>) |]) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q Exp
    varE '(<$>)))
         SigT ty :: Type
    ty _kind :: 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 ty :: 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
         _ -> (,) [] (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 -> ClauseQ
    genLiftA2Clause unsafely :: Bool
    unsafely (NormalC name :: Name
    name fieldTypes :: [BangType]
    fieldTypes) = do
       Name
    f          <- String -> Q Name
    newName "f"
       [Name]
    fieldNames1 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "x")
       Name
    y <- String -> Q Name
    newName "y"
       [Name]
    fieldNames2 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "y")
       let pats :: [PatQ]
    pats = [Name -> PatQ
    varP Name
    f, Name -> [PatQ] -> PatQ
    conP Name
    name ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    fieldNames1), Name -> PatQ
    varP Name
    y]
           body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q 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 (x :: Name
    x, y :: Name
    y) (_, fieldType :: Type
    fieldType) = Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely (Name -> Q Exp
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    varE Name
    x) (Name -> Q Exp
    varE Name
    y) Q Exp -> Q Exp
    forall a. a -> a
    id
       [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ]
    pats BodyQ
    body [PatQ -> BodyQ -> [Q Dec] -> Q Dec
    valD (Name -> [PatQ] -> PatQ
    conP Name
    name ([PatQ] -> PatQ) -> [PatQ] -> PatQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    fieldNames2) (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE Name
    y) []]
    genLiftA2Clause unsafely :: Bool
    unsafely (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    f <- String -> Q Name
    newName "f"
       Name
    x <- String -> Q Name
    newName "x"
       Name
    y <- String -> Q Name
    newName "y"
       let body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q 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 (fieldName :: Name
    fieldName, _, fieldType :: Type
    fieldType) =
              Name -> Q Exp -> Q (Name, Exp)
    fieldExp Name
    fieldName (Bool
    -> Q Exp -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q Exp
    genLiftA2Field Bool
    unsafely (Name -> Q Exp
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    getFieldOf Name
    x) (Name -> Q Exp
    getFieldOf Name
    y) Q Exp -> Q Exp
    forall a. a -> a
    id)
              where getFieldOf :: Name -> Q Exp
    getFieldOf = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE Name
    fieldName) (Q Exp -> Q Exp) -> (Name -> Q Exp) -> Name -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Q Exp
    varE
       [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    f, PatQ -> PatQ
    bangP (Name -> PatQ
    varP Name
    x), Name -> PatQ
    varP Name
    y] BodyQ
    body []
    genLiftA2Clause unsafely :: Bool
    unsafely (GadtC [name :: Name
    name] fieldTypes :: [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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 -> ClauseQ
    genLiftA2Clause Bool
    unsafely (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genLiftA2Clause unsafely :: Bool
    unsafely (RecGadtC [name :: Name
    name] fields :: [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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 -> ClauseQ
    genLiftA2Clause Bool
    unsafely (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genLiftA2Clause unsafely :: Bool
    unsafely (ForallC _vars :: [TyVarBndr]
    _vars _cxt :: [Type]
    _cxt con :: Con
    con) = Bool -> Con -> ClauseQ
    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 unsafely :: Bool
    unsafely fun :: Q Exp
    fun fieldType :: Type
    fieldType field1Access :: Q Exp
    field1Access field2Access :: Q Exp
    field2Access wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _ | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(wrap fun) $field1Access $field2Access |]
         AppT _ ty :: Type
    ty | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(wrap $ appE (varE 'Rank2.liftA2) fun) $field1Access $field2Access |]
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q 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 ty :: Type
    ty _kind :: 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 ty :: 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
         _ | Bool
    unsafely -> [| error "Cannot apply liftA2 to field" |]
           | Bool
    otherwise -> String -> Q Exp
    forall a. HasCallStack => String -> a
    error ("Cannot apply liftA2 to field of type " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> String
    forall a. Show a => a -> String
    show Type
    fieldType)

    genLiftA3Clause :: Bool -> Con -> Q Clause
    genLiftA3Clause :: Bool -> Con -> ClauseQ
    genLiftA3Clause unsafely :: Bool
    unsafely (NormalC name :: Name
    name fieldTypes :: [BangType]
    fieldTypes) = do
       Name
    f          <- String -> Q Name
    newName "f"
       [Name]
    fieldNames1 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "x")
       Name
    y <- String -> Q Name
    newName "y"
       Name
    z <- String -> Q Name
    newName "z"
       [Name]
    fieldNames2 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "y")
       [Name]
    fieldNames3 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "z")
       let pats :: [PatQ]
    pats = [Name -> PatQ
    varP Name
    f, Name -> [PatQ] -> PatQ
    conP Name
    name ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    fieldNames1), Name -> PatQ
    varP Name
    y, Name -> PatQ
    varP Name
    z]
           body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q 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 (x :: Name
    x, y :: Name
    y, z :: Name
    z) (_, fieldType :: Type
    fieldType) = Bool
    -> Q Exp
    -> Type
    -> Q Exp
    -> Q Exp
    -> Q Exp
    -> (Q Exp -> Q Exp)
    -> Q Exp
    genLiftA3Field Bool
    unsafely (Name -> Q Exp
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    varE Name
    x) (Name -> Q Exp
    varE Name
    y) (Name -> Q Exp
    varE Name
    z) Q Exp -> Q Exp
    forall a. a -> a
    id
       [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ]
    pats BodyQ
    body [PatQ -> BodyQ -> [Q Dec] -> Q Dec
    valD (Name -> [PatQ] -> PatQ
    conP Name
    name ([PatQ] -> PatQ) -> [PatQ] -> PatQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    fieldNames2) (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE Name
    y) [],
                         PatQ -> BodyQ -> [Q Dec] -> Q Dec
    valD (Name -> [PatQ] -> PatQ
    conP Name
    name ([PatQ] -> PatQ) -> [PatQ] -> PatQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    fieldNames3) (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE Name
    z) []]
    genLiftA3Clause unsafely :: Bool
    unsafely (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    f <- String -> Q Name
    newName "f"
       Name
    x <- String -> Q Name
    newName "x"
       Name
    y <- String -> Q Name
    newName "y"
       Name
    z <- String -> Q Name
    newName "z"
       let body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q 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 (fieldName :: Name
    fieldName, _, fieldType :: Type
    fieldType) =
              Name -> Q Exp -> Q (Name, Exp)
    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
    varE Name
    f) Type
    fieldType (Name -> Q Exp
    getFieldOf Name
    x) (Name -> Q Exp
    getFieldOf Name
    y) (Name -> Q Exp
    getFieldOf Name
    z) Q Exp -> Q Exp
    forall a. a -> a
    id)
              where getFieldOf :: Name -> Q Exp
    getFieldOf = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE Name
    fieldName) (Q Exp -> Q Exp) -> (Name -> Q Exp) -> Name -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Q Exp
    varE
       [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    f, PatQ -> PatQ
    bangP (Name -> PatQ
    varP Name
    x), Name -> PatQ
    varP Name
    y, Name -> PatQ
    varP Name
    z] BodyQ
    body []
    genLiftA3Clause unsafely :: Bool
    unsafely (GadtC [name :: Name
    name] fieldTypes :: [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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 -> ClauseQ
    genLiftA3Clause Bool
    unsafely (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genLiftA3Clause unsafely :: Bool
    unsafely (RecGadtC [name :: Name
    name] fields :: [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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 -> ClauseQ
    genLiftA3Clause Bool
    unsafely (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genLiftA3Clause unsafely :: Bool
    unsafely (ForallC _vars :: [TyVarBndr]
    _vars _cxt :: [Type]
    _cxt con :: Con
    con) = Bool -> Con -> ClauseQ
    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 unsafely :: Bool
    unsafely fun :: Q Exp
    fun fieldType :: Type
    fieldType field1Access :: Q Exp
    field1Access field2Access :: Q Exp
    field2Access field3Access :: Q Exp
    field3Access wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _
            | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(wrap fun) $(field1Access) $(field2Access) $(field3Access) |]
         AppT _ ty :: Type
    ty
            | Type
    ty Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Type
    VarT Name
    typeVar -> [| $(wrap $ appE (varE 'Rank2.liftA3) fun) $(field1Access) $(field2Access) $(field3Access) |]
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q 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 ty :: Type
    ty _kind :: 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 ty :: 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
         _ | Bool
    unsafely -> [| error "Cannot apply liftA3 to field" |]
           | Bool
    otherwise -> String -> Q Exp
    forall a. HasCallStack => String -> a
    error ("Cannot apply liftA3 to field of type " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> String
    forall a. Show a => a -> String
    show Type
    fieldType)

    genApClause :: Bool -> Con -> Q ([Type], Clause)
    genApClause :: Bool -> Con -> Q ([Type], Clause)
    genApClause unsafely :: Bool
    unsafely (NormalC name :: Name
    name fieldTypes :: [BangType]
    fieldTypes) = do
       [Name]
    fieldNames1 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "x")
       [Name]
    fieldNames2 <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "y")
       Name
    rhsName <- String -> Q Name
    newName "rhs"
       let pats :: [PatQ]
    pats = [Name -> [PatQ] -> PatQ
    conP Name
    name ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    fieldNames1), Name -> PatQ
    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 :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q 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 (x :: Name
    x, y :: Name
    y) (_, fieldType :: Type
    fieldType) = Bool
    -> Type -> Q Exp -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genApField Bool
    unsafely Type
    fieldType (Name -> Q Exp
    varE Name
    x) (Name -> Q 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)] -> CxtQ
    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)
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ]
    pats BodyQ
    body [PatQ -> BodyQ -> [Q Dec] -> Q Dec
    valD (Name -> [PatQ] -> PatQ
    conP Name
    name ([PatQ] -> PatQ) -> [PatQ] -> PatQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    fieldNames2) (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE Name
    rhsName) []]
    genApClause unsafely :: Bool
    unsafely (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    x <- String -> Q Name
    newName "x"
       Name
    y <- String -> Q Name
    newName "y"
       let body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q 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 (fieldName :: Name
    fieldName, _, fieldType :: 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 -> Q Exp
    getFieldOf Name
    x) (Name -> Q Exp
    getFieldOf Name
    y) Q Exp -> Q Exp
    forall a. a -> a
    id
              where getFieldOf :: Name -> Q Exp
    getFieldOf = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE Name
    fieldName) (Q Exp -> Q Exp) -> (Name -> Q Exp) -> Name -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Q Exp
    varE
       [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))] -> CxtQ
    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)
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    x, PatQ -> PatQ
    bangP (Name -> PatQ
    varP Name
    y)] BodyQ
    body []
    genApClause unsafely :: Bool
    unsafely (GadtC [name :: Name
    name] fieldTypes :: [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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 ([Type], Clause)
    genApClause Bool
    unsafely (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genApClause unsafely :: Bool
    unsafely (RecGadtC [name :: Name
    name] fields :: [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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 ([Type], Clause)
    genApClause Bool
    unsafely (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genApClause unsafely :: Bool
    unsafely (ForallC _vars :: [TyVarBndr]
    _vars _cxt :: [Type]
    _cxt con :: Con
    con) = Bool -> Con -> Q ([Type], Clause)
    genApClause Bool
    unsafely 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 unsafely :: Bool
    unsafely fieldType :: Type
    fieldType field1Access :: Q Exp
    field1Access field2Access :: Q Exp
    field2Access wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _ | 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
    <$> [| $(wrap (varE 'Rank2.apply)) $(field1Access) $(field2Access) |]
         AppT t1 :: Type
    t1 t2 :: 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
    <$> [| $(wrap (varE 'Rank2.ap)) $(field1Access) $(field2Access) |]
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q 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 ty :: Type
    ty _kind :: 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 ty :: 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
         _ | Bool
    unsafely -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [| error ("Cannot apply ap to field" <> $(pure $ LitE $ StringL $ show fieldType)) |]
           | Bool
    otherwise -> String -> Q ([Type], Exp)
    forall a. HasCallStack => String -> a
    error ("Cannot apply ap to field of type " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> String
    forall a. Show a => a -> String
    show Type
    fieldType)

    genPureClause :: Con -> Q ([Type], Clause)
    genPureClause :: Con -> Q ([Type], Clause)
    genPureClause (NormalC name :: Name
    name fieldTypes :: [BangType]
    fieldTypes) = do
       Name
    argName <- String -> Q Name
    newName "f"
       let body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ [Q Exp] -> Q Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q 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 (_, fieldType :: Type
    fieldType) = Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    fieldType (Name -> Q 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)] -> CxtQ
    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)
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    argName] BodyQ
    body []
    genPureClause (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    argName <- String -> Q Name
    newName "f"
       let body :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q 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 (fieldName :: Name
    fieldName, _, fieldType :: 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
    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))] -> CxtQ
    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)
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    argName] BodyQ
    body []

    genPureField :: Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField :: Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField fieldType :: Type
    fieldType pureValue :: Q Exp
    pureValue wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _ | 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 t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q Exp
    varE 'Rank2.pure) Q Exp
    pureValue)
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q Exp
    varE 'pure))
         SigT ty :: Type
    ty _kind :: Type
    _kind -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    ty Q Exp
    pureValue Q Exp -> Q Exp
    wrap
         ParensT ty :: Type
    ty -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genPureField Type
    ty Q Exp
    pureValue Q Exp -> Q Exp
    wrap
         _ -> String -> Q ([Type], Exp)
    forall a. HasCallStack => String -> a
    error ("Cannot create a pure field of type " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Type -> String
    forall a. Show a => a -> String
    show Type
    fieldType)

    genFoldMapClause :: Con -> Q ([Type], Clause)
    genFoldMapClause :: Con -> Q ([Type], Clause)
    genFoldMapClause (NormalC name :: Name
    name fieldTypes :: [BangType]
    fieldTypes) = do
       Name
    f          <- String -> Q Name
    newName "f"
       [Name]
    fieldNames <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "x")
       let pats :: [PatQ]
    pats = [Name -> PatQ
    varP Name
    f, Name -> [PatQ] -> PatQ
    conP Name
    name ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    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 (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    fieldNames = [| mempty |]
                | Bool
    otherwise = (Q Exp -> Q Exp -> Q Exp) -> [Q Exp] -> Q Exp
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Q Exp -> Q Exp -> Q 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 :: Q Exp -> Q Exp -> Q Exp
    append a :: Q Exp
    a b :: Q Exp
    b = [| $(a) <> $(b) |]
           newField :: Name -> BangType -> Q ([Type], Exp)
           newField :: Name -> BangType -> Q ([Type], Exp)
    newField x :: Name
    x (_, fieldType :: Type
    fieldType) = Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    f Type
    fieldType (Name -> Q 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)] -> CxtQ
    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)
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ]
    pats (Q Exp -> BodyQ
    normalB Q Exp
    body) []
    genFoldMapClause (RecC _name :: Name
    _name fields :: [VarBangType]
    fields) = do
       Name
    f <- String -> Q Name
    newName "f"
       Name
    x <- String -> Q Name
    newName "x"
       let body :: Q Exp
    body | [VarBangType] -> 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 (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Q Exp -> Q Exp -> Q 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 :: Q Exp -> Q Exp -> Q Exp
    append a :: Q Exp
    a b :: Q Exp
    b = [| $(a) <> $(b) |]
           newField :: VarBangType -> Q ([Type], Exp)
           newField :: VarBangType -> Q ([Type], Exp)
    newField (fieldName :: Name
    fieldName, _, fieldType :: Type
    fieldType) = Name -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genFoldMapField Name
    f Type
    fieldType (Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE Name
    fieldName) (Name -> Q 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)] -> CxtQ
    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)
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    f, PatQ -> PatQ
    bangP (Name -> PatQ
    varP Name
    x)] (Q Exp -> BodyQ
    normalB Q Exp
    body) []
    genFoldMapClause (GadtC [name :: Name
    name] fieldTypes :: [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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)
          Con -> Q ([Type], Clause)
    genFoldMapClause (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genFoldMapClause (RecGadtC [name :: Name
    name] fields :: [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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)
          Con -> Q ([Type], Clause)
    genFoldMapClause (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genFoldMapClause (ForallC _vars :: [TyVarBndr]
    _vars _cxt :: [Type]
    _cxt con :: Con
    con) = Con -> Q ([Type], Clause)
    genFoldMapClause 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 funcName :: Name
    funcName fieldType :: Type
    fieldType fieldAccess :: Q Exp
    fieldAccess wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _ | 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
    appE (Q Exp -> Q Exp
    wrap (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE Name
    funcName) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    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
    appE (Name -> Q Exp
    varE 'Rank2.foldMap) (Name -> Q Exp
    varE Name
    funcName)) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q Exp
    varE 'foldMap))
         SigT ty :: Type
    ty _kind :: 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 ty :: 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
         _ -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [| mempty |]

    genTraverseClause :: Con -> Q ([Type], Clause)
    genTraverseClause :: Con -> Q ([Type], Clause)
    genTraverseClause (NormalC name :: Name
    name []) =
       (,) [] (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ
    wildP, PatQ
    wildP] (Q Exp -> BodyQ
    normalB [| pure $(conE name) |]) []
    genTraverseClause (NormalC name :: Name
    name fieldTypes :: [BangType]
    fieldTypes) = do
       Name
    f          <- String -> Q Name
    newName "f"
       [Name]
    fieldNames <- Int -> Q Name -> Q [Name]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM ([BangType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [BangType]
    fieldTypes) (String -> Q Name
    newName "x")
       let pats :: [PatQ]
    pats = [Name -> PatQ
    varP Name
    f, Name -> [PatQ] -> PatQ
    conP Name
    name ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    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 :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    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 (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (Q Exp, Bool) -> Q Exp -> (Q Exp, Bool)
    apply (Name -> Q Exp
    conE Name
    name, Bool
    False) [Q Exp]
    newFields
           apply :: (Q Exp, Bool) -> Q Exp -> (Q Exp, Bool)
    apply (a :: Q Exp
    a, False) b :: Q Exp
    b = ([| $(a) <$> $(b) |], Bool
    True)
           apply (a :: Q Exp
    a, True) b :: Q Exp
    b = ([| $(a) <*> $(b) |], Bool
    True)
           newField :: Name -> BangType -> Q ([Type], Exp)
           newField :: Name -> BangType -> Q ([Type], Exp)
    newField x :: Name
    x (_, fieldType :: Type
    fieldType) = Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField (Name -> Q Exp
    varE Name
    f) Type
    fieldType (Name -> Q 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)] -> CxtQ
    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)
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ]
    pats BodyQ
    body []
    genTraverseClause (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    f <- String -> Q Name
    newName "f"
       Name
    x <- String -> Q Name
    newName "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 :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    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 (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (Q Exp, Bool) -> Q Exp -> (Q Exp, Bool)
    apply (Name -> Q 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 :: (Q Exp, Bool) -> Q Exp -> (Q Exp, Bool)
    apply (a :: Q Exp
    a, False) b :: Q Exp
    b = ([| $(a) <$> $(b) |], Bool
    True)
           apply (a :: Q Exp
    a, True) b :: Q Exp
    b = ([| $(a) <*> $(b) |], Bool
    True)
           newField :: VarBangType -> Q ([Type], Exp)
           newField :: VarBangType -> Q ([Type], Exp)
    newField (fieldName :: Name
    fieldName, _, fieldType :: Type
    fieldType) = Q Exp -> Type -> Q Exp -> (Q Exp -> Q Exp) -> Q ([Type], Exp)
    genTraverseField (Name -> Q Exp
    varE Name
    f) Type
    fieldType (Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE Name
    fieldName) (Name -> Q 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)] -> CxtQ
    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)
    sequence [Q ([Type], Exp)]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    f, PatQ -> PatQ
    bangP (Name -> PatQ
    varP Name
    x)] BodyQ
    body []
    genTraverseClause (GadtC [name :: Name
    name] fieldTypes :: [BangType]
    fieldTypes _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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)
          Con -> Q ([Type], Clause)
    genTraverseClause (Name -> [BangType] -> Con
    NormalC Name
    name [BangType]
    fieldTypes)
    genTraverseClause (RecGadtC [name :: Name
    name] fields :: [VarBangType]
    fields _resultType :: Type
    _resultType@(AppT _ (VarT tyVar :: Name
    tyVar))) =
       do Just (Deriving tyConName :: Name
    tyConName _tyVar :: 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)
          Con -> Q ([Type], Clause)
    genTraverseClause (Name -> [VarBangType] -> Con
    RecC Name
    name [VarBangType]
    fields)
    genTraverseClause (ForallC _vars :: [TyVarBndr]
    _vars _cxt :: [Type]
    _cxt con :: Con
    con) = Con -> Q ([Type], Clause)
    genTraverseClause 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 fun :: Q Exp
    fun fieldType :: Type
    fieldType fieldAccess :: Q Exp
    fieldAccess wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _ | 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
    appE (Q Exp -> Q Exp
    wrap Q Exp
    fun) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Q Exp -> Q Exp
    wrap [| Rank2.traverse $fun |]) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q Exp
    varE 'traverse))
         SigT ty :: Type
    ty _kind :: 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 ty :: 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
         _ -> (,) [] (Exp -> ([Type], Exp)) -> Q Exp -> Q ([Type], Exp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [| pure $fieldAccess |]

    genCotraverseClause :: Con -> Q ([Type], Clause)
    genCotraverseClause :: Con -> Q ([Type], Clause)
    genCotraverseClause (NormalC name :: Name
    name []) = Con -> Q ([Type], Clause)
    genCotraverseClause (Name -> [VarBangType] -> Con
    RecC Name
    name [])
    genCotraverseClause (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    withName <- String -> Q Name
    newName "w"
       Name
    argName <- String -> Q Name
    newName "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 :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q 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 (fieldName :: Name
    fieldName, _, fieldType :: 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
    varE 'Rank2.cotraverse) (Name -> Q Exp
    varE Name
    withName)
                                       Type
    fieldType [| $(varE fieldName) <$> $(varE 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))] -> CxtQ
    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)
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    withName, Name -> PatQ
    varP Name
    argName] BodyQ
    body []

    genCotraverseTraversableClause :: Con -> Q ([Type], Clause)
    genCotraverseTraversableClause :: Con -> Q ([Type], Clause)
    genCotraverseTraversableClause (NormalC name :: Name
    name []) = Con -> Q ([Type], Clause)
    genCotraverseTraversableClause (Name -> [VarBangType] -> Con
    RecC Name
    name [])
    genCotraverseTraversableClause (RecC name :: Name
    name fields :: [VarBangType]
    fields) = do
       Name
    withName <- String -> Q Name
    newName "w"
       Name
    argName <- String -> Q Name
    newName "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 :: BodyQ
    body = Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> [Q (Name, Exp)] -> Q 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 (fieldName :: Name
    fieldName, _, fieldType :: 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
    varE 'Rank2.cotraverseTraversable) (Name -> Q Exp
    varE Name
    withName) Type
    fieldType
                                       [| $(varE fieldName) <$> $(varE 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))] -> CxtQ
    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)
    sequence [Q ([Type], (Name, Exp))]
    constraintsAndFields
       (,) [Type]
    constraints (Clause -> ([Type], Clause)) -> ClauseQ -> Q ([Type], Clause)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    withName, Name -> PatQ
    varP Name
    argName] BodyQ
    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 className :: Name
    className method :: Q Exp
    method fun :: Q Exp
    fun fieldType :: Type
    fieldType fieldAccess :: Q Exp
    fieldAccess wrap :: Q Exp -> Q Exp
    wrap = do
       Just (Deriving _ typeVar :: Name
    typeVar) <- Q (Maybe Deriving)
    forall a. Typeable a => Q (Maybe a)
    getQ
       case Type
    fieldType of
         AppT ty :: Type
    ty _ | 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
    appE (Q Exp -> Q Exp
    wrap Q Exp
    fun) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    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
    appE Q Exp
    method Q Exp
    fun) Q Exp
    fieldAccess
         AppT t1 :: Type
    t1 t2 :: 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
    appE (Name -> Q Exp
    varE 'cotraverse))
         SigT ty :: Type
    ty _kind :: 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 ty :: 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

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