    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ViewPatterns #-}

    {- |
    Module      :  Generics.Deriving.TH
    Copyright   :  (c) 2008--2009 Universiteit Utrecht
    License     :  BSD3

    Maintainer  :  generics@haskell.org
    Stability   :  experimental
    Portability :  non-portable

    This module contains Template Haskell code that can be used to
    automatically generate the boilerplate code for the generic deriving
    library.

    To use these functions, pass the name of a data type as an argument:

    @
    &#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;

    data Example a = Example Int Char a
    $('deriveAll0'     ''Example) -- Derives Generic instance
    $('deriveAll1'     ''Example) -- Derives Generic1 instance
    $('deriveAll0And1' ''Example) -- Derives Generic and Generic1 instances
    @

    On GHC 7.4 or later, this code can also be used with data families. To derive
    for a data family instance, pass the name of one of the instance's constructors:

    @
    &#123;-&#35; LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies &#35;-&#125;

    data family Family a b
    newtype instance Family Char x = FamilyChar Char
    data    instance Family Bool x = FamilyTrue | FamilyFalse

    $('deriveAll0' 'FamilyChar) -- instance Generic (Family Char b) where ...
    $('deriveAll1' 'FamilyTrue) -- instance Generic1 (Family Bool) where ...
    -- Alternatively, one could type $(deriveAll1 'FamilyFalse)
    @
    -}

    -- Adapted from Generics.Regular.TH
    module Generics.Deriving.TH (
          -- * @derive@- functions
          deriveMeta
        , deriveData
        , deriveConstructors
        , deriveSelectors

        , deriveAll
        , deriveAll0
        , deriveAll1
        , deriveAll0And1
        , deriveRepresentable0
        , deriveRepresentable1
        , deriveRep0
        , deriveRep1

         -- * @make@- functions
         -- $make
        , makeRep0Inline
        , makeRep0
        , makeRep0FromType
        , makeFrom
        , makeFrom0
        , makeTo
        , makeTo0
        , makeRep1Inline
        , makeRep1
        , makeRep1FromType
        , makeFrom1
        , makeTo1

         -- * Options
         -- $options
         -- ** Option types
        , Options(..)
        , defaultOptions
        , RepOptions(..)
        , defaultRepOptions
        , KindSigOptions
        , defaultKindSigOptions
        , EmptyCaseOptions
        , defaultEmptyCaseOptions

        -- ** Functions with optional arguments
        , deriveAll0Options
        , deriveAll1Options
        , deriveAll0And1Options
        , deriveRepresentable0Options
        , deriveRepresentable1Options
        , deriveRep0Options
        , deriveRep1Options

        , makeFrom0Options
        , makeTo0Options
        , makeFrom1Options
        , makeTo1Options
      ) where

    import           Control.Monad ((>=>), unless, when)

    import qualified Data.Map as Map (empty, fromList)

    import           Generics.Deriving.TH.Internal
    import           Generics.Deriving.TH.Post4_9

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

    {- $options
    'Options' gives you a way to further tweak derived 'Generic' and 'Generic1' instances:

    *   'RepOptions': By default, all derived 'Rep' and 'Rep1' type instances emit the code
        directly (the 'InlineRep' option). One can also choose to emit a separate type
        synonym for the 'Rep' type (this is the functionality of 'deriveRep0' and
        'deriveRep1') and define a 'Rep' instance in terms of that type synonym (the
        'TypeSynonymRep' option).

    *   'EmptyCaseOptions': By default, all derived instances for empty data types
        (i.e., data types with no constructors) use 'error' in @from(1)@/@to(1)@.
        For instance, @data Empty@ would have this derived 'Generic' instance:

        @
        instance Generic Empty where
          type Rep Empty = D1 ('MetaData ...) V1
          from _ = M1 (error "No generic representation for empty datatype Empty")
          to (M1 _) = error "No generic representation for empty datatype Empty"
        @

        This matches the behavior of GHC up until 8.4, when derived @Generic(1)@
        instances began to use the @EmptyCase@ extension. In GHC 8.4, the derived
        'Generic' instance for @Empty@ would instead be:

        @
        instance Generic Empty where
          type Rep Empty = D1 ('MetaData ...) V1
          from x = M1 (case x of {})
          to (M1 x) = case x of {}
        @

        This is a slightly better encoding since, for example, any divergent
        computations passed to 'from' will actually diverge (as opposed to before,
        where the result would always be a call to 'error'). On the other hand, using
        this encoding in @generic-deriving@ has one large drawback: it requires
        enabling @EmptyCase@, an extension which was only introduced in GHC 7.8
        (and only received reliable pattern-match coverage checking in 8.2).

        The 'EmptyCaseOptions' field controls whether code should be emitted that
        uses @EmptyCase@ (i.e., 'EmptyCaseOptions' set to 'True') or not ('False').
        The default value is 'False'. Note that even if set to 'True', this option
        has no effect on GHCs before 7.8, as @EmptyCase@ did not exist then.

    *   'KindSigOptions': By default, all derived instances will use explicit kind
        signatures (when the 'KindSigOptions' is 'True'). You might wish to set the
        'KindSigOptions' to 'False' if you want a 'Generic'/'Generic1' instance at
        a particular kind that GHC will infer correctly, but the functions in this
        module won't guess correctly. You probably won't ever need this option
        unless you are a power user.
    -}

    -- | Additional options for configuring derived 'Generic'/'Generic1' instances
    -- using Template Haskell.
    data Options = Options
      { Options -> RepOptions
    repOptions       :: RepOptions
      , Options -> KindSigOptions
    kindSigOptions   :: KindSigOptions
      , Options -> KindSigOptions
    emptyCaseOptions :: EmptyCaseOptions
      } deriving (Options -> Options -> KindSigOptions
    (Options -> Options -> KindSigOptions)
    -> (Options -> Options -> KindSigOptions) -> Eq Options
    forall a.
    (a -> a -> KindSigOptions) -> (a -> a -> KindSigOptions) -> Eq a
    $c== :: Options -> Options -> KindSigOptions
    == :: Options -> Options -> KindSigOptions
    $c/= :: Options -> Options -> KindSigOptions
    /= :: Options -> Options -> KindSigOptions
    Eq, Eq Options
    Eq Options =>
    (Options -> Options -> Ordering)
    -> (Options -> Options -> KindSigOptions)
    -> (Options -> Options -> KindSigOptions)
    -> (Options -> Options -> KindSigOptions)
    -> (Options -> Options -> KindSigOptions)
    -> (Options -> Options -> Options)
    -> (Options -> Options -> Options)
    -> Ord Options
    Options -> Options -> KindSigOptions
    Options -> Options -> Ordering
    Options -> Options -> Options
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Options -> Options -> Ordering
    compare :: Options -> Options -> Ordering
    $c< :: Options -> Options -> KindSigOptions
    < :: Options -> Options -> KindSigOptions
    $c<= :: Options -> Options -> KindSigOptions
    <= :: Options -> Options -> KindSigOptions
    $c> :: Options -> Options -> KindSigOptions
    > :: Options -> Options -> KindSigOptions
    $c>= :: Options -> Options -> KindSigOptions
    >= :: Options -> Options -> KindSigOptions
    $cmax :: Options -> Options -> Options
    max :: Options -> Options -> Options
    $cmin :: Options -> Options -> Options
    min :: Options -> Options -> Options
    Ord, ReadPrec [Options]
    ReadPrec Options
    Int -> ReadS Options
    ReadS [Options]
    (Int -> ReadS Options)
    -> ReadS [Options]
    -> ReadPrec Options
    -> ReadPrec [Options]
    -> Read Options
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Options
    readsPrec :: Int -> ReadS Options
    $creadList :: ReadS [Options]
    readList :: ReadS [Options]
    $creadPrec :: ReadPrec Options
    readPrec :: ReadPrec Options
    $creadListPrec :: ReadPrec [Options]
    readListPrec :: ReadPrec [Options]
    Read, Int -> Options -> ShowS
    [Options] -> ShowS
    Options -> String
    (Int -> Options -> ShowS)
    -> (Options -> String) -> ([Options] -> ShowS) -> Show Options
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Options -> ShowS
    showsPrec :: Int -> Options -> ShowS
    $cshow :: Options -> String
    show :: Options -> String
    $cshowList :: [Options] -> ShowS
    showList :: [Options] -> ShowS
    Show)

    -- | Sensible default 'Options'.
    defaultOptions :: Options
    defaultOptions :: Options
    defaultOptions = Options
      { repOptions :: RepOptions
    repOptions       = RepOptions
    defaultRepOptions
      , kindSigOptions :: KindSigOptions
    kindSigOptions   = KindSigOptions
    defaultKindSigOptions
      , emptyCaseOptions :: KindSigOptions
    emptyCaseOptions = KindSigOptions
    defaultEmptyCaseOptions
      }

    -- | Configures whether 'Rep'/'Rep1' type instances should be defined inline in a
    -- derived 'Generic'/'Generic1' instance ('InlineRep') or defined in terms of a
    -- type synonym ('TypeSynonymRep').
    data RepOptions = InlineRep
                    | TypeSynonymRep
      deriving (RepOptions -> RepOptions -> KindSigOptions
    (RepOptions -> RepOptions -> KindSigOptions)
    -> (RepOptions -> RepOptions -> KindSigOptions) -> Eq RepOptions
    forall a.
    (a -> a -> KindSigOptions) -> (a -> a -> KindSigOptions) -> Eq a
    $c== :: RepOptions -> RepOptions -> KindSigOptions
    == :: RepOptions -> RepOptions -> KindSigOptions
    $c/= :: RepOptions -> RepOptions -> KindSigOptions
    /= :: RepOptions -> RepOptions -> KindSigOptions
    Eq, Eq RepOptions
    Eq RepOptions =>
    (RepOptions -> RepOptions -> Ordering)
    -> (RepOptions -> RepOptions -> KindSigOptions)
    -> (RepOptions -> RepOptions -> KindSigOptions)
    -> (RepOptions -> RepOptions -> KindSigOptions)
    -> (RepOptions -> RepOptions -> KindSigOptions)
    -> (RepOptions -> RepOptions -> RepOptions)
    -> (RepOptions -> RepOptions -> RepOptions)
    -> Ord RepOptions
    RepOptions -> RepOptions -> KindSigOptions
    RepOptions -> RepOptions -> Ordering
    RepOptions -> RepOptions -> RepOptions
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> KindSigOptions)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: RepOptions -> RepOptions -> Ordering
    compare :: RepOptions -> RepOptions -> Ordering
    $c< :: RepOptions -> RepOptions -> KindSigOptions
    < :: RepOptions -> RepOptions -> KindSigOptions
    $c<= :: RepOptions -> RepOptions -> KindSigOptions
    <= :: RepOptions -> RepOptions -> KindSigOptions
    $c> :: RepOptions -> RepOptions -> KindSigOptions
    > :: RepOptions -> RepOptions -> KindSigOptions
    $c>= :: RepOptions -> RepOptions -> KindSigOptions
    >= :: RepOptions -> RepOptions -> KindSigOptions
    $cmax :: RepOptions -> RepOptions -> RepOptions
    max :: RepOptions -> RepOptions -> RepOptions
    $cmin :: RepOptions -> RepOptions -> RepOptions
    min :: RepOptions -> RepOptions -> RepOptions
    Ord, ReadPrec [RepOptions]
    ReadPrec RepOptions
    Int -> ReadS RepOptions
    ReadS [RepOptions]
    (Int -> ReadS RepOptions)
    -> ReadS [RepOptions]
    -> ReadPrec RepOptions
    -> ReadPrec [RepOptions]
    -> Read RepOptions
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS RepOptions
    readsPrec :: Int -> ReadS RepOptions
    $creadList :: ReadS [RepOptions]
    readList :: ReadS [RepOptions]
    $creadPrec :: ReadPrec RepOptions
    readPrec :: ReadPrec RepOptions
    $creadListPrec :: ReadPrec [RepOptions]
    readListPrec :: ReadPrec [RepOptions]
    Read, Int -> RepOptions -> ShowS
    [RepOptions] -> ShowS
    RepOptions -> String
    (Int -> RepOptions -> ShowS)
    -> (RepOptions -> String)
    -> ([RepOptions] -> ShowS)
    -> Show RepOptions
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RepOptions -> ShowS
    showsPrec :: Int -> RepOptions -> ShowS
    $cshow :: RepOptions -> String
    show :: RepOptions -> String
    $cshowList :: [RepOptions] -> ShowS
    showList :: [RepOptions] -> ShowS
    Show)

    -- | 'InlineRep', a sensible default 'RepOptions'.
    defaultRepOptions :: RepOptions
    defaultRepOptions :: RepOptions
    defaultRepOptions = RepOptions
    InlineRep

    -- | 'True' if explicit kind signatures should be used in derived
    -- 'Generic'/'Generic1' instances, 'False' otherwise.
    type KindSigOptions = Bool

    -- | 'True', a sensible default 'KindSigOptions'.
    defaultKindSigOptions :: KindSigOptions
    defaultKindSigOptions :: KindSigOptions
    defaultKindSigOptions = KindSigOptions
    True

    -- | 'True' if generated code for empty data types should use the @EmptyCase@
    -- extension, 'False' otherwise. This has no effect on GHCs before 7.8, since
    -- @EmptyCase@ is only available in 7.8 or later.
    type EmptyCaseOptions = Bool

    -- | Sensible default 'EmptyCaseOptions'.
    defaultEmptyCaseOptions :: EmptyCaseOptions
    defaultEmptyCaseOptions :: KindSigOptions
    defaultEmptyCaseOptions = KindSigOptions
    False

    -- | A backwards-compatible synonym for 'deriveAll0'.
    deriveAll :: Name -> Q [Dec]
    deriveAll :: Name -> Q [Dec]
    deriveAll = Name -> Q [Dec]
    deriveAll0

    -- | Given the type and the name (as string) for the type to derive,
    -- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
    -- instances, and the 'Representable0' instance.
    deriveAll0 :: Name -> Q [Dec]
    deriveAll0 :: Name -> Q [Dec]
    deriveAll0 = Options -> Name -> Q [Dec]
    deriveAll0Options Options
    defaultOptions

    -- | Like 'deriveAll0', but takes an 'Options' argument.
    deriveAll0Options :: Options -> Name -> Q [Dec]
    deriveAll0Options :: Options -> Name -> Q [Dec]
    deriveAll0Options = KindSigOptions -> KindSigOptions -> Options -> Name -> Q [Dec]
    deriveAllCommon KindSigOptions
    True KindSigOptions
    False

    -- | Given the type and the name (as string) for the type to derive,
    -- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
    -- instances, and the 'Representable1' instance.
    deriveAll1 :: Name -> Q [Dec]
    deriveAll1 :: Name -> Q [Dec]
    deriveAll1 = Options -> Name -> Q [Dec]
    deriveAll1Options Options
    defaultOptions

    -- | Like 'deriveAll1', but takes an 'Options' argument.
    deriveAll1Options :: Options -> Name -> Q [Dec]
    deriveAll1Options :: Options -> Name -> Q [Dec]
    deriveAll1Options = KindSigOptions -> KindSigOptions -> Options -> Name -> Q [Dec]
    deriveAllCommon KindSigOptions
    False KindSigOptions
    True

    -- | Given the type and the name (as string) for the type to derive,
    -- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
    -- instances, the 'Representable0' instance, and the 'Representable1' instance.
    deriveAll0And1 :: Name -> Q [Dec]
    deriveAll0And1 :: Name -> Q [Dec]
    deriveAll0And1 = Options -> Name -> Q [Dec]
    deriveAll0And1Options Options
    defaultOptions

    -- | Like 'deriveAll0And1', but takes an 'Options' argument.
    deriveAll0And1Options :: Options -> Name -> Q [Dec]
    deriveAll0And1Options :: Options -> Name -> Q [Dec]
    deriveAll0And1Options = KindSigOptions -> KindSigOptions -> Options -> Name -> Q [Dec]
    deriveAllCommon KindSigOptions
    True KindSigOptions
    True

    deriveAllCommon :: Bool -> Bool -> Options -> Name -> Q [Dec]
    deriveAllCommon :: KindSigOptions -> KindSigOptions -> Options -> Name -> Q [Dec]
    deriveAllCommon KindSigOptions
    generic KindSigOptions
    generic1 Options
    opts Name
    n = do
        a <- Name -> Q [Dec]
    deriveMeta Name
    n
        b <- if generic
                then deriveRepresentableCommon Generic opts n
                else return []
        c <- if generic1
                then deriveRepresentableCommon Generic1 opts n
                else return []
        return (a ++ b ++ c)

    -- | Given the type and the name (as string) for the Representable0 type
    -- synonym to derive, generate the 'Representable0' instance.
    deriveRepresentable0 :: Name -> Q [Dec]
    deriveRepresentable0 :: Name -> Q [Dec]
    deriveRepresentable0 = Options -> Name -> Q [Dec]
    deriveRepresentable0Options Options
    defaultOptions

    -- | Like 'deriveRepresentable0', but takes an 'Options' argument.
    deriveRepresentable0Options :: Options -> Name -> Q [Dec]
    deriveRepresentable0Options :: Options -> Name -> Q [Dec]
    deriveRepresentable0Options = GenericClass -> Options -> Name -> Q [Dec]
    deriveRepresentableCommon GenericClass
    Generic

    -- | Given the type and the name (as string) for the Representable1 type
    -- synonym to derive, generate the 'Representable1' instance.
    deriveRepresentable1 :: Name -> Q [Dec]
    deriveRepresentable1 :: Name -> Q [Dec]
    deriveRepresentable1 = Options -> Name -> Q [Dec]
    deriveRepresentable1Options Options
    defaultOptions

    -- | Like 'deriveRepresentable1', but takes an 'Options' argument.
    deriveRepresentable1Options :: Options -> Name -> Q [Dec]
    deriveRepresentable1Options :: Options -> Name -> Q [Dec]
    deriveRepresentable1Options = GenericClass -> Options -> Name -> Q [Dec]
    deriveRepresentableCommon GenericClass
    Generic1

    deriveRepresentableCommon :: GenericClass -> Options -> Name -> Q [Dec]
    deriveRepresentableCommon :: GenericClass -> Options -> Name -> Q [Dec]
    deriveRepresentableCommon GenericClass
    gClass Options
    opts Name
    n = do
        rep  <- if Options -> RepOptions
    repOptions Options
    opts RepOptions -> RepOptions -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == RepOptions
    InlineRep
                   then [Dec] -> Q [Dec]
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                   else GenericClass -> KindSigOptions -> Name -> Q [Dec]
    deriveRepCommon GenericClass
    gClass (Options -> KindSigOptions
    kindSigOptions Options
    opts) Name
    n
        inst <- deriveInst gClass opts n
        return (rep ++ inst)

    -- | Derive only the 'Rep0' type synonym. Not needed if 'deriveRepresentable0'
    -- is used.
    deriveRep0 :: Name -> Q [Dec]
    deriveRep0 :: Name -> Q [Dec]
    deriveRep0 = KindSigOptions -> Name -> Q [Dec]
    deriveRep0Options KindSigOptions
    defaultKindSigOptions

    -- | Like 'deriveRep0', but takes an 'KindSigOptions' argument.
    deriveRep0Options :: KindSigOptions -> Name -> Q [Dec]
    deriveRep0Options :: KindSigOptions -> Name -> Q [Dec]
    deriveRep0Options = GenericClass -> KindSigOptions -> Name -> Q [Dec]
    deriveRepCommon GenericClass
    Generic

    -- | Derive only the 'Rep1' type synonym. Not needed if 'deriveRepresentable1'
    -- is used.
    deriveRep1 :: Name -> Q [Dec]
    deriveRep1 :: Name -> Q [Dec]
    deriveRep1 = KindSigOptions -> Name -> Q [Dec]
    deriveRep1Options KindSigOptions
    defaultKindSigOptions

    -- | Like 'deriveRep1', but takes an 'KindSigOptions' argument.
    deriveRep1Options :: KindSigOptions -> Name -> Q [Dec]
    deriveRep1Options :: KindSigOptions -> Name -> Q [Dec]
    deriveRep1Options = GenericClass -> KindSigOptions -> Name -> Q [Dec]
    deriveRepCommon GenericClass
    Generic1

    deriveRepCommon :: GenericClass -> KindSigOptions -> Name -> Q [Dec]
    deriveRepCommon :: GenericClass -> KindSigOptions -> Name -> Q [Dec]
    deriveRepCommon GenericClass
    gClass KindSigOptions
    useKindSigs Name
    n = do
      i <- Name
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    reifyDataInfo Name
    n
      let (name, instTys, cons, dv) = either error id i
          gt = GenericClass -> [Type] -> GenericTvbs
    mkGenericTvbs GenericClass
    gClass [Type]
    instTys
      -- See Note [Forcing buildTypeInstance]
      !_ <- buildTypeInstance gClass useKindSigs name instTys

      -- See Note [Kind signatures in derived instances]
      let tySynVars  = GenericTvbs -> [TyVarBndrUnit]
    genericInitTvbs GenericTvbs
    gt
          tySynVars' = if KindSigOptions
    useKindSigs
                          then [TyVarBndrUnit]
    tySynVars
                          else (TyVarBndrUnit -> TyVarBndrUnit)
    -> [TyVarBndrUnit] -> [TyVarBndrUnit]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndrUnit -> TyVarBndrUnit
    unKindedTV [TyVarBndrUnit]
    tySynVars
      fmap (:[]) $ tySynD (genRepName gClass dv name)
                          (changeTVFlags bndrReq tySynVars')
                          (repType gt dv name Map.empty cons)

    deriveInst :: GenericClass -> Options -> Name -> Q [Dec]
    deriveInst :: GenericClass -> Options -> Name -> Q [Dec]
    deriveInst GenericClass
    Generic  = Name
    -> Name
    -> GenericClass
    -> Name
    -> Name
    -> Options
    -> Name
    -> Q [Dec]
    deriveInstCommon Name
    genericTypeName  Name
    repTypeName  GenericClass
    Generic  Name
    fromValName  Name
    toValName
    deriveInst GenericClass
    Generic1 = Name
    -> Name
    -> GenericClass
    -> Name
    -> Name
    -> Options
    -> Name
    -> Q [Dec]
    deriveInstCommon Name
    generic1TypeName Name
    rep1TypeName GenericClass
    Generic1 Name
    from1ValName Name
    to1ValName

    deriveInstCommon :: Name
                     -> Name
                     -> GenericClass
                     -> Name
                     -> Name
                     -> Options
                     -> Name
                     -> Q [Dec]
    deriveInstCommon :: Name
    -> Name
    -> GenericClass
    -> Name
    -> Name
    -> Options
    -> Name
    -> Q [Dec]
    deriveInstCommon Name
    genericName Name
    repName GenericClass
    gClass Name
    fromName Name
    toName Options
    opts Name
    n = do
      i <- Name
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    reifyDataInfo Name
    n
      let (name, instTys, cons, dv) = either error id i
          gt = GenericClass -> [Type] -> GenericTvbs
    mkGenericTvbs GenericClass
    gClass [Type]
    instTys
          useKindSigs = Options -> KindSigOptions
    kindSigOptions Options
    opts
      -- See Note [Forcing buildTypeInstance]
      !(origTy, origKind) <- buildTypeInstance gClass useKindSigs name instTys
      tyInsRHS <- if repOptions opts == InlineRep
                     then repType gt dv name Map.empty cons
                     else makeRepTySynApp gClass dv name origTy

      let origSigTy = if KindSigOptions
    useKindSigs
                         then Type -> Type -> Type
    SigT Type
    origTy Type
    origKind
                         else Type
    origTy
      tyIns <- tySynInstDCompat repName Nothing [return origSigTy] (return tyInsRHS)
      let ecOptions = Options -> KindSigOptions
    emptyCaseOptions Options
    opts
          mkBody GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    maker = [[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
    $
                                  Q Match -> Q Exp
    mkCaseExp (Q Match -> Q Exp) -> Q Match -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                                  GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    maker GenericTvbs
    gt KindSigOptions
    ecOptions Name
    name [ConstructorInfo]
    cons)
                                 []]
          fcs = (GenericTvbs
     -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match)
    -> [Q Clause]
    mkBody GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkFrom
          tcs = (GenericTvbs
     -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match)
    -> [Q Clause]
    mkBody GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkTo

          inline_pragmas
            | [ConstructorInfo] -> KindSigOptions
    inlining_useful [ConstructorInfo]
    cons
            = (Name -> Q Dec) -> [Name] -> [Q Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Name
    fun_name ->
                    Name -> Inline -> RuleMatch -> Phases -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    Name -> Inline -> RuleMatch -> Phases -> m Dec
    pragInlD Name
    fun_name
                             Inline
    Inline RuleMatch
    FunLike (Int -> Phases
    FromPhase Int
    1)
                  ) [Name
    fromName, Name
    toName]
            | KindSigOptions
    otherwise
            = []

      fmap (:[]) $
        instanceD (cxt []) (conT genericName `appT` return origSigTy)
                           (inline_pragmas ++ [return tyIns, funD fromName fcs, funD toName tcs])
      where
        -- Adapted from inlining_useful in GHC.Tc.Deriv.Generics.mkBindsRep in the
        -- GHC source code:
        --
        -- https://gitlab.haskell.org/ghc/ghc/-/blob/80729d96e47c99dc38e83612dfcfe01cf565eac0/compiler/GHC/Tc/Deriv/Generics.hs#L368-386
        inlining_useful :: [ConstructorInfo] -> KindSigOptions
    inlining_useful [ConstructorInfo]
    cons
          | Int
    ncons Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    1  = KindSigOptions
    True
          | Int
    ncons Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    4  = Int
    max_fields Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    5
          | Int
    ncons Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    8  = Int
    max_fields Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    2
          | Int
    ncons Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    16 = Int
    max_fields Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    1
          | Int
    ncons Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int
    24 = Int
    max_fields Int -> Int -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Int
    0
          | KindSigOptions
    otherwise   = KindSigOptions
    False
          where
            ncons :: Int
    ncons      = [ConstructorInfo] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ConstructorInfo]
    cons
            max_fields :: Int
    max_fields = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (ConstructorInfo -> Int) -> [ConstructorInfo] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Type] -> Int)
    -> (ConstructorInfo -> [Type]) -> ConstructorInfo -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConstructorInfo -> [Type]
    constructorFields) [ConstructorInfo]
    cons

    {- $make

    There are some data types for which the Template Haskell deriver functions in
    this module are not sophisticated enough to infer the correct 'Generic' or
    'Generic1' instances. As an example, consider this data type:

    @
    newtype Fix f a = Fix (f (Fix f a))
    @

    A proper 'Generic1' instance would look like this:

    @
    instance Functor f => Generic1 (Fix f) where ...
    @

    Unfortunately, 'deriveRepresentable1' cannot infer the @Functor f@ constraint.
    One can still define a 'Generic1' instance for @Fix@, however, by using the
    functions in this module that are prefixed with @make@-. For example:

    @
    $('deriveMeta' ''Fix)
    $('deriveRep1' ''Fix)
    instance Functor f => Generic1 (Fix f) where
      type Rep1 (Fix f) = $('makeRep1Inline' ''Fix [t| Fix f |])
      from1 = $('makeFrom1' ''Fix)
      to1   = $('makeTo1'   ''Fix)
    @

    Note that due to the lack of type-level lambdas in Haskell, one must manually
    apply @'makeRep1Inline' ''Fix@ to the type @Fix f@.

    Be aware that there is a bug on GHC 7.0, 7.2, and 7.4 which might prevent you from
    using 'makeRep0Inline' and 'makeRep1Inline'. In the @Fix@ example above, you
    would experience the following error:

    @
        Kinded thing `f' used as a type
        In the Template Haskell quotation [t| Fix f |]
    @

    Then a workaround is to use 'makeRep1' instead, which requires you to:

    1. Invoke 'deriveRep1' beforehand

    2. Pass as arguments the type variables that occur in the instance, in order
       from left to right, topologically sorted, excluding duplicates. (Normally,
       'makeRep1Inline' would figure this out for you.)

    Using the above example:

    @
    $('deriveMeta' ''Fix)
    $('deriveRep1' ''Fix)
    instance Functor f => Generic1 (Fix f) where
      type Rep1 (Fix f) = $('makeRep1' ''Fix) f
      from1 = $('makeFrom1' ''Fix)
      to1   = $('makeTo1'   ''Fix)
    @

    On GHC 7.4, you might encounter more complicated examples involving data
    families. For instance:

    @
    data family Fix a b c d
    newtype instance Fix b (f c) (g b) a = Fix (f (Fix b (f c) (g b) a))

    $('deriveMeta' ''Fix)
    $('deriveRep1' ''Fix)
    instance Functor f => Generic1 (Fix b (f c) (g b)) where
      type Rep1 (Fix b (f c) (g b)) = $('makeRep1' 'Fix) b f c g
      from1 = $('makeFrom1' 'Fix)
      to1   = $('makeTo1'   'Fix)
    @

    Note that you don't pass @b@ twice, only once.
    -}

    -- | Generates the full 'Rep' type inline. Since this type can be quite
    -- large, it is recommended you only use this to define 'Rep', e.g.,
    --
    -- @
    -- type Rep (Foo (a :: k) b) = $('makeRep0Inline' ''Foo [t| Foo (a :: k) b |])
    -- @
    --
    -- You can then simply refer to @Rep (Foo a b)@ elsewhere.
    --
    -- Note that the type passed as an argument to 'makeRep0Inline' must match the
    -- type argument of 'Rep' exactly, even up to including the explicit kind
    -- signature on @a@. This is due to a limitation of Template Haskell—without
    -- the kind signature, 'makeRep0Inline' has no way of figuring out the kind of
    -- @a@, and the generated type might be completely wrong as a result!
    makeRep0Inline :: Name -> Q Type -> Q Type
    makeRep0Inline :: Name -> Q Type -> Q Type
    makeRep0Inline Name
    n = GenericClass -> RepOptions -> Name -> Maybe (Q Type) -> Q Type
    makeRepCommon GenericClass
    Generic RepOptions
    InlineRep Name
    n (Maybe (Q Type) -> Q Type)
    -> (Q Type -> Maybe (Q Type)) -> Q Type -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Type -> Maybe (Q Type)
    forall a. a -> Maybe a
    Just

    -- | Generates the full 'Rep1' type inline. Since this type can be quite
    -- large, it is recommended you only use this to define 'Rep1', e.g.,
    --
    -- @
    -- type Rep1 (Foo (a :: k)) = $('makeRep0Inline' ''Foo [t| Foo (a :: k) |])
    -- @
    --
    -- You can then simply refer to @Rep1 (Foo a)@ elsewhere.
    --
    -- Note that the type passed as an argument to 'makeRep1Inline' must match the
    -- type argument of 'Rep1' exactly, even up to including the explicit kind
    -- signature on @a@. This is due to a limitation of Template Haskell—without
    -- the kind signature, 'makeRep1Inline' has no way of figuring out the kind of
    -- @a@, and the generated type might be completely wrong as a result!
    makeRep1Inline :: Name -> Q Type -> Q Type
    makeRep1Inline :: Name -> Q Type -> Q Type
    makeRep1Inline Name
    n = GenericClass -> RepOptions -> Name -> Maybe (Q Type) -> Q Type
    makeRepCommon GenericClass
    Generic1 RepOptions
    InlineRep Name
    n (Maybe (Q Type) -> Q Type)
    -> (Q Type -> Maybe (Q Type)) -> Q Type -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Type -> Maybe (Q Type)
    forall a. a -> Maybe a
    Just

    -- | Generates the 'Rep' type synonym constructor (as opposed to 'deriveRep0',
    -- which generates the type synonym declaration). After splicing it into
    -- Haskell source, it expects types as arguments. For example:
    --
    -- @
    -- type Rep (Foo a b) = $('makeRep0' ''Foo) a b
    -- @
    --
    -- The use of 'makeRep0' is generally discouraged, as it can sometimes be
    -- difficult to predict the order in which you are expected to pass type
    -- variables. As a result, 'makeRep0Inline' is recommended instead. However,
    -- 'makeRep0Inline' is not usable on GHC 7.0, 7.2, or 7.4 due to a GHC bug,
    -- so 'makeRep0' still exists for GHC 7.0, 7.2, and 7.4 users.
    makeRep0 :: Name -> Q Type
    makeRep0 :: Name -> Q Type
    makeRep0 Name
    n = GenericClass -> RepOptions -> Name -> Maybe (Q Type) -> Q Type
    makeRepCommon GenericClass
    Generic RepOptions
    TypeSynonymRep Name
    n Maybe (Q Type)
    forall a. Maybe a
    Nothing

    -- | Generates the 'Rep1' type synonym constructor (as opposed to 'deriveRep1',
    -- which generates the type synonym declaration). After splicing it into
    -- Haskell source, it expects types as arguments. For example:
    --
    -- @
    -- type Rep1 (Foo a) = $('makeRep1' ''Foo) a
    -- @
    --
    -- The use of 'makeRep1' is generally discouraged, as it can sometimes be
    -- difficult to predict the order in which you are expected to pass type
    -- variables. As a result, 'makeRep1Inline' is recommended instead. However,
    -- 'makeRep1Inline' is not usable on GHC 7.0, 7.2, or 7.4 due to a GHC bug,
    -- so 'makeRep1' still exists for GHC 7.0, 7.2, and 7.4 users.
    makeRep1 :: Name -> Q Type
    makeRep1 :: Name -> Q Type
    makeRep1 Name
    n = GenericClass -> RepOptions -> Name -> Maybe (Q Type) -> Q Type
    makeRepCommon GenericClass
    Generic1 RepOptions
    TypeSynonymRep Name
    n Maybe (Q Type)
    forall a. Maybe a
    Nothing

    -- | Generates the 'Rep' type synonym constructor (as opposed to 'deriveRep0',
    -- which generates the type synonym declaration) applied to its type arguments.
    -- Unlike 'makeRep0', this also takes a quoted 'Type' as an argument, e.g.,
    --
    -- @
    -- type Rep (Foo (a :: k) b) = $('makeRep0FromType' ''Foo [t| Foo (a :: k) b |])
    -- @
    --
    -- Note that the type passed as an argument to 'makeRep0FromType' must match the
    -- type argument of 'Rep' exactly, even up to including the explicit kind
    -- signature on @a@. This is due to a limitation of Template Haskell—without
    -- the kind signature, 'makeRep0FromType' has no way of figuring out the kind of
    -- @a@, and the generated type might be completely wrong as a result!
    --
    -- The use of 'makeRep0FromType' is generally discouraged, since 'makeRep0Inline'
    -- does exactly the same thing but without having to go through an intermediate
    -- type synonym, and as a result, 'makeRep0Inline' tends to be less buggy.
    makeRep0FromType :: Name -> Q Type -> Q Type
    makeRep0FromType :: Name -> Q Type -> Q Type
    makeRep0FromType Name
    n = GenericClass -> RepOptions -> Name -> Maybe (Q Type) -> Q Type
    makeRepCommon GenericClass
    Generic RepOptions
    TypeSynonymRep Name
    n (Maybe (Q Type) -> Q Type)
    -> (Q Type -> Maybe (Q Type)) -> Q Type -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Type -> Maybe (Q Type)
    forall a. a -> Maybe a
    Just

    -- | Generates the 'Rep1' type synonym constructor (as opposed to 'deriveRep1',
    -- which generates the type synonym declaration) applied to its type arguments.
    -- Unlike 'makeRep1', this also takes a quoted 'Type' as an argument, e.g.,
    --
    -- @
    -- type Rep1 (Foo (a :: k)) = $('makeRep1FromType' ''Foo [t| Foo (a :: k) |])
    -- @
    --
    -- Note that the type passed as an argument to 'makeRep1FromType' must match the
    -- type argument of 'Rep' exactly, even up to including the explicit kind
    -- signature on @a@. This is due to a limitation of Template Haskell—without
    -- the kind signature, 'makeRep1FromType' has no way of figuring out the kind of
    -- @a@, and the generated type might be completely wrong as a result!
    --
    -- The use of 'makeRep1FromType' is generally discouraged, since 'makeRep1Inline'
    -- does exactly the same thing but without having to go through an intermediate
    -- type synonym, and as a result, 'makeRep1Inline' tends to be less buggy.
    makeRep1FromType :: Name -> Q Type -> Q Type
    makeRep1FromType :: Name -> Q Type -> Q Type
    makeRep1FromType Name
    n = GenericClass -> RepOptions -> Name -> Maybe (Q Type) -> Q Type
    makeRepCommon GenericClass
    Generic1 RepOptions
    TypeSynonymRep Name
    n (Maybe (Q Type) -> Q Type)
    -> (Q Type -> Maybe (Q Type)) -> Q Type -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Type -> Maybe (Q Type)
    forall a. a -> Maybe a
    Just

    makeRepCommon :: GenericClass
                  -> RepOptions
                  -> Name
                  -> Maybe (Q Type)
                  -> Q Type
    makeRepCommon :: GenericClass -> RepOptions -> Name -> Maybe (Q Type) -> Q Type
    makeRepCommon GenericClass
    gClass RepOptions
    repOpts Name
    n Maybe (Q Type)
    mbQTy = do
      i <- Name
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    reifyDataInfo Name
    n
      let (name, instTys, cons, dv) = either error id i
          gt = GenericClass -> [Type] -> GenericTvbs
    mkGenericTvbs GenericClass
    gClass [Type]
    instTys
      -- See Note [Forcing buildTypeInstance]
      !_ <- buildTypeInstance gClass False name instTys

      case (mbQTy, repOpts) of
           (Just Q Type
    qTy, RepOptions
    TypeSynonymRep) -> Q Type
    qTy Q Type -> (Type -> Q Type) -> Q Type
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GenericClass -> DatatypeVariant_ -> Name -> Type -> Q Type
    makeRepTySynApp GenericClass
    gClass DatatypeVariant_
    dv Name
    name
           (Just Q Type
    qTy, RepOptions
    InlineRep)      -> Q Type
    qTy Q Type -> (Type -> Q Type) -> Q Type
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GenericTvbs
    -> DatatypeVariant_ -> Name -> [ConstructorInfo] -> Type -> Q Type
    makeRepInline GenericTvbs
    gt DatatypeVariant_
    dv Name
    name [ConstructorInfo]
    cons
           (Maybe (Q Type)
    Nothing,  RepOptions
    TypeSynonymRep) -> Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT (Name -> Q Type) -> Name -> Q Type
    forall a b. (a -> b) -> a -> b
    $ GenericClass -> DatatypeVariant_ -> Name -> Name
    genRepName GenericClass
    gClass DatatypeVariant_
    dv Name
    name
           (Maybe (Q Type)
    Nothing,  RepOptions
    InlineRep)      -> String -> Q Type
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "makeRepCommon"

    makeRepInline :: GenericTvbs
                  -> DatatypeVariant_
                  -> Name
                  -> [ConstructorInfo]
                  -> Type
                  -> Q Type
    makeRepInline :: GenericTvbs
    -> DatatypeVariant_ -> Name -> [ConstructorInfo] -> Type -> Q Type
    makeRepInline GenericTvbs
    gt DatatypeVariant_
    dv Name
    name [ConstructorInfo]
    cons Type
    ty = do
      let instVars :: [TyVarBndrUnit]
    instVars = [Type] -> [TyVarBndrUnit]
    freeVariablesWellScoped [Type
    ty]
          tySynVars :: [TyVarBndrUnit]
    tySynVars = GenericTvbs -> [TyVarBndrUnit]
    genericInitTvbs GenericTvbs
    gt

          typeSubst :: TypeSubst
          typeSubst :: TypeSubst
    typeSubst = [(Name, Type)] -> TypeSubst
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Type)] -> TypeSubst) -> [(Name, Type)] -> TypeSubst
    forall a b. (a -> b) -> a -> b
    $
            [Name] -> [Type] -> [(Name, Type)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndrUnit -> Name
    forall flag. TyVarBndr_ flag -> Name
    tvName [TyVarBndrUnit]
    tySynVars)
                ((TyVarBndrUnit -> Type) -> [TyVarBndrUnit] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> Type
    VarT (Name -> Type) -> (TyVarBndrUnit -> Name) -> TyVarBndrUnit -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyVarBndrUnit -> Name
    forall flag. TyVarBndr_ flag -> Name
    tvName) [TyVarBndrUnit]
    instVars)

      GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> TypeSubst
    -> [ConstructorInfo]
    -> Q Type
    repType GenericTvbs
    gt DatatypeVariant_
    dv Name
    name TypeSubst
    typeSubst [ConstructorInfo]
    cons

    makeRepTySynApp :: GenericClass -> DatatypeVariant_ -> Name
                    -> Type -> Q Type
    makeRepTySynApp :: GenericClass -> DatatypeVariant_ -> Name -> Type -> Q Type
    makeRepTySynApp GenericClass
    gClass DatatypeVariant_
    dv Name
    name Type
    ty =
      -- Here, we figure out the distinct type variables (in order from left-to-right)
      -- of the LHS of the Rep(1) instance. We call unKindedTV because the kind
      -- inferencer can figure out the kinds perfectly well, so we don't need to
      -- give anything here explicit kind signatures.
      let instTvbs :: [TyVarBndrUnit]
    instTvbs = (TyVarBndrUnit -> TyVarBndrUnit)
    -> [TyVarBndrUnit] -> [TyVarBndrUnit]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndrUnit -> TyVarBndrUnit
    unKindedTV ([TyVarBndrUnit] -> [TyVarBndrUnit])
    -> [TyVarBndrUnit] -> [TyVarBndrUnit]
    forall a b. (a -> b) -> a -> b
    $ [Type] -> [TyVarBndrUnit]
    freeVariablesWellScoped [Type
    ty]
      in Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> Q Type) -> Type -> Q Type
    forall a b. (a -> b) -> a -> b
    $ Name -> [TyVarBndrUnit] -> Type
    forall flag. Name -> [TyVarBndr_ flag] -> Type
    applyTyToTvbs (GenericClass -> DatatypeVariant_ -> Name -> Name
    genRepName GenericClass
    gClass DatatypeVariant_
    dv Name
    name) [TyVarBndrUnit]
    instTvbs

    -- | A backwards-compatible synonym for 'makeFrom0'.
    makeFrom :: Name -> Q Exp
    makeFrom :: Name -> Q Exp
    makeFrom = Name -> Q Exp
    makeFrom0

    -- | Generates a lambda expression which behaves like 'from'.
    makeFrom0 :: Name -> Q Exp
    makeFrom0 :: Name -> Q Exp
    makeFrom0 = KindSigOptions -> Name -> Q Exp
    makeFrom0Options KindSigOptions
    defaultEmptyCaseOptions

    -- | Like 'makeFrom0Options', but takes an 'EmptyCaseOptions' argument.
    makeFrom0Options :: EmptyCaseOptions -> Name -> Q Exp
    makeFrom0Options :: KindSigOptions -> Name -> Q Exp
    makeFrom0Options = (GenericTvbs
     -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match)
    -> GenericClass -> KindSigOptions -> Name -> Q Exp
    makeFunCommon GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkFrom GenericClass
    Generic

    -- | A backwards-compatible synonym for 'makeTo0'.
    makeTo :: Name -> Q Exp
    makeTo :: Name -> Q Exp
    makeTo = Name -> Q Exp
    makeTo0

    -- | Generates a lambda expression which behaves like 'to'.
    makeTo0 :: Name -> Q Exp
    makeTo0 :: Name -> Q Exp
    makeTo0 = KindSigOptions -> Name -> Q Exp
    makeTo0Options KindSigOptions
    defaultEmptyCaseOptions

    -- | Like 'makeTo0Options', but takes an 'EmptyCaseOptions' argument.
    makeTo0Options :: EmptyCaseOptions -> Name -> Q Exp
    makeTo0Options :: KindSigOptions -> Name -> Q Exp
    makeTo0Options = (GenericTvbs
     -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match)
    -> GenericClass -> KindSigOptions -> Name -> Q Exp
    makeFunCommon GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkTo GenericClass
    Generic

    -- | Generates a lambda expression which behaves like 'from1'.
    makeFrom1 :: Name -> Q Exp
    makeFrom1 :: Name -> Q Exp
    makeFrom1 = KindSigOptions -> Name -> Q Exp
    makeFrom1Options KindSigOptions
    defaultEmptyCaseOptions

    -- | Like 'makeFrom1Options', but takes an 'EmptyCaseOptions' argument.
    makeFrom1Options :: EmptyCaseOptions -> Name -> Q Exp
    makeFrom1Options :: KindSigOptions -> Name -> Q Exp
    makeFrom1Options = (GenericTvbs
     -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match)
    -> GenericClass -> KindSigOptions -> Name -> Q Exp
    makeFunCommon GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkFrom GenericClass
    Generic1

    -- | Generates a lambda expression which behaves like 'to1'.
    makeTo1 :: Name -> Q Exp
    makeTo1 :: Name -> Q Exp
    makeTo1 = KindSigOptions -> Name -> Q Exp
    makeTo1Options KindSigOptions
    defaultEmptyCaseOptions

    -- | Like 'makeTo1Options', but takes an 'EmptyCaseOptions' argument.
    makeTo1Options :: EmptyCaseOptions -> Name -> Q Exp
    makeTo1Options :: KindSigOptions -> Name -> Q Exp
    makeTo1Options = (GenericTvbs
     -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match)
    -> GenericClass -> KindSigOptions -> Name -> Q Exp
    makeFunCommon GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkTo GenericClass
    Generic1

    makeFunCommon
      :: (GenericTvbs -> EmptyCaseOptions -> Name -> [ConstructorInfo] -> Q Match)
      -> GenericClass -> EmptyCaseOptions -> Name -> Q Exp
    makeFunCommon :: (GenericTvbs
     -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match)
    -> GenericClass -> KindSigOptions -> Name -> Q Exp
    makeFunCommon GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    maker GenericClass
    gClass KindSigOptions
    ecOptions Name
    n = do
      i <- Name
    -> Q (Either
            String (Name, [Type], [ConstructorInfo], DatatypeVariant_))
    reifyDataInfo Name
    n
      let (name, instTys, cons, _) = either error id i
          gt = GenericClass -> [Type] -> GenericTvbs
    mkGenericTvbs GenericClass
    gClass [Type]
    instTys
      -- See Note [Forcing buildTypeInstance]
      buildTypeInstance gClass False name instTys
        `seq` mkCaseExp (maker gt ecOptions name cons)

    genRepName :: GenericClass -> DatatypeVariant_
               -> Name -> Name
    genRepName :: GenericClass -> DatatypeVariant_ -> Name -> Name
    genRepName GenericClass
    gClass DatatypeVariant_
    dv Name
    n
      = String -> Name
    mkName
      (String -> Name) -> ShowS -> String -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DatatypeVariant_ -> ShowS
    showsDatatypeVariant DatatypeVariant_
    dv
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String
    "Rep" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (GenericClass -> Int
    forall a. Enum a => a -> Int
    fromEnum GenericClass
    gClass)) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Name -> String
    showNameQual Name
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "_") String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    sanitizeName
      (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ Name -> String
    nameBase Name
    n

    repType :: GenericTvbs
            -> DatatypeVariant_
            -> Name
            -> TypeSubst
            -> [ConstructorInfo]
            -> Q Type
    repType :: GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> TypeSubst
    -> [ConstructorInfo]
    -> Q Type
    repType GenericTvbs
    gt DatatypeVariant_
    dv Name
    dt TypeSubst
    typeSubst [ConstructorInfo]
    cs =
        Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    d1TypeName Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` DatatypeVariant_ -> Name -> Q Type
    mkMetaDataType DatatypeVariant_
    dv Name
    dt Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT`
          (Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
    forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal Q Type -> Q Type -> Q Type
    sum' (Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    v1TypeName) ((ConstructorInfo -> Q Type) -> [ConstructorInfo] -> [Q Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> TypeSubst
    -> ConstructorInfo
    -> Q Type
    repCon GenericTvbs
    gt DatatypeVariant_
    dv Name
    dt TypeSubst
    typeSubst) [ConstructorInfo]
    cs)
      where
        sum' :: Q Type -> Q Type -> Q Type
        sum' :: Q Type -> Q Type -> Q Type
    sum' Q Type
    a Q Type
    b = Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    sumTypeName Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` Q Type
    a Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` Q Type
    b

    repCon :: GenericTvbs
           -> DatatypeVariant_
           -> Name
           -> TypeSubst
           -> ConstructorInfo
           -> Q Type
    repCon :: GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> TypeSubst
    -> ConstructorInfo
    -> Q Type
    repCon GenericTvbs
    gt DatatypeVariant_
    dv Name
    dt TypeSubst
    typeSubst
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName       = Name
    n
                       , constructorVars :: ConstructorInfo -> [TyVarBndrUnit]
    constructorVars       = [TyVarBndrUnit]
    vars
                       , constructorContext :: ConstructorInfo -> [Type]
    constructorContext    = [Type]
    ctxt
                       , constructorStrictness :: ConstructorInfo -> [FieldStrictness]
    constructorStrictness = [FieldStrictness]
    bangs
                       , constructorFields :: ConstructorInfo -> [Type]
    constructorFields     = [Type]
    ts
                       , constructorVariant :: ConstructorInfo -> ConstructorVariant
    constructorVariant    = ConstructorVariant
    cv
                       }) = do
      Name -> [TyVarBndrUnit] -> [Type] -> Q ()
    checkExistentialContext Name
    n [TyVarBndrUnit]
    vars [Type]
    ctxt
      let mbSelNames :: Maybe [Name]
    mbSelNames = case ConstructorVariant
    cv of
                         ConstructorVariant
    NormalConstructor          -> Maybe [Name]
    forall a. Maybe a
    Nothing
                         ConstructorVariant
    InfixConstructor           -> Maybe [Name]
    forall a. Maybe a
    Nothing
                         RecordConstructor [Name]
    selNames -> [Name] -> Maybe [Name]
    forall a. a -> Maybe a
    Just [Name]
    selNames
          isRecord :: KindSigOptions
    isRecord   = case ConstructorVariant
    cv of
                         ConstructorVariant
    NormalConstructor   -> KindSigOptions
    False
                         ConstructorVariant
    InfixConstructor    -> KindSigOptions
    False
                         RecordConstructor [Name]
    _ -> KindSigOptions
    True
          isInfix :: KindSigOptions
    isInfix    = case ConstructorVariant
    cv of
                         ConstructorVariant
    NormalConstructor   -> KindSigOptions
    False
                         ConstructorVariant
    InfixConstructor    -> KindSigOptions
    True
                         RecordConstructor [Name]
    _ -> KindSigOptions
    False
      ssis <- Name -> [FieldStrictness] -> Q [SelStrictInfo]
    reifySelStrictInfo Name
    n [FieldStrictness]
    bangs
      repConWith gt dv dt n typeSubst mbSelNames ssis ts isRecord isInfix

    repConWith :: GenericTvbs
               -> DatatypeVariant_
               -> Name
               -> Name
               -> TypeSubst
               -> Maybe [Name]
               -> [SelStrictInfo]
               -> [Type]
               -> Bool
               -> Bool
               -> Q Type
    repConWith :: GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> Name
    -> TypeSubst
    -> Maybe [Name]
    -> [SelStrictInfo]
    -> [Type]
    -> KindSigOptions
    -> KindSigOptions
    -> Q Type
    repConWith GenericTvbs
    gt DatatypeVariant_
    dv Name
    dt Name
    n TypeSubst
    typeSubst Maybe [Name]
    mbSelNames [SelStrictInfo]
    ssis [Type]
    ts KindSigOptions
    isRecord KindSigOptions
    isInfix = do
        let structureType :: Q Type
            structureType :: Q Type
    structureType = (Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
    forall a. (a -> a -> a) -> a -> [a] -> a
    foldBal Q Type -> Q Type -> Q Type
    prodT (Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    u1TypeName) [Q Type]
    f

            f :: [Q Type]
            f :: [Q Type]
    f = case Maybe [Name]
    mbSelNames of
                     Just [Name]
    selNames -> (Name -> SelStrictInfo -> Type -> Q Type)
    -> [Name] -> [SelStrictInfo] -> [Type] -> [Q Type]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 (GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> Name
    -> TypeSubst
    -> Maybe Name
    -> SelStrictInfo
    -> Type
    -> Q Type
    repField GenericTvbs
    gt DatatypeVariant_
    dv Name
    dt Name
    n TypeSubst
    typeSubst (Maybe Name -> SelStrictInfo -> Type -> Q Type)
    -> (Name -> Maybe Name) -> Name -> SelStrictInfo -> Type -> Q Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Maybe Name
    forall a. a -> Maybe a
    Just)
                                               [Name]
    selNames [SelStrictInfo]
    ssis [Type]
    ts
                     Maybe [Name]
    Nothing       -> (SelStrictInfo -> Type -> Q Type)
    -> [SelStrictInfo] -> [Type] -> [Q Type]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith  (GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> Name
    -> TypeSubst
    -> Maybe Name
    -> SelStrictInfo
    -> Type
    -> Q Type
    repField GenericTvbs
    gt DatatypeVariant_
    dv Name
    dt Name
    n TypeSubst
    typeSubst Maybe Name
    forall a. Maybe a
    Nothing)
                                               [SelStrictInfo]
    ssis [Type]
    ts

        Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    c1TypeName
          Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` DatatypeVariant_
    -> Name -> Name -> KindSigOptions -> KindSigOptions -> Q Type
    mkMetaConsType DatatypeVariant_
    dv Name
    dt Name
    n KindSigOptions
    isRecord KindSigOptions
    isInfix
          Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` Q Type
    structureType

    prodT :: Q Type -> Q Type -> Q Type
    prodT :: Q Type -> Q Type -> Q Type
    prodT Q Type
    a Q Type
    b = Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    productTypeName Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` Q Type
    a Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` Q Type
    b

    repField :: GenericTvbs
             -> DatatypeVariant_
             -> Name
             -> Name
             -> TypeSubst
             -> Maybe Name
             -> SelStrictInfo
             -> Type
             -> Q Type
    repField :: GenericTvbs
    -> DatatypeVariant_
    -> Name
    -> Name
    -> TypeSubst
    -> Maybe Name
    -> SelStrictInfo
    -> Type
    -> Q Type
    repField GenericTvbs
    gt DatatypeVariant_
    dv Name
    dt Name
    ns TypeSubst
    typeSubst Maybe Name
    mbF SelStrictInfo
    ssi Type
    t =
               Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    s1TypeName
        Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` DatatypeVariant_
    -> Name -> Name -> Maybe Name -> SelStrictInfo -> Q Type
    mkMetaSelType DatatypeVariant_
    dv Name
    dt Name
    ns Maybe Name
    mbF SelStrictInfo
    ssi
        Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` (GenericTvbs -> Type -> Q Type
    repFieldArg GenericTvbs
    gt (Type -> Q Type) -> Q Type -> Q Type
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Type -> Q Type
    resolveTypeSynonyms Type
    t'')
      where
        -- See Note [Generic1 is polykinded in base-4.10]
        t', t'' :: Type
        t' :: Type
    t' = case GenericTvbs
    gt of
                  Gen1{gen1LastTvbKindVar :: GenericTvbs -> Maybe Name
    gen1LastTvbKindVar = Just Name
    _kvName} ->
    #if MIN_VERSION_base(4,10,0)
                    Type
    t
    #else
                    substNameWithKind _kvName starK t
    #endif
                  GenericTvbs
    _ -> Type
    t
        t'' :: Type
    t'' = TypeSubst -> Type -> Type
    forall a. TypeSubstitution a => TypeSubst -> a -> a
    applySubstitution TypeSubst
    typeSubst Type
    t'

    repFieldArg :: GenericTvbs -> Type -> Q Type
    repFieldArg :: GenericTvbs -> Type -> Q Type
    repFieldArg Gen0{} Type
    t = Type -> Q Type
    boxT Type
    t
    repFieldArg (Gen1{gen1LastTvbName :: GenericTvbs -> Name
    gen1LastTvbName = Name
    name}) (Type -> Type
    dustOff -> Type
    t0) =
        Type -> Q (ArgRes Type)
    go Type
    t0 Q (ArgRes Type) -> (ArgRes Type -> Q Type) -> Q Type
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ArgRes Type
    res -> case ArgRes Type
    res of
          ArgRes Type
    NoPar -> Type -> Q Type
    boxT Type
    t0
          ArgRes KindSigOptions
    _ Type
    r -> Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    r
      where
        -- | Returns NoPar if the parameter doesn't appear.
        -- Expects its argument to have been dusted.
        go :: Type -> Q (ArgRes Type)
        go :: Type -> Q (ArgRes Type)
    go ForallT{} = Q (ArgRes Type)
    forall a. Q a
    rankNError
    #if MIN_VERSION_template_haskell(2,16,0)
        go ForallVisT{} = Q (ArgRes Type)
    forall a. Q a
    rankNError
    #endif
        go (VarT Name
    t) | Name
    t Name -> Name -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name
    name = KindSigOptions -> Type -> ArgRes Type
    forall a. KindSigOptions -> a -> ArgRes a
    ArgRes KindSigOptions
    True (Type -> ArgRes Type) -> Q Type -> Q (ArgRes Type)
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    par1TypeName
        go (AppT Type
    f Type
    x) = do
          KindSigOptions -> Q () -> Q ()
    forall (f :: * -> *).
    Applicative f =>
    KindSigOptions -> f () -> f ()
    when (KindSigOptions -> KindSigOptions
    not (Type
    f Type -> Name -> KindSigOptions
    `ground` Name
    name)) Q ()
    forall a. Q a
    outOfPlaceTyVarError
          mxr <- Type -> Q (ArgRes Type)
    go (Type -> Type
    dustOff Type
    x)
          case mxr of
            ArgRes Type
    NoPar -> ArgRes Type -> Q (ArgRes Type)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArgRes Type
    forall a. ArgRes a
    NoPar
            ArgRes KindSigOptions
    arg_is_param Type
    xr -> do
              itf <- Type -> Q KindSigOptions
    isUnsaturatedType Type
    f
              when itf typeFamilyApplicationError
              ArgRes False `fmap`
                if arg_is_param
                  then
                    conT rec1TypeName `appT` return f
                  else
                    conT composeTypeName `appT` return f `appT` return xr
        go Type
    _ = ArgRes Type -> Q (ArgRes Type)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArgRes Type
    forall a. ArgRes a
    NoPar

    -- | The result of checking the argument. This NoPar
    -- means the parameter wasn't there. The Bool is True
    -- if the argument *is* the parameter, and False otherwise.
    data ArgRes a = NoPar | ArgRes !Bool a

    boxT :: Type -> Q Type
    boxT :: Type -> Q Type
    boxT Type
    ty = case Type -> Maybe (Name, Name, Name)
    unboxedRepNames Type
    ty of
        Just (Name
    boxTyName, Name
    _, Name
    _) -> Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    boxTyName
        Maybe (Name, Name, Name)
    Nothing                -> Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    rec0TypeName Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty

    mkCaseExp :: Q Match -> Q Exp
    mkCaseExp :: Q Match -> Q Exp
    mkCaseExp Q Match
    qMatch = do
      val <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "val"
      lam1E (varP val) $ caseE (varE val) [qMatch]

    mkFrom :: GenericTvbs -> EmptyCaseOptions -> Name
           -> [ConstructorInfo] -> Q Match
    mkFrom :: GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkFrom GenericTvbs
    gt KindSigOptions
    ecOptions Name
    dt [ConstructorInfo]
    cs = do
        y <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "y"
        match (varP y)
              (normalB $ conE m1DataName `appE` caseE (varE y) cases)
              []
      where
        cases :: [Q Match]
    cases = case [ConstructorInfo]
    cs of
                  [] -> KindSigOptions -> Name -> [Q Match]
    errorFrom KindSigOptions
    ecOptions Name
    dt
                  [ConstructorInfo]
    _  -> (Int -> ConstructorInfo -> Q Match)
    -> [Int] -> [ConstructorInfo] -> [Q Match]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (GenericTvbs
    -> (Q Exp -> Q Exp) -> Int -> Int -> ConstructorInfo -> Q Match
    fromCon GenericTvbs
    gt Q Exp -> Q Exp
    forall a. a -> a
    id ([ConstructorInfo] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ConstructorInfo]
    cs)) [Int
    1..] [ConstructorInfo]
    cs

    errorFrom :: EmptyCaseOptions -> Name -> [Q Match]
    errorFrom :: KindSigOptions -> Name -> [Q Match]
    errorFrom KindSigOptions
    useEmptyCase Name
    dt
      | KindSigOptions
    useEmptyCase
      = []
      | KindSigOptions
    otherwise
      = [do z <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "z"
            match
              (varP z)
              (normalB $
                appE (varE seqValName) (varE z) `appE`
                appE (varE errorValName)
                     (stringE $ "No generic representation for empty datatype "
                              ++ nameBase dt))
              []]

    mkTo :: GenericTvbs -> EmptyCaseOptions -> Name
         -> [ConstructorInfo] -> Q Match
    mkTo :: GenericTvbs
    -> KindSigOptions -> Name -> [ConstructorInfo] -> Q Match
    mkTo GenericTvbs
    gt KindSigOptions
    ecOptions Name
    dt [ConstructorInfo]
    cs = do
        y <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "y"
        match (conP m1DataName [varP y])
              (normalB $ caseE (varE y) cases)
              []
      where
        cases :: [Q Match]
    cases = case [ConstructorInfo]
    cs of
                  [] -> KindSigOptions -> Name -> [Q Match]
    errorTo KindSigOptions
    ecOptions Name
    dt
                  [ConstructorInfo]
    _  -> (Int -> ConstructorInfo -> Q Match)
    -> [Int] -> [ConstructorInfo] -> [Q Match]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (GenericTvbs
    -> (Q Pat -> Q Pat) -> Int -> Int -> ConstructorInfo -> Q Match
    toCon GenericTvbs
    gt Q Pat -> Q Pat
    forall a. a -> a
    id ([ConstructorInfo] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ConstructorInfo]
    cs)) [Int
    1..] [ConstructorInfo]
    cs

    errorTo :: EmptyCaseOptions -> Name -> [Q Match]
    errorTo :: KindSigOptions -> Name -> [Q Match]
    errorTo KindSigOptions
    useEmptyCase Name
    dt
      | KindSigOptions
    useEmptyCase
      = []
      | KindSigOptions
    otherwise
      = [do z <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "z"
            match
              (varP z)
              (normalB $
                appE (varE seqValName) (varE z) `appE`
                appE (varE errorValName)
                     (stringE $ "No values for empty datatype " ++ nameBase dt))
              []]

    fromCon :: GenericTvbs -> (Q Exp -> Q Exp) -> Int -> Int
            -> ConstructorInfo -> Q Match
    fromCon :: GenericTvbs
    -> (Q Exp -> Q Exp) -> Int -> Int -> ConstructorInfo -> Q Match
    fromCon GenericTvbs
    gt Q Exp -> Q Exp
    wrap Int
    m Int
    i
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    cn
                       , constructorVars :: ConstructorInfo -> [TyVarBndrUnit]
    constructorVars    = [TyVarBndrUnit]
    vars
                       , constructorContext :: ConstructorInfo -> [Type]
    constructorContext = [Type]
    ctxt
                       , constructorFields :: ConstructorInfo -> [Type]
    constructorFields  = [Type]
    ts
                       }) = do
      Name -> [TyVarBndrUnit] -> [Type] -> Q ()
    checkExistentialContext Name
    cn [TyVarBndrUnit]
    vars [Type]
    ctxt
      fNames <- String -> Int -> Q [Name]
    newNameList String
    "f" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    ts
      match (conP cn (map varP fNames))
            (normalB $ wrap $ lrE i m $ conE m1DataName `appE`
              foldBal prodE (conE u1DataName) (zipWith (fromField gt) fNames ts)) []

    prodE :: Q Exp -> Q Exp -> Q Exp
    prodE :: Q Exp -> Q Exp -> Q Exp
    prodE Q Exp
    x Q Exp
    y = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    productDataName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    x Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    y

    fromField :: GenericTvbs -> Name -> Type -> Q Exp
    fromField :: GenericTvbs -> Name -> Type -> Q Exp
    fromField GenericTvbs
    gt Name
    nr Type
    t = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    m1DataName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` (GenericTvbs -> Name -> Type -> Q Exp
    fromFieldWrap GenericTvbs
    gt Name
    nr (Type -> Q Exp) -> Q Type -> Q Exp
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Type -> Q Type
    resolveTypeSynonyms Type
    t)

    fromFieldWrap :: GenericTvbs -> Name -> Type -> Q Exp
    fromFieldWrap :: GenericTvbs -> Name -> Type -> Q Exp
    fromFieldWrap GenericTvbs
    _                              Name
    _  ForallT{}  = Q Exp
    forall a. Q a
    rankNError
    fromFieldWrap GenericTvbs
    gt                             Name
    nr (SigT Type
    t Type
    _) = GenericTvbs -> Name -> Type -> Q Exp
    fromFieldWrap GenericTvbs
    gt Name
    nr Type
    t
    fromFieldWrap Gen0{}                         Name
    nr Type
    t          = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE (Type -> Name
    boxRepName Type
    t) 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
    nr
    fromFieldWrap (Gen1{gen1LastTvbName :: GenericTvbs -> Name
    gen1LastTvbName = Name
    name}) Name
    nr Type
    t          = Type -> Name -> Q Exp
    wC Type
    t 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
    nr

    wC :: Type -> Name -> Q Exp
    wC :: Type -> Name -> Q Exp
    wC (Type -> Type
    dustOff -> Type
    t0) Name
    name =
        Type -> Q (ArgRes Exp)
    go Type
    t0 Q (ArgRes Exp) -> (ArgRes Exp -> Q Exp) -> Q Exp
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ArgRes Exp
    res -> case ArgRes Exp
    res of
          ArgRes Exp
    NoPar -> Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Type -> Name
    boxRepName Type
    t0
          ArgRes KindSigOptions
    _ Exp
    r -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    r
      where
        -- | Returns NoPar if the parameter doesn't appear.
        -- Expects its argument to have been dusted.
        go :: Type -> Q (ArgRes Exp)
        go :: Type -> Q (ArgRes Exp)
    go ForallT{} = Q (ArgRes Exp)
    forall a. Q a
    rankNError
    #if MIN_VERSION_template_haskell(2,16,0)
        go ForallVisT{} = Q (ArgRes Exp)
    forall a. Q a
    rankNError
    #endif
        go (VarT Name
    t) | Name
    t Name -> Name -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name
    name = KindSigOptions -> Exp -> ArgRes Exp
    forall a. KindSigOptions -> a -> ArgRes a
    ArgRes KindSigOptions
    True (Exp -> ArgRes Exp) -> Q Exp -> Q (ArgRes Exp)
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    par1DataName
        go (AppT Type
    f Type
    x) = do
          KindSigOptions -> Q () -> Q ()
    forall (f :: * -> *).
    Applicative f =>
    KindSigOptions -> f () -> f ()
    when (KindSigOptions -> KindSigOptions
    not (Type
    f Type -> Name -> KindSigOptions
    `ground` Name
    name)) Q ()
    forall a. Q a
    outOfPlaceTyVarError
          mxr <- Type -> Q (ArgRes Exp)
    go (Type -> Type
    dustOff Type
    x)
          case mxr of
            ArgRes Exp
    NoPar -> ArgRes Exp -> Q (ArgRes Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArgRes Exp
    forall a. ArgRes a
    NoPar
            ArgRes KindSigOptions
    arg_is_param Exp
    xr -> do
              itf <- Type -> Q KindSigOptions
    isUnsaturatedType Type
    f
              when itf typeFamilyApplicationError
              ArgRes False `fmap`
                if arg_is_param
                  then
                    conE rec1DataName
                  else
                    infixApp (conE comp1DataName) (varE composeValName) (varE fmapValName `appE` return xr)
        go Type
    _ = ArgRes Exp -> Q (ArgRes Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArgRes Exp
    forall a. ArgRes a
    NoPar

    boxRepName :: Type -> Name
    boxRepName :: Type -> Name
    boxRepName = Name
    -> ((Name, Name, Name) -> Name) -> Maybe (Name, Name, Name) -> Name
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Name
    k1DataName (Name, Name, Name) -> Name
    forall a b c. (a, b, c) -> b
    snd3 (Maybe (Name, Name, Name) -> Name)
    -> (Type -> Maybe (Name, Name, Name)) -> Type -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Maybe (Name, Name, Name)
    unboxedRepNames

    toCon :: GenericTvbs -> (Q Pat -> Q Pat) -> Int -> Int
          -> ConstructorInfo -> Q Match
    toCon :: GenericTvbs
    -> (Q Pat -> Q Pat) -> Int -> Int -> ConstructorInfo -> Q Match
    toCon GenericTvbs
    gt Q Pat -> Q Pat
    wrap Int
    m Int
    i
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    cn
                       , constructorVars :: ConstructorInfo -> [TyVarBndrUnit]
    constructorVars    = [TyVarBndrUnit]
    vars
                       , constructorContext :: ConstructorInfo -> [Type]
    constructorContext = [Type]
    ctxt
                       , constructorFields :: ConstructorInfo -> [Type]
    constructorFields  = [Type]
    ts
                       }) = do
      Name -> [TyVarBndrUnit] -> [Type] -> Q ()
    checkExistentialContext Name
    cn [TyVarBndrUnit]
    vars [Type]
    ctxt
      fNames <- String -> Int -> Q [Name]
    newNameList String
    "f" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    ts
      match (wrap $ lrP i m $ conP m1DataName
              [foldBal prod (conP u1DataName []) (zipWith (toField gt) fNames ts)])
            (normalB $ foldl appE (conE cn)
                             (zipWith (\Name
    nr -> Type -> Q Type
    resolveTypeSynonyms (Type -> Q Type) -> (Type -> Q Exp) -> Type -> Q Exp
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> GenericTvbs -> Name -> Type -> Q Exp
    toConUnwC GenericTvbs
    gt Name
    nr)
                             fNames ts)) []
      where prod :: m Pat -> m Pat -> m Pat
    prod m Pat
    x m Pat
    y = Name -> [m Pat] -> m Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    productDataName [m Pat
    x,m Pat
    y]

    toConUnwC :: GenericTvbs -> Name -> Type -> Q Exp
    toConUnwC :: GenericTvbs -> Name -> Type -> Q Exp
    toConUnwC Gen0{}                         Name
    nr Type
    _ = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    nr
    toConUnwC (Gen1{gen1LastTvbName :: GenericTvbs -> Name
    gen1LastTvbName = Name
    name}) Name
    nr Type
    t = Type -> Name -> Q Exp
    unwC Type
    t 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
    nr

    toField :: GenericTvbs -> Name -> Type -> Q Pat
    toField :: GenericTvbs -> Name -> Type -> Q Pat
    toField GenericTvbs
    gt Name
    nr Type
    t = Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    m1DataName [GenericTvbs -> Name -> Type -> Q Pat
    toFieldWrap GenericTvbs
    gt Name
    nr Type
    t]

    toFieldWrap :: GenericTvbs -> Name -> Type -> Q Pat
    toFieldWrap :: GenericTvbs -> Name -> Type -> Q Pat
    toFieldWrap Gen0{} Name
    nr Type
    t = Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP (Type -> Name
    boxRepName Type
    t) [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    nr]
    toFieldWrap Gen1{} Name
    nr Type
    _ = Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    nr

    unwC :: Type -> Name -> Q Exp
    unwC :: Type -> Name -> Q Exp
    unwC (Type -> Type
    dustOff -> Type
    t0) Name
    name =
      Type -> Q (ArgRes Exp)
    go Type
    t0 Q (ArgRes Exp) -> (ArgRes Exp -> Q Exp) -> Q Exp
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ArgRes Exp
    res -> case ArgRes Exp
    res of
        ArgRes Exp
    NoPar -> Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Type -> Name
    unboxRepName Type
    t0
        ArgRes KindSigOptions
    _ Exp
    r -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    r
      where
        -- | Returns NoPar if the parameter doesn't appear.
        -- Expects its argument to have been dusted.
        go :: Type -> Q (ArgRes Exp)
        go :: Type -> Q (ArgRes Exp)
    go ForallT{} = Q (ArgRes Exp)
    forall a. Q a
    rankNError
    #if MIN_VERSION_template_haskell(2,16,0)
        go ForallVisT{} = Q (ArgRes Exp)
    forall a. Q a
    rankNError
    #endif
        go (VarT Name
    t) | Name
    t Name -> Name -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name
    name = KindSigOptions -> Exp -> ArgRes Exp
    forall a. KindSigOptions -> a -> ArgRes a
    ArgRes KindSigOptions
    True (Exp -> ArgRes Exp) -> Q Exp -> Q (ArgRes Exp)
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    unPar1ValName
        go (AppT Type
    f Type
    x) = do
          KindSigOptions -> Q () -> Q ()
    forall (f :: * -> *).
    Applicative f =>
    KindSigOptions -> f () -> f ()
    when (KindSigOptions -> KindSigOptions
    not (Type
    f Type -> Name -> KindSigOptions
    `ground` Name
    name)) Q ()
    forall a. Q a
    outOfPlaceTyVarError
          mxr <- Type -> Q (ArgRes Exp)
    go (Type -> Type
    dustOff Type
    x)
          case mxr of
            ArgRes Exp
    NoPar -> ArgRes Exp -> Q (ArgRes Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArgRes Exp
    forall a. ArgRes a
    NoPar
            ArgRes KindSigOptions
    arg_is_param Exp
    xr -> do
              itf <- Type -> Q KindSigOptions
    isUnsaturatedType Type
    f
              when itf typeFamilyApplicationError
              ArgRes False `fmap`
                if arg_is_param
                  then
                    varE unRec1ValName
                  else
                    infixApp (varE fmapValName `appE` return xr)
                             (varE composeValName)
                             (varE unComp1ValName)
        go Type
    _ = ArgRes Exp -> Q (ArgRes Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArgRes Exp
    forall a. ArgRes a
    NoPar

    unboxRepName :: Type -> Name
    unboxRepName :: Type -> Name
    unboxRepName = Name
    -> ((Name, Name, Name) -> Name) -> Maybe (Name, Name, Name) -> Name
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Name
    unK1ValName (Name, Name, Name) -> Name
    forall a b c. (a, b, c) -> c
    trd3 (Maybe (Name, Name, Name) -> Name)
    -> (Type -> Maybe (Name, Name, Name)) -> Type -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Maybe (Name, Name, Name)
    unboxedRepNames

    lrP :: Int -> Int -> (Q Pat -> Q Pat)
    lrP :: Int -> Int -> Q Pat -> Q Pat
    lrP Int
    i Int
    n Q Pat
    p
      | Int
    n Int -> Int -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Int
    0       = String -> Q Pat
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "lrP: impossible"
      | Int
    n Int -> Int -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Int
    1       = Q Pat
    p
      | Int
    i Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    n Int
    2 = Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    l1DataName [Int -> Int -> Q Pat -> Q Pat
    lrP Int
    i     (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    n Int
    2) Q Pat
    p]
      | KindSigOptions
    otherwise    = Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    r1DataName [Int -> Int -> Q Pat -> Q Pat
    lrP (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    m) (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    m)     Q Pat
    p]
                         where m :: Int
    m = Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    n Int
    2

    lrE :: Int -> Int -> (Q Exp -> Q Exp)
    lrE :: Int -> Int -> Q Exp -> Q Exp
    lrE Int
    i Int
    n Q Exp
    e
      | Int
    n Int -> Int -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Int
    0       = String -> Q Exp
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "lrE: impossible"
      | Int
    n Int -> Int -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Int
    1       = Q Exp
    e
      | Int
    i Int -> Int -> KindSigOptions
    forall a. Ord a => a -> a -> KindSigOptions
    <= Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    n Int
    2 = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    l1DataName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Int -> Int -> Q Exp -> Q Exp
    lrE Int
    i     (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    n Int
    2) Q Exp
    e
      | KindSigOptions
    otherwise    = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    r1DataName Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Int -> Int -> Q Exp -> Q Exp
    lrE (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    m) (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    m)     Q Exp
    e
                         where m :: Int
    m = Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    div Int
    n Int
    2

    unboxedRepNames :: Type -> Maybe (Name, Name, Name)
    unboxedRepNames :: Type -> Maybe (Name, Name, Name)
    unboxedRepNames Type
    ty
      | Type
    ty Type -> Type -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name -> Type
    ConT Name
    addrHashTypeName   = (Name, Name, Name) -> Maybe (Name, Name, Name)
    forall a. a -> Maybe a
    Just (Name
    uAddrTypeName,   Name
    uAddrDataName,   Name
    uAddrHashValName)
      | Type
    ty Type -> Type -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name -> Type
    ConT Name
    charHashTypeName   = (Name, Name, Name) -> Maybe (Name, Name, Name)
    forall a. a -> Maybe a
    Just (Name
    uCharTypeName,   Name
    uCharDataName,   Name
    uCharHashValName)
      | Type
    ty Type -> Type -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name -> Type
    ConT Name
    doubleHashTypeName = (Name, Name, Name) -> Maybe (Name, Name, Name)
    forall a. a -> Maybe a
    Just (Name
    uDoubleTypeName, Name
    uDoubleDataName, Name
    uDoubleHashValName)
      | Type
    ty Type -> Type -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name -> Type
    ConT Name
    floatHashTypeName  = (Name, Name, Name) -> Maybe (Name, Name, Name)
    forall a. a -> Maybe a
    Just (Name
    uFloatTypeName,  Name
    uFloatDataName,  Name
    uFloatHashValName)
      | Type
    ty Type -> Type -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name -> Type
    ConT Name
    intHashTypeName    = (Name, Name, Name) -> Maybe (Name, Name, Name)
    forall a. a -> Maybe a
    Just (Name
    uIntTypeName,    Name
    uIntDataName,    Name
    uIntHashValName)
      | Type
    ty Type -> Type -> KindSigOptions
    forall a. Eq a => a -> a -> KindSigOptions
    == Name -> Type
    ConT Name
    wordHashTypeName   = (Name, Name, Name) -> Maybe (Name, Name, Name)
    forall a. a -> Maybe a
    Just (Name
    uWordTypeName,   Name
    uWordDataName,   Name
    uWordHashValName)
      | KindSigOptions
    otherwise                     = Maybe (Name, Name, Name)
    forall a. Maybe a
    Nothing

    -- For the given Types, deduces the instance type (and kind) to use for a
    -- Generic(1) instance. Coming up with the instance type isn't as simple as
    -- dropping the last types, as you need to be wary of kinds being instantiated
    -- with *.
    -- See Note [Type inference in derived instances]
    buildTypeInstance :: GenericClass
                      -- ^ Generic or Generic1
                      -> KindSigOptions
                      -- ^ Whether or not to use explicit kind signatures in the instance type
                      -> Name
                      -- ^ The type constructor or data family name
                      -> [Type]
                      -- ^ The types to instantiate the instance with
                      -> Q (Type, Kind)
    buildTypeInstance :: GenericClass -> KindSigOptions -> Name -> [Type] -> Q (Type, Type)
    buildTypeInstance GenericClass
    gClass KindSigOptions
    useKindSigs Name
    tyConName [Type]
    varTysOrig = do
        -- Make sure to expand through type/kind synonyms! Otherwise, the
        -- eta-reduction check might get tripped up over type variables in a
        -- synonym that are actually dropped.
        -- (See GHC Trac #11416 for a scenario where this actually happened.)
        varTysExp <- (Type -> Q Type) -> [Type] -> Q [Type]
    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 [Type]
    varTysOrig

        let remainingLength :: Int
            remainingLength = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    varTysOrig Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - GenericClass -> Int
    forall a. Enum a => a -> Int
    fromEnum GenericClass
    gClass

    #if !(MIN_VERSION_base(4,10,0))
            droppedTysExp :: [Type]
            droppedTysExp = drop remainingLength varTysExp

            droppedStarKindStati :: [StarKindStatus]
            droppedStarKindStati = map canRealizeKindStar droppedTysExp
    #endif

        -- Check that:
        --
        -- 1. There are enough types to drop
        --
        -- 2. If using GHC 8.0 or earlier, all types are either of kind * or kind k
        --    (for some kind variable k). See Note [Generic1 is polykinded in base-4.10].
        --
        -- If either of these checks fail, throw an error.
        when (remainingLength < 0
    #if !(MIN_VERSION_base(4,10,0))
               || any (== OtherKind) droppedStarKindStati
    #endif
             ) $
          derivingKindError tyConName

            -- Substitute kind * for any dropped kind variables
        let varTysExpSubst :: [Type]
    -- See Note [Generic1 is polykinded in base-4.10]
    #if MIN_VERSION_base(4,10,0)
            varTysExpSubst = [Type]
    varTysExp
    #else
            varTysExpSubst = map (substNamesWithKindStar droppedKindVarNames) varTysExp

            droppedKindVarNames :: [Name]
            droppedKindVarNames = catKindVarNames droppedStarKindStati
    #endif

        let remainingTysExpSubst, droppedTysExpSubst :: [Type]
            (remainingTysExpSubst, droppedTysExpSubst) =
              splitAt remainingLength varTysExpSubst

    -- See Note [Generic1 is polykinded in base-4.10]
    #if !(MIN_VERSION_base(4,10,0))
        -- If any of the dropped types were polykinded, ensure that there are of
        -- kind * after substituting * for the dropped kind variables. If not,
        -- throw an error.
        unless (all hasKindStar droppedTysExpSubst) $
          derivingKindError tyConName
    #endif

            -- We now substitute all of the specialized-to-* kind variable names
            -- with *, but in the original types, not the synonym-expanded types. The reason
            -- we do this is a superficial one: we want the derived instance to resemble
            -- the datatype written in source code as closely as possible. For example,
            -- for the following data family instance:
            --
            --   data family Fam a
            --   newtype instance Fam String = Fam String
            --
            -- We'd want to generate the instance:
            --
            --   instance C (Fam String)
            --
            -- Not:
            --
            --   instance C (Fam [Char])
        let varTysOrigSubst :: [Type]
            varTysOrigSubst =
    -- See Note [Generic1 is polykinded in base-4.10]
    #if MIN_VERSION_base(4,10,0)
              [Type] -> [Type]
    forall a. a -> a
    id
    #else
              map (substNamesWithKindStar droppedKindVarNames)
    #endif
                ([Type] -> [Type]) -> [Type] -> [Type]
    forall a b. (a -> b) -> a -> b
    $ [Type]
    varTysOrig

            remainingTysOrigSubst, droppedTysOrigSubst :: [Type]
            (remainingTysOrigSubst, droppedTysOrigSubst) =
                splitAt remainingLength varTysOrigSubst

            remainingTysOrigSubst' :: [Type]
            -- See Note [Kind signatures in derived instances] for an explanation
            -- of the useKindSigs check.
            remainingTysOrigSubst' =
              if KindSigOptions
    useKindSigs
                 then [Type]
    remainingTysOrigSubst
                 else (Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Type
    unSigT [Type]
    remainingTysOrigSubst

            instanceType :: Type
            instanceType = Type -> [Type] -> Type
    applyTyToTys (Name -> Type
    ConT Name
    tyConName) [Type]
    remainingTysOrigSubst'

            -- See Note [Kind signatures in derived instances]
            instanceKind :: Kind
            instanceKind = [Type] -> Type -> Type
    makeFunKind ((Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Type
    typeKind [Type]
    droppedTysOrigSubst) Type
    starK

        -- Ensure the dropped types can be safely eta-reduced. Otherwise,
        -- throw an error.
        unless (canEtaReduce remainingTysExpSubst droppedTysExpSubst) $
          etaReductionError instanceType
        return (instanceType, instanceKind)

    {-
    Note [Forcing buildTypeInstance]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Sometimes, we don't explicitly need to generate a Generic(1) type instance, but
    we force buildTypeInstance nevertheless. This is because it performs some checks
    for whether or not the provided datatype can actually have Generic(1) implemented for
    it, and produces errors if it can't. Otherwise, laziness would cause these checks
    to be skipped entirely, which could result in some indecipherable type errors
    down the road.

    Note [Kind signatures in derived instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    We generally include explicit type signatures in derived instances. One reason for
    doing so is that in the case of certain data family instances, not including kind
    signatures can result in ambiguity. For example, consider the following two data
    family instances that are distinguished by their kinds:

      data family Fam (a :: k)
      data instance Fam (a :: * -> *)
      data instance Fam (a :: *)

    If we dropped the kind signature for a in a derived instance for Fam a, then GHC
    would have no way of knowing which instance we are talking about.

    In addition to using explicit kind signatures in the instance head, we also put
    explicit kinds in the associated Rep(1) instance. For example, this data type:

      data S (a :: k) = S k

    Will have the following Generic1 instance generated for it:

      instance Generic1 (S :: k -> *) where
        type Rep1 (S :: k -> *) = ... (Rec0 k)

    Why do we do this? Imagine what the instance would be without the explicit kind
    annotation in the Rep1 instance:

      instance Generic1 S where
        type Rep1 S = ... (Rec0 k)

    This is an error, since the variable k is now out-of-scope!

    In the rare event that attaching explicit kind annotations does the wrong
    thing, there are variants of the TH functions that allow configuring the
    KindSigOptions. If KindSigOptions is set to False, then generated instances
    will not include explicit kind signatures, leaving it up to GHC's kind
    inference machinery to figure out the correct kinds.

    Note [Generic1 is polykinded in base-4.10]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Prior to base-4.10, Generic1 :: (* -> *) -> Constraint. This means that if a Generic1
    instance is defined for a polykinded data type like so:

      data Proxy k (a :: k) = Proxy

    Then k is unified with *, and this has an effect on the generated Generic1 instance:

      instance Generic1 (Proxy *) where ...

    We must take great care to ensure that all occurrences of k are substituted with *,
    or else the generated instance will be ill kinded.

    In base-4.10 and later, Generic1 :: (k -> *) -> Constraint. This means we don't have
    to do any of this kind unification trickery anymore! Hooray!
    -}