    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-|
    Module:      Data.Functor.Deriving.Internal
    Copyright:   (C) 2015-2017 Ryan Scott
    License:     BSD-style (see the file LICENSE)
    Maintainer:  Ryan Scott
    Portability: Template Haskell

    The machinery needed to derive 'Foldable', 'Functor', and 'Traversable' instances.

    For more info on how deriving @Functor@ works, see
    <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFunctor this GHC wiki page>.

    Note: this is an internal module, and as such, the API presented here is not
    guaranteed to be stable, even between minor releases of this library.
    -}
    module Data.Functor.Deriving.Internal (
          -- * 'Foldable'
          deriveFoldable
        , deriveFoldableOptions
        , makeFoldMap
        , makeFoldMapOptions
        , makeFoldr
        , makeFoldrOptions
        , makeFold
        , makeFoldOptions
        , makeFoldl
        , makeFoldlOptions
        , makeNull
        , makeNullOptions
          -- * 'Functor'
        , deriveFunctor
        , deriveFunctorOptions
        , makeFmap
        , makeFmapOptions
        , makeReplace
        , makeReplaceOptions
          -- * 'Traversable'
        , deriveTraversable
        , deriveTraversableOptions
        , makeTraverse
        , makeTraverseOptions
        , makeSequenceA
        , makeSequenceAOptions
        , makeMapM
        , makeMapMOptions
        , makeSequence
        , makeSequenceOptions
          -- * 'FFTOptions'
        , FFTOptions(..)
        , defaultFFTOptions
        ) where

    import           Control.Monad (guard)

    import           Data.Deriving.Internal
    import qualified Data.List as List
    import qualified Data.Map as Map ((!), keys, lookup, member, singleton)
    import           Data.Maybe

    import           Language.Haskell.TH.Datatype
    import           Language.Haskell.TH.Datatype.TyVarBndr
    import           Language.Haskell.TH.Lib
    import           Language.Haskell.TH.Syntax

    -- | Options that further configure how the functions in "Data.Functor.Deriving"
    -- should behave. (@FFT@ stands for 'Functor'/'Foldable'/'Traversable'.)
    newtype FFTOptions = FFTOptions
      { FFTOptions -> Bool
    fftEmptyCaseBehavior :: Bool
        -- ^ If 'True', derived instances for empty data types (i.e., ones with
        --   no data constructors) will use the @EmptyCase@ language extension.
        --   If 'False', derived instances will simply use 'seq' instead.
        --   (This has no effect on GHCs before 7.8, since @EmptyCase@ is only
        --   available in 7.8 or later.)
      } deriving (FFTOptions -> FFTOptions -> Bool
    (FFTOptions -> FFTOptions -> Bool)
    -> (FFTOptions -> FFTOptions -> Bool) -> Eq FFTOptions
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FFTOptions -> FFTOptions -> Bool
    == :: FFTOptions -> FFTOptions -> Bool
    $c/= :: FFTOptions -> FFTOptions -> Bool
    /= :: FFTOptions -> FFTOptions -> Bool
    Eq, Eq FFTOptions
    Eq FFTOptions =>
    (FFTOptions -> FFTOptions -> Ordering)
    -> (FFTOptions -> FFTOptions -> Bool)
    -> (FFTOptions -> FFTOptions -> Bool)
    -> (FFTOptions -> FFTOptions -> Bool)
    -> (FFTOptions -> FFTOptions -> Bool)
    -> (FFTOptions -> FFTOptions -> FFTOptions)
    -> (FFTOptions -> FFTOptions -> FFTOptions)
    -> Ord FFTOptions
    FFTOptions -> FFTOptions -> Bool
    FFTOptions -> FFTOptions -> Ordering
    FFTOptions -> FFTOptions -> FFTOptions
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: FFTOptions -> FFTOptions -> Ordering
    compare :: FFTOptions -> FFTOptions -> Ordering
    $c< :: FFTOptions -> FFTOptions -> Bool
    < :: FFTOptions -> FFTOptions -> Bool
    $c<= :: FFTOptions -> FFTOptions -> Bool
    <= :: FFTOptions -> FFTOptions -> Bool
    $c> :: FFTOptions -> FFTOptions -> Bool
    > :: FFTOptions -> FFTOptions -> Bool
    $c>= :: FFTOptions -> FFTOptions -> Bool
    >= :: FFTOptions -> FFTOptions -> Bool
    $cmax :: FFTOptions -> FFTOptions -> FFTOptions
    max :: FFTOptions -> FFTOptions -> FFTOptions
    $cmin :: FFTOptions -> FFTOptions -> FFTOptions
    min :: FFTOptions -> FFTOptions -> FFTOptions
    Ord, ReadPrec [FFTOptions]
    ReadPrec FFTOptions
    Int -> ReadS FFTOptions
    ReadS [FFTOptions]
    (Int -> ReadS FFTOptions)
    -> ReadS [FFTOptions]
    -> ReadPrec FFTOptions
    -> ReadPrec [FFTOptions]
    -> Read FFTOptions
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS FFTOptions
    readsPrec :: Int -> ReadS FFTOptions
    $creadList :: ReadS [FFTOptions]
    readList :: ReadS [FFTOptions]
    $creadPrec :: ReadPrec FFTOptions
    readPrec :: ReadPrec FFTOptions
    $creadListPrec :: ReadPrec [FFTOptions]
    readListPrec :: ReadPrec [FFTOptions]
    Read, Int -> FFTOptions -> ShowS
    [FFTOptions] -> ShowS
    FFTOptions -> String
    (Int -> FFTOptions -> ShowS)
    -> (FFTOptions -> String)
    -> ([FFTOptions] -> ShowS)
    -> Show FFTOptions
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FFTOptions -> ShowS
    showsPrec :: Int -> FFTOptions -> ShowS
    $cshow :: FFTOptions -> String
    show :: FFTOptions -> String
    $cshowList :: [FFTOptions] -> ShowS
    showList :: [FFTOptions] -> ShowS
    Show)

    -- | Conservative 'FFTOptions' that doesn't attempt to use @EmptyCase@ (to
    -- prevent users from having to enable that extension at use sites.)
    defaultFFTOptions :: FFTOptions
    defaultFFTOptions :: FFTOptions
    defaultFFTOptions = FFTOptions { fftEmptyCaseBehavior :: Bool
    fftEmptyCaseBehavior = Bool
    False }

    -- | Generates a 'Foldable' instance declaration for the given data type or data
    -- family instance.
    deriveFoldable :: Name -> Q [Dec]
    deriveFoldable :: Name -> Q [Dec]
    deriveFoldable = FFTOptions -> Name -> Q [Dec]
    deriveFoldableOptions FFTOptions
    defaultFFTOptions

    -- | Like 'deriveFoldable', but takes an 'FFTOptions' argument.
    deriveFoldableOptions :: FFTOptions -> Name -> Q [Dec]
    deriveFoldableOptions :: FFTOptions -> Name -> Q [Dec]
    deriveFoldableOptions = FunctorClass -> FFTOptions -> Name -> Q [Dec]
    deriveFunctorClass FunctorClass
    Foldable

    -- | Generates a lambda expression which behaves like 'foldMap' (without requiring a
    -- 'Foldable' instance).
    makeFoldMap :: Name -> Q Exp
    makeFoldMap :: Name -> Q Exp
    makeFoldMap = FFTOptions -> Name -> Q Exp
    makeFoldMapOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeFoldMap', but takes an 'FFTOptions' argument.
    makeFoldMapOptions :: FFTOptions -> Name -> Q Exp
    makeFoldMapOptions :: FFTOptions -> Name -> Q Exp
    makeFoldMapOptions = FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun FunctorFun
    FoldMap

    -- | Generates a lambda expression which behaves like 'null' (without requiring a
    -- 'Foldable' instance).
    makeNull :: Name -> Q Exp
    makeNull :: Name -> Q Exp
    makeNull = FFTOptions -> Name -> Q Exp
    makeNullOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeNull', but takes an 'FFTOptions' argument.
    makeNullOptions :: FFTOptions -> Name -> Q Exp
    makeNullOptions :: FFTOptions -> Name -> Q Exp
    makeNullOptions = FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun FunctorFun
    Null

    -- | Generates a lambda expression which behaves like 'foldr' (without requiring a
    -- 'Foldable' instance).
    makeFoldr :: Name -> Q Exp
    makeFoldr :: Name -> Q Exp
    makeFoldr = FFTOptions -> Name -> Q Exp
    makeFoldrOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeFoldr', but takes an 'FFTOptions' argument.
    makeFoldrOptions :: FFTOptions -> Name -> Q Exp
    makeFoldrOptions :: FFTOptions -> Name -> Q Exp
    makeFoldrOptions = FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun FunctorFun
    Foldr

    -- | Generates a lambda expression which behaves like 'fold' (without requiring a
    -- 'Foldable' instance).
    makeFold :: Name -> Q Exp
    makeFold :: Name -> Q Exp
    makeFold = FFTOptions -> Name -> Q Exp
    makeFoldOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeFold', but takes an 'FFTOptions' argument.
    makeFoldOptions :: FFTOptions -> Name -> Q Exp
    makeFoldOptions :: FFTOptions -> Name -> Q Exp
    makeFoldOptions FFTOptions
    opts Name
    name = FFTOptions -> Name -> Q Exp
    makeFoldMapOptions FFTOptions
    opts Name
    name Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    idValName

    -- | Generates a lambda expression which behaves like 'foldl' (without requiring a
    -- 'Foldable' instance).
    makeFoldl :: Name -> Q Exp
    makeFoldl :: Name -> Q Exp
    makeFoldl = FFTOptions -> Name -> Q Exp
    makeFoldlOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeFoldl', but takes an 'FFTOptions' argument.
    makeFoldlOptions :: FFTOptions -> Name -> Q Exp
    makeFoldlOptions :: FFTOptions -> Name -> Q Exp
    makeFoldlOptions FFTOptions
    opts Name
    name = do
      Name
    f <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "f"
      Name
    z <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "z"
      Name
    t <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "t"
      [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    z, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    t] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
        [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    appEndoValName
              , [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    getDualValName
                      , [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE [ FFTOptions -> Name -> Q Exp
    makeFoldMapOptions FFTOptions
    opts Name
    name, Name -> Q Exp
    foldFun Name
    f, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    t]
                      ]
              , Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    z
              ]
      where
        foldFun :: Name -> Q Exp
        foldFun :: Name -> Q Exp
    foldFun Name
    n = Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    infixApp (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    dualDataName)
                             (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    composeValName)
                             (Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    infixApp (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    endoDataName)
                                       (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    composeValName)
                                       (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    flipValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    n)
                             )

    -- | Generates a 'Functor' instance declaration for the given data type or data
    -- family instance.
    deriveFunctor :: Name -> Q [Dec]
    deriveFunctor :: Name -> Q [Dec]
    deriveFunctor = FFTOptions -> Name -> Q [Dec]
    deriveFunctorOptions FFTOptions
    defaultFFTOptions

    -- | Like 'deriveFunctor', but takes an 'FFTOptions' argument.
    deriveFunctorOptions :: FFTOptions -> Name -> Q [Dec]
    deriveFunctorOptions :: FFTOptions -> Name -> Q [Dec]
    deriveFunctorOptions = FunctorClass -> FFTOptions -> Name -> Q [Dec]
    deriveFunctorClass FunctorClass
    Functor

    -- | Generates a lambda expression which behaves like 'fmap' (without requiring a
    -- 'Functor' instance).
    makeFmap :: Name -> Q Exp
    makeFmap :: Name -> Q Exp
    makeFmap = FFTOptions -> Name -> Q Exp
    makeFmapOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeFmap', but takes an 'FFTOptions' argument.
    makeFmapOptions :: FFTOptions -> Name -> Q Exp
    makeFmapOptions :: FFTOptions -> Name -> Q Exp
    makeFmapOptions = FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun FunctorFun
    Fmap

    -- | Generates a lambda expression which behaves like ('<$') (without requiring a
    -- 'Functor' instance).
    makeReplace :: Name -> Q Exp
    makeReplace :: Name -> Q Exp
    makeReplace = FFTOptions -> Name -> Q Exp
    makeReplaceOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeReplace', but takes an 'FFTOptions' argument.
    makeReplaceOptions :: FFTOptions -> Name -> Q Exp
    makeReplaceOptions :: FFTOptions -> Name -> Q Exp
    makeReplaceOptions = FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun FunctorFun
    Replace

    -- | Generates a 'Traversable' instance declaration for the given data type or data
    -- family instance.
    deriveTraversable :: Name -> Q [Dec]
    deriveTraversable :: Name -> Q [Dec]
    deriveTraversable = FFTOptions -> Name -> Q [Dec]
    deriveTraversableOptions FFTOptions
    defaultFFTOptions

    -- | Like 'deriveTraverse', but takes an 'FFTOptions' argument.
    deriveTraversableOptions :: FFTOptions -> Name -> Q [Dec]
    deriveTraversableOptions :: FFTOptions -> Name -> Q [Dec]
    deriveTraversableOptions = FunctorClass -> FFTOptions -> Name -> Q [Dec]
    deriveFunctorClass FunctorClass
    Traversable

    -- | Generates a lambda expression which behaves like 'traverse' (without requiring a
    -- 'Traversable' instance).
    makeTraverse :: Name -> Q Exp
    makeTraverse :: Name -> Q Exp
    makeTraverse = FFTOptions -> Name -> Q Exp
    makeTraverseOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeTraverse', but takes an 'FFTOptions' argument.
    makeTraverseOptions :: FFTOptions -> Name -> Q Exp
    makeTraverseOptions :: FFTOptions -> Name -> Q Exp
    makeTraverseOptions = FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun FunctorFun
    Traverse

    -- | Generates a lambda expression which behaves like 'sequenceA' (without requiring a
    -- 'Traversable' instance).
    makeSequenceA :: Name -> Q Exp
    makeSequenceA :: Name -> Q Exp
    makeSequenceA = FFTOptions -> Name -> Q Exp
    makeSequenceAOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeSequenceA', but takes an 'FFTOptions' argument.
    makeSequenceAOptions :: FFTOptions -> Name -> Q Exp
    makeSequenceAOptions :: FFTOptions -> Name -> Q Exp
    makeSequenceAOptions FFTOptions
    opts Name
    name = FFTOptions -> Name -> Q Exp
    makeTraverseOptions FFTOptions
    opts Name
    name Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    idValName

    -- | Generates a lambda expression which behaves like 'mapM' (without requiring a
    -- 'Traversable' instance).
    makeMapM :: Name -> Q Exp
    makeMapM :: Name -> Q Exp
    makeMapM = FFTOptions -> Name -> Q Exp
    makeMapMOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeMapM', but takes an 'FFTOptions' argument.
    makeMapMOptions :: FFTOptions -> Name -> Q Exp
    makeMapMOptions :: FFTOptions -> Name -> Q Exp
    makeMapMOptions FFTOptions
    opts Name
    name = do
      Name
    f <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "f"
      Q Pat -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Exp
    lam1E (Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    f) (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 -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    infixApp (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    unwrapMonadValName) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    composeValName) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                       FFTOptions -> Name -> Q Exp
    makeTraverseOptions FFTOptions
    opts Name
    name Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    wrapMonadExp Name
    f
      where
        wrapMonadExp :: Name -> Q Exp
        wrapMonadExp :: Name -> Q Exp
    wrapMonadExp Name
    n = Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    infixApp (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    wrapMonadDataName) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    composeValName) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    n)

    -- | Generates a lambda expression which behaves like 'sequence' (without requiring a
    -- 'Traversable' instance).
    makeSequence :: Name -> Q Exp
    makeSequence :: Name -> Q Exp
    makeSequence = FFTOptions -> Name -> Q Exp
    makeSequenceOptions FFTOptions
    defaultFFTOptions

    -- | Like 'makeSequence', but takes an 'FFTOptions' argument.
    makeSequenceOptions :: FFTOptions -> Name -> Q Exp
    makeSequenceOptions :: FFTOptions -> Name -> Q Exp
    makeSequenceOptions FFTOptions
    opts Name
    name = FFTOptions -> Name -> Q Exp
    makeMapMOptions FFTOptions
    opts Name
    name Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    idValName

    -------------------------------------------------------------------------------
    -- Code generation
    -------------------------------------------------------------------------------

    -- | Derive a class instance declaration (depending on the FunctorClass argument's value).
    deriveFunctorClass :: FunctorClass -> FFTOptions -> Name -> Q [Dec]
    deriveFunctorClass :: FunctorClass -> FFTOptions -> Name -> Q [Dec]
    deriveFunctorClass FunctorClass
    fc FFTOptions
    opts Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTypes
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } -> do
          (Cxt
    instanceCxt, Type
    instanceType)
              <- FunctorClass
    -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    forall a.
    ClassRep a =>
    a -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance FunctorClass
    fc Name
    parentName Cxt
    ctxt Cxt
    instTypes DatatypeVariant
    variant
          (Dec -> [Dec] -> [Dec]
    forall a. a -> [a] -> [a]
    :[]) (Dec -> [Dec]) -> Q Dec -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Q Cxt -> Q Type -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Cxt -> m Type -> [m Dec] -> m Dec
    instanceD (Cxt -> Q Cxt
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Cxt
    instanceCxt)
                                 (Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    instanceType)
                                 (FunctorClass
    -> FFTOptions -> Name -> Cxt -> [ConstructorInfo] -> [Q Dec]
    functorFunDecs FunctorClass
    fc FFTOptions
    opts Name
    parentName Cxt
    instTypes [ConstructorInfo]
    cons)

    -- | Generates a declaration defining the primary function(s) corresponding to a
    -- particular class (fmap for Functor, foldr and foldMap for Foldable, and
    -- traverse for Traversable).
    --
    -- For why both foldr and foldMap are derived for Foldable, see Trac #7436.
    functorFunDecs
      :: FunctorClass -> FFTOptions -> Name -> [Type] -> [ConstructorInfo]
      -> [Q Dec]
    functorFunDecs :: FunctorClass
    -> FFTOptions -> Name -> Cxt -> [ConstructorInfo] -> [Q Dec]
    functorFunDecs FunctorClass
    fc FFTOptions
    opts Name
    parentName Cxt
    instTypes [ConstructorInfo]
    cons =
      (FunctorFun -> Q Dec) -> [FunctorFun] -> [Q Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map FunctorFun -> Q Dec
    makeFunD ([FunctorFun] -> [Q Dec]) -> [FunctorFun] -> [Q Dec]
    forall a b. (a -> b) -> a -> b
    $ FunctorClass -> [FunctorFun]
    functorClassToFuns FunctorClass
    fc
      where
        makeFunD :: FunctorFun -> Q Dec
        makeFunD :: FunctorFun -> Q Dec
    makeFunD FunctorFun
    ff =
          Name -> [Q Clause] -> Q Dec
    forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
    funD (FunctorFun -> Name
    functorFunName FunctorFun
    ff)
               [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    clause []
                        (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ FunctorFun
    -> FFTOptions -> Name -> Cxt -> [ConstructorInfo] -> Q Exp
    makeFunctorFunForCons FunctorFun
    ff FFTOptions
    opts Name
    parentName Cxt
    instTypes [ConstructorInfo]
    cons)
                        []
               ]

    -- | Generates a lambda expression which behaves like the FunctorFun argument.
    makeFunctorFun :: FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun :: FunctorFun -> FFTOptions -> Name -> Q Exp
    makeFunctorFun FunctorFun
    ff FFTOptions
    opts Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTypes
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } -> do
          -- We force buildTypeInstance here since it performs some checks for whether
          -- or not the provided datatype can actually have fmap/foldr/traverse/etc.
          -- implemented for it, and produces errors if it can't.
          FunctorClass
    -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    forall a.
    ClassRep a =>
    a -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance (FunctorFun -> FunctorClass
    functorFunToClass FunctorFun
    ff) Name
    parentName Cxt
    ctxt Cxt
    instTypes DatatypeVariant
    variant
            Q (Cxt, Type) -> Q Exp -> Q Exp
    forall a b. Q a -> Q b -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> FunctorFun
    -> FFTOptions -> Name -> Cxt -> [ConstructorInfo] -> Q Exp
    makeFunctorFunForCons FunctorFun
    ff FFTOptions
    opts Name
    parentName Cxt
    instTypes [ConstructorInfo]
    cons

    -- | Generates a lambda expression for the given constructors.
    -- All constructors must be from the same type.
    makeFunctorFunForCons
      :: FunctorFun -> FFTOptions -> Name -> [Type] -> [ConstructorInfo]
      -> Q Exp
    makeFunctorFunForCons :: FunctorFun
    -> FFTOptions -> Name -> Cxt -> [ConstructorInfo] -> Q Exp
    makeFunctorFunForCons FunctorFun
    ff FFTOptions
    opts Name
    _parentName Cxt
    instTypes [ConstructorInfo]
    cons = do
      Name
    mapFun <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "f"
      Name
    z      <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "z" -- Only used for deriving foldr
      Name
    value  <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "value"
      let argNames :: [Name]
    argNames  = [Maybe Name] -> [Name]
    forall a. [Maybe a] -> [a]
    catMaybes [ Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (FunctorFun
    ff FunctorFun -> FunctorFun -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FunctorFun
    Null)  Maybe () -> Maybe Name -> Maybe Name
    forall a b. Maybe a -> Maybe b -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    mapFun
                                , Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (FunctorFun
    ff FunctorFun -> FunctorFun -> Bool
    forall a. Eq a => a -> a -> Bool
    == FunctorFun
    Foldr) Maybe () -> Maybe Name -> Maybe Name
    forall a b. Maybe a -> Maybe b -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    z
                                , Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    value
                                ]
          lastTyVar :: Name
    lastTyVar = Type -> Name
    varTToName (Type -> Name) -> Type -> Name
    forall a b. (a -> b) -> a -> b
    $ Cxt -> Type
    forall a. HasCallStack => [a] -> a
    last Cxt
    instTypes
          tvMap :: Map Name (OneOrTwoNames One)
    tvMap     = Name -> OneOrTwoNames One -> Map Name (OneOrTwoNames One)
    forall k a. k -> a -> Map k a
    Map.singleton Name
    lastTyVar (OneOrTwoNames One -> Map Name (OneOrTwoNames One))
    -> OneOrTwoNames One -> Map Name (OneOrTwoNames One)
    forall a b. (a -> b) -> a -> b
    $ Name -> OneOrTwoNames One
    OneName Name
    mapFun
      [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    argNames)
          (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
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE
          ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ FunctorFun -> Name
    functorFunConstName FunctorFun
    ff
            , Name -> Name -> Map Name (OneOrTwoNames One) -> Q Exp
    makeFun Name
    z Name
    value Map Name (OneOrTwoNames One)
    tvMap
            ] [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Q Exp) -> [Name] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE [Name]
    argNames
      where
        makeFun :: Name -> Name -> TyVarMap1 -> Q Exp
        makeFun :: Name -> Name -> Map Name (OneOrTwoNames One) -> Q Exp
    makeFun Name
    z Name
    value Map Name (OneOrTwoNames One)
    tvMap = do
    #if MIN_VERSION_template_haskell(2,9,0)
          [Role]
    roles <- Name -> Q [Role]
    reifyRoles Name
    _parentName
    #endif
          case () of
            ()
    _

    #if MIN_VERSION_template_haskell(2,9,0)
              | Just ([Role]
    _, Role
    PhantomR) <- [Role] -> Maybe ([Role], Role)
    forall a. [a] -> Maybe ([a], a)
    unsnoc [Role]
    roles
             -> Name -> Name -> Q Exp
    functorFunPhantom Name
    z Name
    value
    #endif

              | [ConstructorInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConstructorInfo]
    cons Bool -> Bool -> Bool
    && FFTOptions -> Bool
    fftEmptyCaseBehavior FFTOptions
    opts Bool -> Bool -> Bool
    && Bool
    ghc7'8OrLater
             -> FunctorFun -> Name -> Name -> Q Exp
    functorFunEmptyCase FunctorFun
    ff Name
    z Name
    value

              | [ConstructorInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConstructorInfo]
    cons
             -> FunctorFun -> Name -> Name -> Q Exp
    functorFunNoCons FunctorFun
    ff Name
    z Name
    value

              | Bool
    otherwise
             -> Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    value)
                      ((ConstructorInfo -> Q Match) -> [ConstructorInfo] -> [Q Match]
    forall a b. (a -> b) -> [a] -> [b]
    map (FunctorFun
    -> Name
    -> Map Name (OneOrTwoNames One)
    -> ConstructorInfo
    -> Q Match
    makeFunctorFunForCon FunctorFun
    ff Name
    z Map Name (OneOrTwoNames One)
    tvMap) [ConstructorInfo]
    cons)

    #if MIN_VERSION_template_haskell(2,9,0)
        functorFunPhantom :: Name -> Name -> Q Exp
        functorFunPhantom :: Name -> Name -> Q Exp
    functorFunPhantom Name
    z Name
    value =
            Q Exp -> Q Exp -> FunctorFun -> Name -> Q Exp
    functorFunTrivial Q Exp
    coerce
                              (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    pureValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    coerce)
                              FunctorFun
    ff Name
    z
          where
            coerce :: Q Exp
            coerce :: Q Exp
    coerce = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    coerceValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    value
    #endif

    -- | Generates a match for a single constructor.
    makeFunctorFunForCon :: FunctorFun -> Name -> TyVarMap1 -> ConstructorInfo -> Q Match
    makeFunctorFunForCon :: FunctorFun
    -> Name
    -> Map Name (OneOrTwoNames One)
    -> ConstructorInfo
    -> Q Match
    makeFunctorFunForCon FunctorFun
    ff Name
    z Map Name (OneOrTwoNames One)
    tvMap
      con :: ConstructorInfo
    con@(ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    conName
                           , constructorContext :: ConstructorInfo -> Cxt
    constructorContext = Cxt
    ctxt }) = do
        FunctorClass
    -> Map Name (OneOrTwoNames One)
    -> Cxt
    -> Name
    -> Q Match
    -> Q Match
    forall a b c.
    ClassRep a =>
    a -> TyVarMap b -> Cxt -> Name -> Q c -> Q c
    checkExistentialContext (FunctorFun -> FunctorClass
    functorFunToClass FunctorFun
    ff) Map Name (OneOrTwoNames One)
    tvMap Cxt
    ctxt Name
    conName (Q Match -> Q Match) -> Q Match -> Q Match
    forall a b. (a -> b) -> a -> b
    $
          case FunctorFun
    ff of
            FunctorFun
    Fmap     -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeFmapMatch Map Name (OneOrTwoNames One)
    tvMap ConstructorInfo
    con
            FunctorFun
    Replace  -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeReplaceMatch Map Name (OneOrTwoNames One)
    tvMap ConstructorInfo
    con
            FunctorFun
    Foldr    -> Name -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeFoldrMatch Name
    z Map Name (OneOrTwoNames One)
    tvMap ConstructorInfo
    con
            FunctorFun
    FoldMap  -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeFoldMapMatch Map Name (OneOrTwoNames One)
    tvMap ConstructorInfo
    con
            FunctorFun
    Null     -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeNullMatch Map Name (OneOrTwoNames One)
    tvMap ConstructorInfo
    con
            FunctorFun
    Traverse -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeTraverseMatch Map Name (OneOrTwoNames One)
    tvMap ConstructorInfo
    con

    -- | Generates a match whose right-hand side implements @fmap@.
    makeFmapMatch :: TyVarMap1 -> ConstructorInfo -> Q Match
    makeFmapMatch :: Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeFmapMatch Map Name (OneOrTwoNames One)
    tvMap con :: ConstructorInfo
    con@(ConstructorInfo{constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName}) = do
      [Exp -> Q Exp]
    parts <- Map Name (OneOrTwoNames One)
    -> FFoldType (Exp -> Q Exp) -> ConstructorInfo -> Q [Exp -> Q Exp]
    forall a.
    Map Name (OneOrTwoNames One)
    -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs Map Name (OneOrTwoNames One)
    tvMap FFoldType (Exp -> Q Exp)
    ft_fmap ConstructorInfo
    con
      Name -> [Exp -> Q Exp] -> Q Match
    match_for_con_functor Name
    conName [Exp -> Q Exp]
    parts
      where
        ft_fmap :: FFoldType (Exp -> Q Exp)
        ft_fmap :: FFoldType (Exp -> Q Exp)
    ft_fmap = FT { ft_triv :: Exp -> Q Exp
    ft_triv = Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                     , ft_var :: Name -> Exp -> Q Exp
    ft_var  = \Name
    v Exp
    x -> case Map Name (OneOrTwoNames One)
    tvMap Map Name (OneOrTwoNames One) -> Name -> OneOrTwoNames One
    forall k a. Ord k => Map k a -> k -> a
    Map.! Name
    v of
                                           OneName Name
    f -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    f Exp -> Exp -> Exp
    `AppE` Exp
    x
                     , ft_fun :: (Exp -> Q Exp) -> (Exp -> Q Exp) -> Exp -> Q Exp
    ft_fun  = \Exp -> Q Exp
    g Exp -> Q Exp
    h Exp
    x -> (Exp -> Q Exp) -> Q Exp
    mkSimpleLam ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Exp
    b -> do
                         Exp
    gg <- Exp -> Q Exp
    g Exp
    b
                         Exp -> Q Exp
    h (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    x Exp -> Exp -> Exp
    `AppE` Exp
    gg
                     , ft_tup :: TupleSort -> [Exp -> Q Exp] -> Exp -> Q Exp
    ft_tup  = (Name -> [Exp -> Q Exp] -> Q Match)
    -> TupleSort -> [Exp -> Q Exp] -> Exp -> Q Exp
    forall a.
    (Name -> [a] -> Q Match) -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase Name -> [Exp -> Q Exp] -> Q Match
    match_for_con_functor
                     , ft_ty_app :: Type -> (Exp -> Q Exp) -> Exp -> Q Exp
    ft_ty_app = \Type
    argTy Exp -> Q Exp
    g Exp
    x -> do
                         case Type -> Maybe Name
    varTToName_maybe Type
    argTy of
                           -- If the argument type is a bare occurrence of the
                           -- data type's last type variable, then we can
                           -- generate more efficient code.
                           -- This was inspired by GHC#17880.
                           Just Name
    argVar
                             |  Just (OneName Name
    f) <- Name -> Map Name (OneOrTwoNames One) -> Maybe (OneOrTwoNames One)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    argVar Map Name (OneOrTwoNames One)
    tvMap
                             -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    fmapValName Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    f Exp -> Exp -> Exp
    `AppE` Exp
    x
                           Maybe Name
    _ -> do Exp
    gg <- (Exp -> Q Exp) -> Q Exp
    mkSimpleLam Exp -> Q Exp
    g
                                   Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    fmapValName Exp -> Exp -> Exp
    `AppE` Exp
    gg Exp -> Exp -> Exp
    `AppE` Exp
    x
                     , ft_forall :: [TyVarBndrSpec] -> (Exp -> Q Exp) -> Exp -> Q Exp
    ft_forall  = \[TyVarBndrSpec]
    _ Exp -> Q Exp
    g Exp
    x -> Exp -> Q Exp
    g Exp
    x
                     , ft_bad_app :: Exp -> Q Exp
    ft_bad_app = \Exp
    _ -> FunctorClass -> Name -> Q Exp
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError FunctorClass
    Functor Name
    conName
                     , ft_co_var :: Name -> Exp -> Q Exp
    ft_co_var  = \Name
    _ Exp
    _ -> Name -> Q Exp
    forall a. Name -> Q a
    contravarianceError Name
    conName
                     }

    -- | Generates a match whose right-hand side implements @(<$)@.
    makeReplaceMatch :: TyVarMap1 -> ConstructorInfo -> Q Match
    makeReplaceMatch :: Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeReplaceMatch Map Name (OneOrTwoNames One)
    tvMap con :: ConstructorInfo
    con@(ConstructorInfo{constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName}) = do
      [Exp -> Q Exp]
    parts <- Map Name (OneOrTwoNames One)
    -> FFoldType (Exp -> Q Exp) -> ConstructorInfo -> Q [Exp -> Q Exp]
    forall a.
    Map Name (OneOrTwoNames One)
    -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs Map Name (OneOrTwoNames One)
    tvMap FFoldType (Exp -> Q Exp)
    ft_replace ConstructorInfo
    con
      Name -> [Exp -> Q Exp] -> Q Match
    match_for_con_functor Name
    conName [Exp -> Q Exp]
    parts
      where
        ft_replace :: FFoldType (Exp -> Q Exp)
        ft_replace :: FFoldType (Exp -> Q Exp)
    ft_replace = FT { ft_triv :: Exp -> Q Exp
    ft_triv = Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                        , ft_var :: Name -> Exp -> Q Exp
    ft_var  = \Name
    v Exp
    _ -> case Map Name (OneOrTwoNames One)
    tvMap Map Name (OneOrTwoNames One) -> Name -> OneOrTwoNames One
    forall k a. Ord k => Map k a -> k -> a
    Map.! Name
    v of
                                              OneName Name
    z -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    z
                        , ft_fun :: (Exp -> Q Exp) -> (Exp -> Q Exp) -> Exp -> Q Exp
    ft_fun  = \Exp -> Q Exp
    g Exp -> Q Exp
    h Exp
    x -> (Exp -> Q Exp) -> Q Exp
    mkSimpleLam ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Exp
    b -> do
                            Exp
    gg <- Exp -> Q Exp
    g Exp
    b
                            Exp -> Q Exp
    h (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    x Exp -> Exp -> Exp
    `AppE` Exp
    gg
                        , ft_tup :: TupleSort -> [Exp -> Q Exp] -> Exp -> Q Exp
    ft_tup  = (Name -> [Exp -> Q Exp] -> Q Match)
    -> TupleSort -> [Exp -> Q Exp] -> Exp -> Q Exp
    forall a.
    (Name -> [a] -> Q Match) -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase Name -> [Exp -> Q Exp] -> Q Match
    match_for_con_functor
                        , ft_ty_app :: Type -> (Exp -> Q Exp) -> Exp -> Q Exp
    ft_ty_app = \Type
    argTy Exp -> Q Exp
    g Exp
    x -> do
                            case Type -> Maybe Name
    varTToName_maybe Type
    argTy of
                              -- If the argument type is a bare occurrence of the
                              -- data type's last type variable, then we can
                              -- generate more efficient code.
                              -- This was inspired by GHC#17880.
                              Just Name
    argVar
                                |  Just (OneName Name
    z) <- Name -> Map Name (OneOrTwoNames One) -> Maybe (OneOrTwoNames One)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    argVar Map Name (OneOrTwoNames One)
    tvMap
                                -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    replaceValName Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    z Exp -> Exp -> Exp
    `AppE` Exp
    x
                              Maybe Name
    _ -> do Exp
    gg <- (Exp -> Q Exp) -> Q Exp
    mkSimpleLam Exp -> Q Exp
    g
                                      Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    fmapValName Exp -> Exp -> Exp
    `AppE` Exp
    gg Exp -> Exp -> Exp
    `AppE` Exp
    x
                        , ft_forall :: [TyVarBndrSpec] -> (Exp -> Q Exp) -> Exp -> Q Exp
    ft_forall  = \[TyVarBndrSpec]
    _ Exp -> Q Exp
    g Exp
    x -> Exp -> Q Exp
    g Exp
    x
                        , ft_bad_app :: Exp -> Q Exp
    ft_bad_app = \Exp
    _ -> FunctorClass -> Name -> Q Exp
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError FunctorClass
    Functor Name
    conName
                        , ft_co_var :: Name -> Exp -> Q Exp
    ft_co_var  = \Name
    _ Exp
    _ -> Name -> Q Exp
    forall a. Name -> Q a
    contravarianceError Name
    conName
                        }

    match_for_con_functor :: Name -> [Exp -> Q Exp] -> Q Match
    match_for_con_functor :: Name -> [Exp -> Q Exp] -> Q Match
    match_for_con_functor = (Name -> [Q Exp] -> Q Exp) -> Name -> [Exp -> Q Exp] -> Q Match
    forall a. (Name -> [a] -> Q Exp) -> Name -> [Exp -> a] -> Q Match
    mkSimpleConMatch ((Name -> [Q Exp] -> Q Exp) -> Name -> [Exp -> Q Exp] -> Q Match)
    -> (Name -> [Q Exp] -> Q Exp) -> Name -> [Exp -> Q Exp] -> Q Match
    forall a b. (a -> b) -> a -> b
    $ \Name
    conName' [Q Exp]
    xs ->
      [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    conName'Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    :[Q Exp]
    xs) -- Con x1 x2 ..

    -- | Generates a match whose right-hand side implements @foldr@.
    makeFoldrMatch :: Name -> TyVarMap1 -> ConstructorInfo -> Q Match
    makeFoldrMatch :: Name -> Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeFoldrMatch Name
    z Map Name (OneOrTwoNames One)
    tvMap con :: ConstructorInfo
    con@(ConstructorInfo{constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName}) = do
      [Q (Bool, Exp)]
    parts  <- Map Name (OneOrTwoNames One)
    -> FFoldType (Q (Bool, Exp))
    -> ConstructorInfo
    -> Q [Q (Bool, Exp)]
    forall a.
    Map Name (OneOrTwoNames One)
    -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs Map Name (OneOrTwoNames One)
    tvMap FFoldType (Q (Bool, Exp))
    ft_foldr ConstructorInfo
    con
      [(Bool, Exp)]
    parts' <- [Q (Bool, Exp)] -> Q [(Bool, Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (Bool, Exp)]
    parts
      Exp -> Name -> [(Bool, Exp)] -> Q Match
    match_for_con (Name -> Exp
    VarE Name
    z) Name
    conName [(Bool, Exp)]
    parts'
      where
        -- The Bool is True if the type mentions the last type parameter, False
        -- otherwise. Later, match_for_con uses mkSimpleConMatch2 to filter out
        -- expressions that do not mention the last parameter by checking for False.
        ft_foldr :: FFoldType (Q (Bool, Exp))
        ft_foldr :: FFoldType (Q (Bool, Exp))
    ft_foldr = FT { ft_triv :: Q (Bool, Exp)
    ft_triv = do Exp
    lam <- (Exp -> Exp -> Q Exp) -> Q Exp
    mkSimpleLam2 ((Exp -> Exp -> Q Exp) -> Q Exp) -> (Exp -> Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Exp
    _ Exp
    z' -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    z'
                                     (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Exp
    lam)
                      , ft_var :: Name -> Q (Bool, Exp)
    ft_var  = \Name
    v -> case Map Name (OneOrTwoNames One)
    tvMap Map Name (OneOrTwoNames One) -> Name -> OneOrTwoNames One
    forall k a. Ord k => Map k a -> k -> a
    Map.! Name
    v of
                                          OneName Name
    f -> (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Name -> Exp
    VarE Name
    f)
                      , ft_tup :: TupleSort -> [Q (Bool, Exp)] -> Q (Bool, Exp)
    ft_tup  = \TupleSort
    t [Q (Bool, Exp)]
    gs -> do
                          [(Bool, Exp)]
    gg  <- [Q (Bool, Exp)] -> Q [(Bool, Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (Bool, Exp)]
    gs
                          Exp
    lam <- (Exp -> Exp -> Q Exp) -> Q Exp
    mkSimpleLam2 ((Exp -> Exp -> Q Exp) -> Q Exp) -> (Exp -> Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Exp
    x Exp
    z' ->
                            (Name -> [(Bool, Exp)] -> Q Match)
    -> TupleSort -> [(Bool, Exp)] -> Exp -> Q Exp
    forall a.
    (Name -> [a] -> Q Match) -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase (Exp -> Name -> [(Bool, Exp)] -> Q Match
    match_for_con Exp
    z') TupleSort
    t [(Bool, Exp)]
    gg Exp
    x
                          (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Exp
    lam)
                      , ft_ty_app :: Type -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_ty_app = \Type
    _ Q (Bool, Exp)
    g -> do
                          (Bool
    b, Exp
    gg) <- Q (Bool, Exp)
    g
                          Exp
    e <- (Exp -> Exp -> Q Exp) -> Q Exp
    mkSimpleLam2 ((Exp -> Exp -> Q Exp) -> Q Exp) -> (Exp -> Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Exp
    x Exp
    z' -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                               Name -> Exp
    VarE Name
    foldrValName Exp -> Exp -> Exp
    `AppE` Exp
    gg Exp -> Exp -> Exp
    `AppE` Exp
    z' Exp -> Exp -> Exp
    `AppE` Exp
    x
                          (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    b, Exp
    e)
                      , ft_forall :: [TyVarBndrSpec] -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_forall  = \[TyVarBndrSpec]
    _ Q (Bool, Exp)
    g -> Q (Bool, Exp)
    g
                      , ft_co_var :: Name -> Q (Bool, Exp)
    ft_co_var  = \Name
    _ -> Name -> Q (Bool, Exp)
    forall a. Name -> Q a
    contravarianceError Name
    conName
                      , ft_fun :: Q (Bool, Exp) -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_fun     = \Q (Bool, Exp)
    _ Q (Bool, Exp)
    _ -> Name -> Q (Bool, Exp)
    forall a. Name -> Q a
    noFunctionsError Name
    conName
                      , ft_bad_app :: Q (Bool, Exp)
    ft_bad_app = FunctorClass -> Name -> Q (Bool, Exp)
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError FunctorClass
    Foldable Name
    conName
                      }

        match_for_con :: Exp -> Name -> [(Bool, Exp)] -> Q Match
        match_for_con :: Exp -> Name -> [(Bool, Exp)] -> Q Match
    match_for_con Exp
    zExp = (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    mkSimpleConMatch2 ((Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match)
    -> (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    forall a b. (a -> b) -> a -> b
    $ \Exp
    _ [Exp]
    xs -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    mkFoldr [Exp]
    xs
          where
            -- g1 v1 (g2 v2 (.. z))
            mkFoldr :: [Exp] -> Exp
            mkFoldr :: [Exp] -> Exp
    mkFoldr = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Exp -> Exp -> Exp
    AppE Exp
    zExp

    -- | Generates a match whose right-hand side implements @foldMap@.
    makeFoldMapMatch :: TyVarMap1 -> ConstructorInfo -> Q Match
    makeFoldMapMatch :: Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeFoldMapMatch Map Name (OneOrTwoNames One)
    tvMap con :: ConstructorInfo
    con@(ConstructorInfo{constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName}) = do
      [Q (Bool, Exp)]
    parts  <- Map Name (OneOrTwoNames One)
    -> FFoldType (Q (Bool, Exp))
    -> ConstructorInfo
    -> Q [Q (Bool, Exp)]
    forall a.
    Map Name (OneOrTwoNames One)
    -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs Map Name (OneOrTwoNames One)
    tvMap FFoldType (Q (Bool, Exp))
    ft_foldMap ConstructorInfo
    con
      [(Bool, Exp)]
    parts' <- [Q (Bool, Exp)] -> Q [(Bool, Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (Bool, Exp)]
    parts
      Name -> [(Bool, Exp)] -> Q Match
    match_for_con Name
    conName [(Bool, Exp)]
    parts'
      where
        -- The Bool is True if the type mentions the last type parameter, False
        -- otherwise. Later, match_for_con uses mkSimpleConMatch2 to filter out
        -- expressions that do not mention the last parameter by checking for False.
        ft_foldMap :: FFoldType (Q (Bool, Exp))
        ft_foldMap :: FFoldType (Q (Bool, Exp))
    ft_foldMap = FT { ft_triv :: Q (Bool, Exp)
    ft_triv = do Exp
    lam <- (Exp -> Q Exp) -> Q Exp
    mkSimpleLam ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Exp
    _ -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    memptyValName
                                       (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Exp
    lam)
                        , ft_var :: Name -> Q (Bool, Exp)
    ft_var  = \Name
    v -> case Map Name (OneOrTwoNames One)
    tvMap Map Name (OneOrTwoNames One) -> Name -> OneOrTwoNames One
    forall k a. Ord k => Map k a -> k -> a
    Map.! Name
    v of
                                            OneName Name
    f -> (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Name -> Exp
    VarE Name
    f)
                        , ft_tup :: TupleSort -> [Q (Bool, Exp)] -> Q (Bool, Exp)
    ft_tup  = \TupleSort
    t [Q (Bool, Exp)]
    gs -> do
                            [(Bool, Exp)]
    gg  <- [Q (Bool, Exp)] -> Q [(Bool, Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (Bool, Exp)]
    gs
                            Exp
    lam <- (Exp -> Q Exp) -> Q Exp
    mkSimpleLam ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (Name -> [(Bool, Exp)] -> Q Match)
    -> TupleSort -> [(Bool, Exp)] -> Exp -> Q Exp
    forall a.
    (Name -> [a] -> Q Match) -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase Name -> [(Bool, Exp)] -> Q Match
    match_for_con TupleSort
    t [(Bool, Exp)]
    gg
                            (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Exp
    lam)
                        , ft_ty_app :: Type -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_ty_app = \Type
    _ Q (Bool, Exp)
    g -> do
                            ((Bool, Exp) -> (Bool, Exp)) -> Q (Bool, Exp) -> Q (Bool, Exp)
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(Bool
    b, Exp
    e) -> (Bool
    b, Name -> Exp
    VarE Name
    foldMapValName Exp -> Exp -> Exp
    `AppE` Exp
    e)) Q (Bool, Exp)
    g
                        , ft_forall :: [TyVarBndrSpec] -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_forall  = \[TyVarBndrSpec]
    _ Q (Bool, Exp)
    g -> Q (Bool, Exp)
    g
                        , ft_co_var :: Name -> Q (Bool, Exp)
    ft_co_var  = \Name
    _ -> Name -> Q (Bool, Exp)
    forall a. Name -> Q a
    contravarianceError Name
    conName
                        , ft_fun :: Q (Bool, Exp) -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_fun     = \Q (Bool, Exp)
    _ Q (Bool, Exp)
    _ -> Name -> Q (Bool, Exp)
    forall a. Name -> Q a
    noFunctionsError Name
    conName
                        , ft_bad_app :: Q (Bool, Exp)
    ft_bad_app = FunctorClass -> Name -> Q (Bool, Exp)
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError FunctorClass
    Foldable Name
    conName
                        }

        match_for_con :: Name -> [(Bool, Exp)] -> Q Match
        match_for_con :: Name -> [(Bool, Exp)] -> Q Match
    match_for_con = (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    mkSimpleConMatch2 ((Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match)
    -> (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    forall a b. (a -> b) -> a -> b
    $ \Exp
    _ [Exp]
    xs -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    mkFoldMap [Exp]
    xs
          where
            -- mappend v1 (mappend v2 ..)
            mkFoldMap :: [Exp] -> Exp
            mkFoldMap :: [Exp] -> Exp
    mkFoldMap [] = Name -> Exp
    VarE Name
    memptyValName
            mkFoldMap [Exp]
    es = (Exp -> Exp -> Exp) -> [Exp] -> Exp
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp) -> (Exp -> Exp) -> Exp -> Exp -> Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE Name
    mappendValName)) [Exp]
    es

    -- | Generates a match whose right-hand side implements @null@.
    makeNullMatch :: TyVarMap1 -> ConstructorInfo -> Q Match
    makeNullMatch :: Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeNullMatch Map Name (OneOrTwoNames One)
    tvMap con :: ConstructorInfo
    con@(ConstructorInfo{constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName}) = do
      [Q (NullM Exp)]
    parts  <- Map Name (OneOrTwoNames One)
    -> FFoldType (Q (NullM Exp))
    -> ConstructorInfo
    -> Q [Q (NullM Exp)]
    forall a.
    Map Name (OneOrTwoNames One)
    -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs Map Name (OneOrTwoNames One)
    tvMap FFoldType (Q (NullM Exp))
    ft_null ConstructorInfo
    con
      [NullM Exp]
    parts' <- [Q (NullM Exp)] -> Q [NullM Exp]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (NullM Exp)]
    parts
      case [NullM Exp] -> Maybe [(Bool, Exp)]
    forall a. [NullM a] -> Maybe [(Bool, a)]
    convert [NullM Exp]
    parts' of
        Maybe [(Bool, Exp)]
    Nothing -> Match -> Q Match
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Match -> Q Match) -> Match -> Q Match
    forall a b. (a -> b) -> a -> b
    $ Pat -> Body -> [Dec] -> Match
    Match (ConstructorInfo -> Pat
    conWildPat ConstructorInfo
    con) (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    ConE Name
    falseDataName) []
        Just [(Bool, Exp)]
    cp -> Name -> [(Bool, Exp)] -> Q Match
    match_for_con Name
    conName [(Bool, Exp)]
    cp
      where
        ft_null :: FFoldType (Q (NullM Exp))
        ft_null :: FFoldType (Q (NullM Exp))
    ft_null = FT { ft_triv :: Q (NullM Exp)
    ft_triv = NullM Exp -> Q (NullM Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NullM Exp -> Q (NullM Exp)) -> NullM Exp -> Q (NullM Exp)
    forall a b. (a -> b) -> a -> b
    $ Exp -> NullM Exp
    forall a. a -> NullM a
    IsNull (Exp -> NullM Exp) -> Exp -> NullM Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    ConE Name
    trueDataName
                     , ft_var :: Name -> Q (NullM Exp)
    ft_var  = \Name
    _ -> NullM Exp -> Q (NullM Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return NullM Exp
    forall a. NullM a
    NotNull
                     , ft_tup :: TupleSort -> [Q (NullM Exp)] -> Q (NullM Exp)
    ft_tup = \TupleSort
    t [Q (NullM Exp)]
    g -> do
                         [NullM Exp]
    gg <- [Q (NullM Exp)] -> Q [NullM Exp]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (NullM Exp)]
    g
                         case [NullM Exp] -> Maybe [(Bool, Exp)]
    forall a. [NullM a] -> Maybe [(Bool, a)]
    convert [NullM Exp]
    gg of
                           Maybe [(Bool, Exp)]
    Nothing  -> NullM Exp -> Q (NullM Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return NullM Exp
    forall a. NullM a
    NotNull
                           Just [(Bool, Exp)]
    ggg ->
                             (Exp -> NullM Exp) -> Q Exp -> Q (NullM Exp)
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Exp -> NullM Exp
    forall a. a -> NullM a
    NullM (Q Exp -> Q (NullM Exp)) -> Q Exp -> Q (NullM Exp)
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Q Exp) -> Q Exp
    mkSimpleLam
                                        ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (Name -> [(Bool, Exp)] -> Q Match)
    -> TupleSort -> [(Bool, Exp)] -> Exp -> Q Exp
    forall a.
    (Name -> [a] -> Q Match) -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase Name -> [(Bool, Exp)] -> Q Match
    match_for_con TupleSort
    t [(Bool, Exp)]
    ggg
                     , ft_ty_app :: Type -> Q (NullM Exp) -> Q (NullM Exp)
    ft_ty_app = \Type
    _ Q (NullM Exp)
    g -> ((NullM Exp -> NullM Exp) -> Q (NullM Exp) -> Q (NullM Exp))
    -> Q (NullM Exp) -> (NullM Exp -> NullM Exp) -> Q (NullM Exp)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (NullM Exp -> NullM Exp) -> Q (NullM Exp) -> Q (NullM Exp)
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Q (NullM Exp)
    g ((NullM Exp -> NullM Exp) -> Q (NullM Exp))
    -> (NullM Exp -> NullM Exp) -> Q (NullM Exp)
    forall a b. (a -> b) -> a -> b
    $ \NullM Exp
    nestedResult ->
                         case NullM Exp
    nestedResult of
                           -- If e definitely contains the parameter, then we can
                           -- test if (G e) contains it by simply checking if (G e)
                           -- is null
                           NullM Exp
    NotNull -> Exp -> NullM Exp
    forall a. a -> NullM a
    NullM (Exp -> NullM Exp) -> Exp -> NullM Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    nullValName
                           -- This case is unreachable--it will actually be caught
                           -- by ft_triv
                           r :: NullM Exp
    r@IsNull{} -> NullM Exp
    r
                           -- The general case uses (all null), (all (all null)),
                           -- etc.
                           NullM Exp
    nestedTest -> Exp -> NullM Exp
    forall a. a -> NullM a
    NullM (Exp -> NullM Exp) -> Exp -> NullM Exp
    forall a b. (a -> b) -> a -> b
    $
                                               Name -> Exp
    VarE Name
    allValName Exp -> Exp -> Exp
    `AppE` Exp
    nestedTest
                     , ft_forall :: [TyVarBndrSpec] -> Q (NullM Exp) -> Q (NullM Exp)
    ft_forall = \[TyVarBndrSpec]
    _ Q (NullM Exp)
    g -> Q (NullM Exp)
    g
                     , ft_co_var :: Name -> Q (NullM Exp)
    ft_co_var  = \Name
    _ -> Name -> Q (NullM Exp)
    forall a. Name -> Q a
    contravarianceError Name
    conName
                     , ft_fun :: Q (NullM Exp) -> Q (NullM Exp) -> Q (NullM Exp)
    ft_fun     = \Q (NullM Exp)
    _ Q (NullM Exp)
    _ -> Name -> Q (NullM Exp)
    forall a. Name -> Q a
    noFunctionsError Name
    conName
                     , ft_bad_app :: Q (NullM Exp)
    ft_bad_app = FunctorClass -> Name -> Q (NullM Exp)
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError FunctorClass
    Foldable Name
    conName
                     }

        match_for_con :: Name -> [(Bool, Exp)] -> Q Match
        match_for_con :: Name -> [(Bool, Exp)] -> Q Match
    match_for_con = (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    mkSimpleConMatch2 ((Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match)
    -> (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    forall a b. (a -> b) -> a -> b
    $ \Exp
    _ [Exp]
    xs -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    mkNull [Exp]
    xs
          where
            -- v1 && v2 && ..
            mkNull :: [Exp] -> Exp
            mkNull :: [Exp] -> Exp
    mkNull [] = Name -> Exp
    ConE Name
    trueDataName
            mkNull [Exp]
    xs = (Exp -> Exp -> Exp) -> [Exp] -> Exp
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\Exp
    x Exp
    y -> Name -> Exp
    VarE Name
    andValName Exp -> Exp -> Exp
    `AppE` Exp
    x Exp -> Exp -> Exp
    `AppE` Exp
    y) [Exp]
    xs

    -- Given a list of NullM results, produce Nothing if any of them is NotNull,
    -- and otherwise produce a list of (Bool, a) with True entries representing
    -- unknowns and False entries representing things that are definitely null.
    convert :: [NullM a] -> Maybe [(Bool, a)]
    convert :: forall a. [NullM a] -> Maybe [(Bool, a)]
    convert = (NullM a -> Maybe (Bool, a)) -> [NullM a] -> Maybe [(Bool, a)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM NullM a -> Maybe (Bool, a)
    forall {b}. NullM b -> Maybe (Bool, b)
    go where
      go :: NullM b -> Maybe (Bool, b)
    go (IsNull b
    a) = (Bool, b) -> Maybe (Bool, b)
    forall a. a -> Maybe a
    Just (Bool
    False, b
    a)
      go NullM b
    NotNull    = Maybe (Bool, b)
    forall a. Maybe a
    Nothing
      go (NullM b
    a)  = (Bool, b) -> Maybe (Bool, b)
    forall a. a -> Maybe a
    Just (Bool
    True, b
    a)

    data NullM a =
        IsNull a -- Definitely null
      | NotNull  -- Definitely not null
      | NullM a  -- Unknown

    -- | Generates a match whose right-hand side implements @traverse@.
    makeTraverseMatch :: TyVarMap1 -> ConstructorInfo -> Q Match
    makeTraverseMatch :: Map Name (OneOrTwoNames One) -> ConstructorInfo -> Q Match
    makeTraverseMatch Map Name (OneOrTwoNames One)
    tvMap con :: ConstructorInfo
    con@(ConstructorInfo{constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName}) = do
      [Q (Bool, Exp)]
    parts  <- Map Name (OneOrTwoNames One)
    -> FFoldType (Q (Bool, Exp))
    -> ConstructorInfo
    -> Q [Q (Bool, Exp)]
    forall a.
    Map Name (OneOrTwoNames One)
    -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs Map Name (OneOrTwoNames One)
    tvMap FFoldType (Q (Bool, Exp))
    ft_trav ConstructorInfo
    con
      [(Bool, Exp)]
    parts' <- [Q (Bool, Exp)] -> Q [(Bool, Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (Bool, Exp)]
    parts
      Name -> [(Bool, Exp)] -> Q Match
    match_for_con Name
    conName [(Bool, Exp)]
    parts'
      where
        -- The Bool is True if the type mentions the last type parameter, False
        -- otherwise. Later, match_for_con uses mkSimpleConMatch2 to filter out
        -- expressions that do not mention the last parameter by checking for False.
        ft_trav :: FFoldType (Q (Bool, Exp))
        ft_trav :: FFoldType (Q (Bool, Exp))
    ft_trav = FT { -- See Note [ft_triv for Bifoldable and Bitraversable]
                       ft_triv :: Q (Bool, Exp)
    ft_triv = (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Name -> Exp
    VarE Name
    pureValName)
                     , ft_var :: Name -> Q (Bool, Exp)
    ft_var  = \Name
    v -> case Map Name (OneOrTwoNames One)
    tvMap Map Name (OneOrTwoNames One) -> Name -> OneOrTwoNames One
    forall k a. Ord k => Map k a -> k -> a
    Map.! Name
    v of
                                         OneName Name
    f -> (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Name -> Exp
    VarE Name
    f)
                     , ft_tup :: TupleSort -> [Q (Bool, Exp)] -> Q (Bool, Exp)
    ft_tup  = \TupleSort
    t [Q (Bool, Exp)]
    gs -> do
                         [(Bool, Exp)]
    gg  <- [Q (Bool, Exp)] -> Q [(Bool, Exp)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q (Bool, Exp)]
    gs
                         Exp
    lam <- (Exp -> Q Exp) -> Q Exp
    mkSimpleLam ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (Name -> [(Bool, Exp)] -> Q Match)
    -> TupleSort -> [(Bool, Exp)] -> Exp -> Q Exp
    forall a.
    (Name -> [a] -> Q Match) -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase Name -> [(Bool, Exp)] -> Q Match
    match_for_con TupleSort
    t [(Bool, Exp)]
    gg
                         (Bool, Exp) -> Q (Bool, Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Exp
    lam)
                     , ft_ty_app :: Type -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_ty_app = \Type
    _ Q (Bool, Exp)
    g ->
                         ((Bool, Exp) -> (Bool, Exp)) -> Q (Bool, Exp) -> Q (Bool, Exp)
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(Bool
    b, Exp
    e) -> (Bool
    b, Name -> Exp
    VarE Name
    traverseValName Exp -> Exp -> Exp
    `AppE` Exp
    e)) Q (Bool, Exp)
    g
                     , ft_forall :: [TyVarBndrSpec] -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_forall  = \[TyVarBndrSpec]
    _ Q (Bool, Exp)
    g -> Q (Bool, Exp)
    g
                     , ft_co_var :: Name -> Q (Bool, Exp)
    ft_co_var  = \Name
    _ -> Name -> Q (Bool, Exp)
    forall a. Name -> Q a
    contravarianceError Name
    conName
                     , ft_fun :: Q (Bool, Exp) -> Q (Bool, Exp) -> Q (Bool, Exp)
    ft_fun     = \Q (Bool, Exp)
    _ Q (Bool, Exp)
    _ -> Name -> Q (Bool, Exp)
    forall a. Name -> Q a
    noFunctionsError Name
    conName
                     , ft_bad_app :: Q (Bool, Exp)
    ft_bad_app = FunctorClass -> Name -> Q (Bool, Exp)
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError FunctorClass
    Traversable Name
    conName
                     }

        -- Con a1 a2 ... -> liftA2 (\b1 b2 ... -> Con b1 b2 ...) (g1 a1)
        --                    (g2 a2) <*> ...
        match_for_con :: Name -> [(Bool, Exp)] -> Q Match
        match_for_con :: Name -> [(Bool, Exp)] -> Q Match
    match_for_con = (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    mkSimpleConMatch2 ((Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match)
    -> (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    forall a b. (a -> b) -> a -> b
    $ \Exp
    conExp [Exp]
    xs -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> [Exp] -> Exp
    mkApCon Exp
    conExp [Exp]
    xs
          where
            -- liftA2 (\b1 b2 ... -> Con b1 b2 ...) x1 x2 <*> ..
            mkApCon :: Exp -> [Exp] -> Exp
            mkApCon :: Exp -> [Exp] -> Exp
    mkApCon Exp
    conExp []  = Name -> Exp
    VarE Name
    pureValName Exp -> Exp -> Exp
    `AppE` Exp
    conExp
            mkApCon Exp
    conExp [Exp
    e] = Name -> Exp
    VarE Name
    fmapValName Exp -> Exp -> Exp
    `AppE` Exp
    conExp Exp -> Exp -> Exp
    `AppE` Exp
    e
            mkApCon Exp
    conExp (Exp
    e1:Exp
    e2:[Exp]
    es) = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' Exp -> Exp -> Exp
    appAp
              (Name -> Exp
    VarE Name
    liftA2ValName Exp -> Exp -> Exp
    `AppE` Exp
    conExp Exp -> Exp -> Exp
    `AppE` Exp
    e1 Exp -> Exp -> Exp
    `AppE` Exp
    e2) [Exp]
    es
              where appAp :: Exp -> Exp -> Exp
    appAp Exp
    se1 Exp
    se2 = Maybe Exp -> Exp -> Maybe Exp -> Exp
    InfixE (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    se1) (Name -> Exp
    VarE Name
    apValName) (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    se2)

    -------------------------------------------------------------------------------
    -- Class-specific constants
    -------------------------------------------------------------------------------

    -- | A representation of which class is being derived.
    data FunctorClass = Functor | Foldable | Traversable

    instance ClassRep FunctorClass where
        arity :: FunctorClass -> Int
    arity FunctorClass
    _ = Int
    1

        allowExQuant :: FunctorClass -> Bool
    allowExQuant FunctorClass
    Foldable = Bool
    True
        allowExQuant FunctorClass
    _        = Bool
    False

        fullClassName :: FunctorClass -> Name
    fullClassName FunctorClass
    Functor     = Name
    functorTypeName
        fullClassName FunctorClass
    Foldable    = Name
    foldableTypeName
        fullClassName FunctorClass
    Traversable = Name
    traversableTypeName

        classConstraint :: FunctorClass -> Int -> Maybe Name
    classConstraint FunctorClass
    fClass Int
    1 = Name -> Maybe Name
    forall a. a -> Maybe a
    Just (Name -> Maybe Name) -> Name -> Maybe Name
    forall a b. (a -> b) -> a -> b
    $ FunctorClass -> Name
    forall a. ClassRep a => a -> Name
    fullClassName FunctorClass
    fClass
        classConstraint  FunctorClass
    _      Int
    _ = Maybe Name
    forall a. Maybe a
    Nothing

    -- | A representation of which function is being generated.
    data FunctorFun
      = Fmap
      | Replace -- (<$)
      | Foldr
      | FoldMap
      | Null
      | Traverse
      deriving FunctorFun -> FunctorFun -> Bool
    (FunctorFun -> FunctorFun -> Bool)
    -> (FunctorFun -> FunctorFun -> Bool) -> Eq FunctorFun
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FunctorFun -> FunctorFun -> Bool
    == :: FunctorFun -> FunctorFun -> Bool
    $c/= :: FunctorFun -> FunctorFun -> Bool
    /= :: FunctorFun -> FunctorFun -> Bool
    Eq

    instance Show FunctorFun where
        showsPrec :: Int -> FunctorFun -> ShowS
    showsPrec Int
    _ FunctorFun
    Fmap     = String -> ShowS
    showString String
    "fmap"
        showsPrec Int
    _ FunctorFun
    Replace  = String -> ShowS
    showString String
    "(<$)"
        showsPrec Int
    _ FunctorFun
    Foldr    = String -> ShowS
    showString String
    "foldr"
        showsPrec Int
    _ FunctorFun
    FoldMap  = String -> ShowS
    showString String
    "foldMap"
        showsPrec Int
    _ FunctorFun
    Null     = String -> ShowS
    showString String
    "null"
        showsPrec Int
    _ FunctorFun
    Traverse = String -> ShowS
    showString String
    "traverse"

    functorFunConstName :: FunctorFun -> Name
    functorFunConstName :: FunctorFun -> Name
    functorFunConstName FunctorFun
    Fmap     = Name
    fmapConstValName
    functorFunConstName FunctorFun
    Replace  = Name
    replaceConstValName
    functorFunConstName FunctorFun
    Foldr    = Name
    foldrConstValName
    functorFunConstName FunctorFun
    FoldMap  = Name
    foldMapConstValName
    functorFunConstName FunctorFun
    Null     = Name
    nullConstValName
    functorFunConstName FunctorFun
    Traverse = Name
    traverseConstValName

    functorFunName :: FunctorFun -> Name
    functorFunName :: FunctorFun -> Name
    functorFunName FunctorFun
    Fmap     = Name
    fmapValName
    functorFunName FunctorFun
    Replace  = Name
    replaceValName
    functorFunName FunctorFun
    Foldr    = Name
    foldrValName
    functorFunName FunctorFun
    FoldMap  = Name
    foldMapValName
    functorFunName FunctorFun
    Null     = Name
    nullValName
    functorFunName FunctorFun
    Traverse = Name
    traverseValName

    functorClassToFuns :: FunctorClass -> [FunctorFun]
    functorClassToFuns :: FunctorClass -> [FunctorFun]
    functorClassToFuns FunctorClass
    Functor     = [ FunctorFun
    Fmap, FunctorFun
    Replace ]
    functorClassToFuns FunctorClass
    Foldable    = [ FunctorFun
    Foldr, FunctorFun
    FoldMap
    #if MIN_VERSION_base(4,8,0)
                                     , FunctorFun
    Null
    #endif
                                     ]
    functorClassToFuns FunctorClass
    Traversable = [ FunctorFun
    Traverse ]

    functorFunToClass :: FunctorFun -> FunctorClass
    functorFunToClass :: FunctorFun -> FunctorClass
    functorFunToClass FunctorFun
    Fmap     = FunctorClass
    Functor
    functorFunToClass FunctorFun
    Replace  = FunctorClass
    Functor
    functorFunToClass FunctorFun
    Foldr    = FunctorClass
    Foldable
    functorFunToClass FunctorFun
    FoldMap  = FunctorClass
    Foldable
    functorFunToClass FunctorFun
    Null     = FunctorClass
    Foldable
    functorFunToClass FunctorFun
    Traverse = FunctorClass
    Traversable

    -------------------------------------------------------------------------------
    -- Assorted utilities
    -------------------------------------------------------------------------------

    functorFunEmptyCase :: FunctorFun -> Name -> Name -> Q Exp
    functorFunEmptyCase :: FunctorFun -> Name -> Name -> Q Exp
    functorFunEmptyCase FunctorFun
    ff Name
    z Name
    value =
        Q Exp -> Q Exp -> FunctorFun -> Name -> Q Exp
    functorFunTrivial Q Exp
    emptyCase
                          (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    pureValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    emptyCase)
                          FunctorFun
    ff Name
    z
      where
        emptyCase :: Q Exp
        emptyCase :: Q Exp
    emptyCase = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    value) []

    functorFunNoCons :: FunctorFun -> Name -> Name -> Q Exp
    functorFunNoCons :: FunctorFun -> Name -> Name -> Q Exp
    functorFunNoCons FunctorFun
    ff Name
    z Name
    value =
        Q Exp -> Q Exp -> FunctorFun -> Name -> Q Exp
    functorFunTrivial Q Exp
    seqAndError
                          (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    pureValName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    seqAndError)
                          FunctorFun
    ff Name
    z
      where
        seqAndError :: Q Exp
        seqAndError :: Q Exp
    seqAndError = Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    seqValName) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    value) Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE`
                      Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    errorValName)
                           (String -> Q Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    stringE (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ String
    "Void " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase (FunctorFun -> Name
    functorFunName FunctorFun
    ff))

    functorFunTrivial :: Q Exp -> Q Exp -> FunctorFun -> Name -> Q Exp
    functorFunTrivial :: Q Exp -> Q Exp -> FunctorFun -> Name -> Q Exp
    functorFunTrivial Q Exp
    fmapE Q Exp
    traverseE FunctorFun
    ff Name
    z = FunctorFun -> Q Exp
    go FunctorFun
    ff
      where
        go :: FunctorFun -> Q Exp
        go :: FunctorFun -> Q Exp
    go FunctorFun
    Fmap     = Q Exp
    fmapE
        go FunctorFun
    Replace  = Q Exp
    fmapE
        go FunctorFun
    Foldr    = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    z
        go FunctorFun
    FoldMap  = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    memptyValName
        go FunctorFun
    Null     = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    trueDataName
        go FunctorFun
    Traverse = Q Exp
    traverseE

    conWildPat :: ConstructorInfo -> Pat
    conWildPat :: ConstructorInfo -> Pat
    conWildPat (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName
                                , constructorFields :: ConstructorInfo -> Cxt
    constructorFields = Cxt
    ts }) =
      Name -> [Pat] -> Pat
    conPCompat Name
    conName ([Pat] -> Pat) -> [Pat] -> Pat
    forall a b. (a -> b) -> a -> b
    $ Int -> Pat -> [Pat]
    forall a. Int -> a -> [a]
    replicate (Cxt -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    ts) Pat
    WildP

    -------------------------------------------------------------------------------
    -- Generic traversal for functor-like deriving
    -------------------------------------------------------------------------------

    -- Much of the code below is cargo-culted from the TcGenFunctor module in GHC.

    data FFoldType a      -- Describes how to fold over a Type in a functor like way
       = FT { forall a. FFoldType a -> a
    ft_triv    :: a
              -- ^ Does not contain variable
            , forall a. FFoldType a -> Name -> a
    ft_var     :: Name -> a
              -- ^ The variable itself
            , forall a. FFoldType a -> Name -> a
    ft_co_var  :: Name -> a
              -- ^ The variable itself, contravariantly
            , forall a. FFoldType a -> a -> a -> a
    ft_fun     :: a -> a -> a
              -- ^ Function type
            , forall a. FFoldType a -> TupleSort -> [a] -> a
    ft_tup     :: TupleSort -> [a] -> a
              -- ^ Tuple type. The @[a]@ is the result of folding over the
              --   arguments of the tuple.
            , forall a. FFoldType a -> Type -> a -> a
    ft_ty_app  :: Type -> a -> a
              -- ^ Type app, variable only in last argument. The 'Type' is the
              --   @arg_ty@ in @fun_ty arg_ty@.
            , forall a. FFoldType a -> a
    ft_bad_app :: a
              -- ^ Type app, variable other than in last argument
            , forall a. FFoldType a -> [TyVarBndrSpec] -> a -> a
    ft_forall  :: [TyVarBndrSpec] -> a -> a
              -- ^ Forall type
         }

    -- Note that in GHC, this function is pure. It must be monadic here since we:
    --
    -- (1) Expand type synonyms
    -- (2) Detect type family applications
    --
    -- Which require reification in Template Haskell, but are pure in Core.
    functorLikeTraverse :: forall a.
                           TyVarMap1   -- ^ Variable to look for
                        -> FFoldType a -- ^ How to fold
                        -> Type        -- ^ Type to process
                        -> Q a
    functorLikeTraverse :: forall a.
    Map Name (OneOrTwoNames One) -> FFoldType a -> Type -> Q a
    functorLikeTraverse Map Name (OneOrTwoNames One)
    tvMap (FT { ft_triv :: forall a. FFoldType a -> a
    ft_triv = a
    caseTrivial,     ft_var :: forall a. FFoldType a -> Name -> a
    ft_var = Name -> a
    caseVar
                                  , ft_co_var :: forall a. FFoldType a -> Name -> a
    ft_co_var = Name -> a
    caseCoVar,     ft_fun :: forall a. FFoldType a -> a -> a -> a
    ft_fun = a -> a -> a
    caseFun
                                  , ft_tup :: forall a. FFoldType a -> TupleSort -> [a] -> a
    ft_tup = TupleSort -> [a] -> a
    caseTuple,        ft_ty_app :: forall a. FFoldType a -> Type -> a -> a
    ft_ty_app = Type -> a -> a
    caseTyApp
                                  , ft_bad_app :: forall a. FFoldType a -> a
    ft_bad_app = a
    caseWrongArg, ft_forall :: forall a. FFoldType a -> [TyVarBndrSpec] -> a -> a
    ft_forall = [TyVarBndrSpec] -> a -> a
    caseForAll })
                        Type
    ty
      = do Type
    ty' <- Type -> Q Type
    resolveTypeSynonyms Type
    ty
           (a
    res, Bool
    _) <- Bool -> Type -> Q (a, Bool)
    go Bool
    False Type
    ty'
           a -> Q a
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    res
      where
        go :: Bool        -- Covariant or contravariant context
           -> Type
           -> Q (a, Bool) -- (result of type a, does type contain var)
        go :: Bool -> Type -> Q (a, Bool)
    go Bool
    co t :: Type
    t@AppT{}
          | (Type
    ArrowT, [Type
    funArg, Type
    funRes]) <- Type -> (Type, Cxt)
    unapplyTy Type
    t
          = do (a
    funArgR, Bool
    funArgC) <- Bool -> Type -> Q (a, Bool)
    go (Bool -> Bool
    not Bool
    co) Type
    funArg
               (a
    funResR, Bool
    funResC) <- Bool -> Type -> Q (a, Bool)
    go      Bool
    co  Type
    funRes
               if Bool
    funArgC Bool -> Bool -> Bool
    || Bool
    funResC
                  then (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> a -> a
    caseFun a
    funArgR a
    funResR, Bool
    True)
                  else Q (a, Bool)
    trivial
        go Bool
    co t :: Type
    t@AppT{} = do
          let (Type
    f, Cxt
    args) = Type -> (Type, Cxt)
    unapplyTy Type
    t
          (a
    _,   Bool
    fc)  <- Bool -> Type -> Q (a, Bool)
    go Bool
    co Type
    f
          ([a]
    xrs, [Bool]
    xcs) <- ([(a, Bool)] -> ([a], [Bool])) -> Q [(a, Bool)] -> Q ([a], [Bool])
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [(a, Bool)] -> ([a], [Bool])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (Q [(a, Bool)] -> Q ([a], [Bool]))
    -> Q [(a, Bool)] -> Q ([a], [Bool])
    forall a b. (a -> b) -> a -> b
    $ (Type -> Q (a, Bool)) -> Cxt -> Q [(a, Bool)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Bool -> Type -> Q (a, Bool)
    go Bool
    co) Cxt
    args
          let tuple :: TupleSort -> Q (a, Bool)
              tuple :: TupleSort -> Q (a, Bool)
    tuple TupleSort
    tupSort = (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TupleSort -> [a] -> a
    caseTuple TupleSort
    tupSort [a]
    xrs, Bool
    True)

              wrongArg :: Q (a, Bool)
              wrongArg :: Q (a, Bool)
    wrongArg = (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    caseWrongArg, Bool
    True)

          case () of
            ()
    _ |  Bool -> Bool
    not ([Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or [Bool]
    xcs)
              -> Q (a, Bool)
    trivial -- Variable does not occur
              -- At this point we know that xrs, xcs is not empty,
              -- and at least one xr is True
              |  TupleT Int
    len <- Type
    f
              -> TupleSort -> Q (a, Bool)
    tuple (TupleSort -> Q (a, Bool)) -> TupleSort -> Q (a, Bool)
    forall a b. (a -> b) -> a -> b
    $ Int -> TupleSort
    Boxed Int
    len
    #if MIN_VERSION_template_haskell(2,6,0)
              |  UnboxedTupleT Int
    len <- Type
    f
              -> TupleSort -> Q (a, Bool)
    tuple (TupleSort -> Q (a, Bool)) -> TupleSort -> Q (a, Bool)
    forall a b. (a -> b) -> a -> b
    $ Int -> TupleSort
    Unboxed Int
    len
    #endif
              |  Bool
    fc Bool -> Bool -> Bool
    || [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ([Bool] -> [Bool]
    forall a. HasCallStack => [a] -> [a]
    init [Bool]
    xcs)
              -> Q (a, Bool)
    wrongArg                    -- T (..var..)    ty
              |  Bool
    otherwise                   -- T (..no var..) ty
              -> do Bool
    itf <- [Name] -> Type -> Cxt -> Q Bool
    isInTypeFamilyApp [Name]
    tyVarNames Type
    f Cxt
    args
                    if Bool
    itf -- We can't decompose type families, so
                           -- error if we encounter one here.
                       then Q (a, Bool)
    wrongArg
                       else (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> a -> a
    caseTyApp (Cxt -> Type
    forall a. HasCallStack => [a] -> a
    last Cxt
    args) ([a] -> a
    forall a. HasCallStack => [a] -> a
    last [a]
    xrs), Bool
    True)
        go Bool
    co (SigT Type
    t Type
    k) = do
          (a
    _, Bool
    kc) <- Bool -> Type -> Q (a, Bool)
    go_kind Bool
    co Type
    k
          if Bool
    kc
             then (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    caseWrongArg, Bool
    True)
             else Bool -> Type -> Q (a, Bool)
    go Bool
    co Type
    t
        go Bool
    co (VarT Name
    v)
          | Name -> Map Name (OneOrTwoNames One) -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member Name
    v Map Name (OneOrTwoNames One)
    tvMap
          = (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (if Bool
    co then Name -> a
    caseCoVar Name
    v else Name -> a
    caseVar Name
    v, Bool
    True)
          | Bool
    otherwise
          = Q (a, Bool)
    trivial
        go Bool
    co (ForallT [TyVarBndrSpec]
    tvbs Cxt
    _ Type
    t) = do
          (a
    tr, Bool
    tc) <- Bool -> Type -> Q (a, Bool)
    go Bool
    co Type
    t
          let tvbNames :: [Name]
    tvbNames = (TyVarBndrSpec -> Name) -> [TyVarBndrSpec] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndrSpec -> Name
    forall flag. TyVarBndr_ flag -> Name
    tvName [TyVarBndrSpec]
    tvbs
          if Bool -> Bool
    not Bool
    tc Bool -> Bool -> Bool
    || (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    tvbNames) [Name]
    tyVarNames
             then Q (a, Bool)
    trivial
             else (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyVarBndrSpec] -> a -> a
    caseForAll [TyVarBndrSpec]
    tvbs a
    tr, Bool
    True)
        go Bool
    _ Type
    _ = Q (a, Bool)
    trivial

        go_kind :: Bool
                -> Kind
                -> Q (a, Bool)
    #if MIN_VERSION_template_haskell(2,9,0)
        go_kind :: Bool -> Type -> Q (a, Bool)
    go_kind = Bool -> Type -> Q (a, Bool)
    go
    #else
        go_kind _ _ = trivial
    #endif

        trivial :: Q (a, Bool)
        trivial :: Q (a, Bool)
    trivial = (a, Bool) -> Q (a, Bool)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    caseTrivial, Bool
    False)

        tyVarNames :: [Name]
        tyVarNames :: [Name]
    tyVarNames = Map Name (OneOrTwoNames One) -> [Name]
    forall k a. Map k a -> [k]
    Map.keys Map Name (OneOrTwoNames One)
    tvMap

    -- Fold over the arguments of a data constructor in a Functor-like way.
    foldDataConArgs :: forall a. TyVarMap1 -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs :: forall a.
    Map Name (OneOrTwoNames One)
    -> FFoldType a -> ConstructorInfo -> Q [a]
    foldDataConArgs Map Name (OneOrTwoNames One)
    tvMap FFoldType a
    ft ConstructorInfo
    con = do
      Cxt
    fieldTys <- (Type -> Q Type) -> Cxt -> Q Cxt
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> Q Type
    resolveTypeSynonyms (Cxt -> Q Cxt) -> Cxt -> Q Cxt
    forall a b. (a -> b) -> a -> b
    $ ConstructorInfo -> Cxt
    constructorFields ConstructorInfo
    con
      (Type -> Q a) -> Cxt -> Q [a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> Q a
    foldArg Cxt
    fieldTys
      where
        foldArg :: Type -> Q a
        foldArg :: Type -> Q a
    foldArg = Map Name (OneOrTwoNames One) -> FFoldType a -> Type -> Q a
    forall a.
    Map Name (OneOrTwoNames One) -> FFoldType a -> Type -> Q a
    functorLikeTraverse Map Name (OneOrTwoNames One)
    tvMap FFoldType a
    ft

    -- Make a 'LamE' using a fresh variable.
    mkSimpleLam :: (Exp -> Q Exp) -> Q Exp
    mkSimpleLam :: (Exp -> Q Exp) -> Q Exp
    mkSimpleLam Exp -> Q Exp
    lam = do
      Name
    n <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "n"
      [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    n] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Q Exp
    lam (Name -> Exp
    VarE Name
    n)

    -- Make a 'LamE' using two fresh variables.
    mkSimpleLam2 :: (Exp -> Exp -> Q Exp) -> Q Exp
    mkSimpleLam2 :: (Exp -> Exp -> Q Exp) -> Q Exp
    mkSimpleLam2 Exp -> Exp -> Q Exp
    lam = do
      Name
    n1 <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "n1"
      Name
    n2 <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "n2"
      [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    n1, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    n2] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Q Exp
    lam (Name -> Exp
    VarE Name
    n1) (Name -> Exp
    VarE Name
    n2)

    -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]"
    --
    -- @mkSimpleConMatch fold conName insides@ produces a match clause in
    -- which the LHS pattern-matches on @extraPats@, followed by a match on the
    -- constructor @conName@ and its arguments. The RHS folds (with @fold@) over
    -- @conName@ and its arguments, applying an expression (from @insides@) to each
    -- of the respective arguments of @conName@.
    mkSimpleConMatch :: (Name -> [a] -> Q Exp)
                     -> Name
                     -> [Exp -> a]
                     -> Q Match
    mkSimpleConMatch :: forall a. (Name -> [a] -> Q Exp) -> Name -> [Exp -> a] -> Q Match
    mkSimpleConMatch Name -> [a] -> Q Exp
    fold Name
    conName [Exp -> a]
    insides = do
      [Name]
    varsNeeded <- String -> Int -> Q [Name]
    newNameList String
    "_arg" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ [Exp -> a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Exp -> a]
    insides
      let pat :: Pat
    pat = Name -> [Pat] -> Pat
    conPCompat Name
    conName ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    varsNeeded)
      Exp
    rhs <- Name -> [a] -> Q Exp
    fold Name
    conName (((Exp -> a) -> Name -> a) -> [Exp -> a] -> [Name] -> [a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Exp -> a
    i Name
    v -> Exp -> a
    i (Exp -> a) -> Exp -> a
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    v) [Exp -> a]
    insides [Name]
    varsNeeded)
      Match -> Q Match
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Match -> Q Match) -> Match -> Q Match
    forall a b. (a -> b) -> a -> b
    $ Pat -> Body -> [Dec] -> Match
    Match Pat
    pat (Exp -> Body
    NormalB Exp
    rhs) []

    -- "Con a1 a2 a3 -> fmap (\b2 -> Con a1 b2 a3) (traverse f a2)"
    --
    -- @mkSimpleConMatch2 fold conName insides@ behaves very similarly to
    -- 'mkSimpleConMatch', with two key differences:
    --
    -- 1. @insides@ is a @[(Bool, Exp)]@ instead of a @[Exp]@. This is because it
    --    filters out the expressions corresponding to arguments whose types do not
    --    mention the last type variable in a derived 'Foldable' or 'Traversable'
    --    instance (i.e., those elements of @insides@ containing @False@).
    --
    -- 2. @fold@ takes an expression as its first argument instead of a
    --    constructor name. This is because it uses a specialized
    --    constructor function expression that only takes as many parameters as
    --    there are argument types that mention the last type variable.
    mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp)
                      -> Name
                      -> [(Bool, Exp)]
                      -> Q Match
    mkSimpleConMatch2 :: (Exp -> [Exp] -> Q Exp) -> Name -> [(Bool, Exp)] -> Q Match
    mkSimpleConMatch2 Exp -> [Exp] -> Q Exp
    fold Name
    conName [(Bool, Exp)]
    insides = do
      [Name]
    varsNeeded <- String -> Int -> Q [Name]
    newNameList String
    "_arg" Int
    lengthInsides
      let pat :: Pat
    pat = Name -> [Pat] -> Pat
    conPCompat Name
    conName ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    varsNeeded)
          -- Make sure to zip BEFORE invoking catMaybes. We want the variable
          -- indicies in each expression to match up with the argument indices
          -- in conExpr (defined below).
          exps :: [Exp]
    exps = [Maybe Exp] -> [Exp]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Exp] -> [Exp]) -> [Maybe Exp] -> [Exp]
    forall a b. (a -> b) -> a -> b
    $ ((Bool, Exp) -> Name -> Maybe Exp)
    -> [(Bool, Exp)] -> [Name] -> [Maybe Exp]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\(Bool
    m, Exp
    i) Name
    v -> if Bool
    m then Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp
    i Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    v)
                                                        else Maybe Exp
    forall a. Maybe a
    Nothing)
                                     [(Bool, Exp)]
    insides [Name]
    varsNeeded
          -- An element of argTysTyVarInfo is True if the constructor argument
          -- with the same index has a type which mentions the last type
          -- variable.
          argTysTyVarInfo :: [Bool]
    argTysTyVarInfo = ((Bool, Exp) -> Bool) -> [(Bool, Exp)] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Bool
    m, Exp
    _) -> Bool
    m) [(Bool, Exp)]
    insides
          ([Name]
    asWithTyVar, [Name]
    asWithoutTyVar) = [Bool] -> [Name] -> ([Name], [Name])
    forall a. [Bool] -> [a] -> ([a], [a])
    partitionByList [Bool]
    argTysTyVarInfo [Name]
    varsNeeded

          conExpQ :: Q Exp
    conExpQ
            | [Name] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    asWithTyVar = [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    conNameQ Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    :(Name -> Q Exp) -> [Name] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE [Name]
    asWithoutTyVar)
            | Bool
    otherwise = do
                [Name]
    bs <- String -> Int -> Q [Name]
    newNameList String
    "b" Int
    lengthInsides
                let bs' :: [Name]
    bs'  = [Bool] -> [Name] -> [Name]
    forall a. [Bool] -> [a] -> [a]
    filterByList  [Bool]
    argTysTyVarInfo [Name]
    bs
                    vars :: [Q Exp]
    vars = [Bool] -> [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists [Bool]
    argTysTyVarInfo
                                         ((Name -> Q Exp) -> [Name] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE [Name]
    bs) ((Name -> Q Exp) -> [Name] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE [Name]
    varsNeeded)
                [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    bs') ([Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    conNameQ Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    :[Q Exp]
    vars))

      Exp
    conExp <- Q Exp
    conExpQ
      Exp
    rhs <- Exp -> [Exp] -> Q Exp
    fold Exp
    conExp [Exp]
    exps
      Match -> Q Match
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Match -> Q Match) -> Match -> Q Match
    forall a b. (a -> b) -> a -> b
    $ Pat -> Body -> [Dec] -> Match
    Match Pat
    pat (Exp -> Body
    NormalB Exp
    rhs) []
      where
        lengthInsides :: Int
    lengthInsides = [(Bool, Exp)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Bool, Exp)]
    insides

    -- Indicates whether a tuple is boxed or unboxed, as well as its number of
    -- arguments. For instance, (a, b) corresponds to @Boxed 2@, and (# a, b, c #)
    -- corresponds to @Unboxed 3@.
    data TupleSort
      = Boxed   Int
    #if MIN_VERSION_template_haskell(2,6,0)
      | Unboxed Int
    #endif

    -- "case x of (a1,a2,a3) -> fold [x1 a1, x2 a2, x3 a3]"
    mkSimpleTupleCase :: (Name -> [a] -> Q Match)
                      -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase :: forall a.
    (Name -> [a] -> Q Match) -> TupleSort -> [a] -> Exp -> Q Exp
    mkSimpleTupleCase Name -> [a] -> Q Match
    matchForCon TupleSort
    tupSort [a]
    insides Exp
    x = do
      let tupDataName :: Name
    tupDataName = case TupleSort
    tupSort of
                          Boxed   Int
    len -> Int -> Name
    tupleDataName Int
    len
    #if MIN_VERSION_template_haskell(2,6,0)
                          Unboxed Int
    len -> Int -> Name
    unboxedTupleDataName Int
    len
    #endif
      Match
    m <- Name -> [a] -> Q Match
    matchForCon Name
    tupDataName [a]
    insides
      Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> [Match] -> Exp
    CaseE Exp
    x [Match
    m]

    -- Adapt to the type of ConP changing in template-haskell-2.18.0.0.
    conPCompat :: Name -> [Pat] -> Pat
    conPCompat :: Name -> [Pat] -> Pat
    conPCompat Name
    n [Pat]
    pats = Name -> Cxt -> [Pat] -> Pat
    ConP Name
    n
    #if MIN_VERSION_template_haskell(2,18,0)
                             []
    #endif
                             [Pat]
    pats