    {-# LANGUAGE BangPatterns       #-}
    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE MagicHash          #-}
    {-# LANGUAGE NamedFieldPuns     #-}
    {-# LANGUAGE TemplateHaskell    #-}
    {-|
    Module:      TextShow.TH.Internal
    Copyright:   (C) 2014-2017 Ryan Scott
    License:     BSD-style (see the file LICENSE)
    Maintainer:  Ryan Scott
    Stability:   Provisional
    Portability: GHC

    Functions to mechanically derive 'TextShow', 'TextShow1', or 'TextShow2' instances,
    or to splice their functions directly into Haskell source code. You need to enable
    the @TemplateHaskell@ language extension in order to use this module.

    This implementation is loosely based off of the @Data.Aeson.TH@ module from the
    @aeson@ library.
    -}
    module TextShow.TH.Internal (
          -- * 'deriveTextShow'
          -- $deriveTextShow
          deriveTextShow
          -- * 'deriveTextShow1'
          -- $deriveTextShow1
        , deriveTextShow1
          -- * 'deriveTextShow2'
          -- $deriveTextShow2
        , deriveTextShow2
          -- * @make-@ functions
          -- $make
        , makeShowt
        , makeShowtl
        , makeShowtPrec
        , makeShowtlPrec
        , makeShowtList
        , makeShowtlList
        , makeShowb
        , makeShowbPrec
        , makeShowbList
        , makePrintT
        , makePrintTL
        , makeHPrintT
        , makeHPrintTL
        , makeLiftShowbPrec
        , makeShowbPrec1
        , makeLiftShowbPrec2
        , makeShowbPrec2
        -- * 'Options'
        , Options(..)
        , defaultOptions
        , GenTextMethods(..)
        , deriveTextShowOptions
        , deriveTextShow1Options
        , deriveTextShow2Options
        ) where

    import           Control.Monad (unless, when)
    import           Data.Foldable.Compat
    import           Data.List.Compat
    import qualified Data.List.NonEmpty.Compat as NE (reverse)
    import           Data.List.NonEmpty.Compat (NonEmpty(..), (<|))
    import qualified Data.Map as Map (fromList, keys, lookup, singleton)
    import           Data.Map (Map)
    import           Data.Maybe
    import qualified Data.Set as Set
    import           Data.Set (Set)
    import qualified Data.Text    as TS
    import qualified Data.Text.IO as TS (putStrLn, hPutStrLn)
    import           Data.Text.Lazy (toStrict)
    import qualified Data.Text.Lazy.Builder as TB
    import           Data.Text.Lazy.Builder (Builder, toLazyText)
    import qualified Data.Text.Lazy    as TL
    import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn)

    import           GHC.Exts ( Char(..), Double(..), Float(..), Int(..), Word(..)
                              , Char#, Double#, Float#, Int#, Word#
    #if MIN_VERSION_base(4,13,0)
                              , Int8#, Int16#, Word8#, Word16#
                              , extendInt8#, extendInt16#, extendWord8#, extendWord16#
    #endif
                              )
    import           GHC.Show (appPrec, appPrec1)

    import           Language.Haskell.TH.Datatype
    import           Language.Haskell.TH.Lib
    import           Language.Haskell.TH.Ppr hiding (appPrec)
    import           Language.Haskell.TH.Syntax

    import           Prelude ()
    import           Prelude.Compat

    import           TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..),
                                       showbListWith,
                                       showbParen,  showbCommaSpace,  showbSpace,
                                       showtParen,  showtCommaSpace,  showtSpace,
                                       showtlParen, showtlCommaSpace, showtlSpace)
    import           TextShow.Options (Options(..), GenTextMethods(..), defaultOptions)
    import           TextShow.Utils (isInfixDataCon, isSymVar, isTupleString)

    -------------------------------------------------------------------------------
    -- User-facing API
    -------------------------------------------------------------------------------

    {- $deriveTextShow

    'deriveTextShow' automatically generates a 'TextShow' instance declaration for a data
    type, newtype, or data family instance. This emulates what would (hypothetically)
    happen if you could attach a @deriving 'TextShow'@ clause to the end of a data
    declaration.

    Here are some examples of how to derive 'TextShow' for simple data types:

    @
    &#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;
    import TextShow.TH

    data Letter = A | B | C
    $('deriveTextShow' ''Letter) -- instance TextShow Letter where ...

    newtype Box a = Box a
    $('deriveTextShow' ''Box) -- instance TextShow a => TextShow (Box a) where ...
    @

    'deriveTextShow' can also be used to derive 'TextShow' instances for data family
    instances (which requires the @-XTypeFamilies@ extension). To do so, pass the name of
    a data or newtype instance constructor (NOT a data family name!) to 'deriveTextShow'.
    Note that the generated code may require the @-XFlexibleInstances@ extension.
    Some examples:

    @
    &#123;-&#35; LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies &#35;-&#125;
    import TextShow.TH (deriveTextShow)

    class AssocClass a where
        data AssocData a
    instance AssocClass Int where
        data AssocData Int = AssocDataInt1 Int | AssocDataInt2 Int Int
    $('deriveTextShow' 'AssocDataInt1) -- instance TextShow (AssocData Int) where ...
    -- Alternatively, one could use $(deriveTextShow 'AssocDataInt2)

    data family DataFam a b
    newtype instance DataFam () b = DataFamB b
    $('deriveTextShow' 'DataFamB) -- instance TextShow b => TextShow (DataFam () b)
    @

    Note that at the moment, there are some limitations:

    * The 'Name' argument to 'deriveTextShow' must not be a type synonym.

    * 'deriveTextShow' makes the assumption that all type variables of kind @*@ require a
      'TextShow' constraint when creating the type context. For example, if you have @data
      Phantom a = Phantom@, then @('deriveTextShow' ''Phantom)@ will generate @instance
      'TextShow' a => 'TextShow' (Phantom a) where ...@, even though @'TextShow' a@ is
      not required. If you want a proper 'TextShow' instance for @Phantom@, you will need
      to use 'makeShowbPrec' (see the documentation of the @make@ functions for more
      information).

    * 'deriveTextShow' lacks the ability to properly detect data types with higher-kinded
       type parameters (e.g., @data HK f a = HK (f a)@) or with kinds other than @*@
       (e.g., @data List a (empty :: Bool)@). If you wish to derive 'TextShow'
       instances for these data types, you will need to use 'makeShowbPrec'.

    * Some data constructors have arguments whose 'TextShow' instance depends on a
      typeclass besides 'TextShow'. For example, consider @newtype MyFixed a = MyFixed
      (Fixed a)@. @'Fixed' a@ is a 'TextShow' instance only if @a@ is an instance of both
      @HasResolution@ and 'TextShow'. Unfortunately, 'deriveTextShow' cannot infer that
      'a' must be an instance of 'HasResolution', so it cannot create a 'TextShow'
      instance for @MyFixed@. However, you can use 'makeShowbPrec' to get around this.

    -}

    -- | Generates a 'TextShow' instance declaration for the given data type or data
    -- family instance.
    --
    -- /Since: 2/
    deriveTextShow :: Name -> Q [Dec]
    deriveTextShow :: Name -> Q [Dec]
    deriveTextShow = Options -> Name -> Q [Dec]
    deriveTextShowOptions Options
    defaultOptions

    -- | Like 'deriveTextShow', but takes an 'Options' argument.
    --
    -- /Since: 3.4/
    deriveTextShowOptions :: Options -> Name -> Q [Dec]
    deriveTextShowOptions :: Options -> Name -> Q [Dec]
    deriveTextShowOptions = TextShowClass -> Options -> Name -> Q [Dec]
    deriveTextShowClass TextShowClass
    TextShow

    {- $deriveTextShow1

    'deriveTextShow1' automatically generates a 'Show1' instance declaration for a data
    type, newtype, or data family instance that has at least one type variable.
    This emulates what would (hypothetically) happen if you could attach a @deriving
    'TextShow1'@ clause to the end of a data declaration. Examples:

    @
    &#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;
    import TextShow.TH

    data Stream a = Stream a (Stream a)
    $('deriveTextShow1' ''Stream) -- instance TextShow1 TextStream where ...

    newtype WrappedFunctor f a = WrapFunctor (f a)
    $('deriveTextShow1' ''WrappedFunctor) -- instance TextShow1 f => TextShow1 (WrappedFunctor f) where ...
    @

    The same restrictions that apply to 'deriveTextShow' also apply to 'deriveTextShow1',
    with some caveats:

    * With 'deriveTextShow1', the last type variable must be of kind @*@. For other ones,
      type variables of kind @*@ are assumed to require a 'TextShow' context, and type
      variables of kind @* -> *@ are assumed to require a 'TextShow1' context. For more
      complicated scenarios, use 'makeLiftShowbPrec'.

    * If using @-XDatatypeContexts@, a datatype constraint cannot mention the last type
      variable. For example, @data Ord a => Illegal a = Illegal a@ cannot have a derived
      'TextShow1' instance.

    * If the last type variable is used within a data field of a constructor, it must only
      be used in the last argument of the data type constructor. For example, @data Legal a
      = Legal (Either Int a)@ can have a derived 'TextShow1' instance, but @data Illegal a
      = Illegal (Either a a)@ cannot.

    * Data family instances must be able to eta-reduce the last type variable. In other
      words, if you have a instance of the form:

      @
      data family Family a1 ... an t
      data instance Family e1 ... e2 v = ...
      @

      Then the following conditions must hold:

      1. @v@ must be a type variable.
      2. @v@ must not be mentioned in any of @e1@, ..., @e2@.

    -}

    -- | Generates a 'TextShow1' instance declaration for the given data type or data
    -- family instance.
    --
    -- /Since: 2/
    deriveTextShow1 :: Name -> Q [Dec]
    deriveTextShow1 :: Name -> Q [Dec]
    deriveTextShow1 = Options -> Name -> Q [Dec]
    deriveTextShow1Options Options
    defaultOptions

    -- | Like 'deriveTextShow1', but takes an 'Options' argument.
    --
    -- /Since: 3.4/
    deriveTextShow1Options :: Options -> Name -> Q [Dec]
    deriveTextShow1Options :: Options -> Name -> Q [Dec]
    deriveTextShow1Options = TextShowClass -> Options -> Name -> Q [Dec]
    deriveTextShowClass TextShowClass
    TextShow1

    {- $deriveTextShow2

    'deriveTextShow2' automatically generates a 'TextShow2' instance declaration for a data
    type, newtype, or data family instance that has at least two type variables.
    This emulates what would (hypothetically) happen if you could attach a @deriving
    'TextShow2'@ clause to the end of a data declaration. Examples:

    @
    &#123;-&#35; LANGUAGE TemplateHaskell &#35;-&#125;
    import TextShow.TH

    data OneOrNone a b = OneL a | OneR b | None
    $('deriveTextShow2' ''OneOrNone) -- instance TextShow2 OneOrNone where ...

    newtype WrappedBifunctor f a b = WrapBifunctor (f a b)
    $('deriveTextShow2' ''WrappedBifunctor) -- instance TextShow2 f => TextShow2 (WrappedBifunctor f) where ...
    @

    The same restrictions that apply to 'deriveTextShow' and 'deriveTextShow1' also apply
    to 'deriveTextShow2', with some caveats:

    * With 'deriveTextShow2', the last type variables must both be of kind @*@. For other
      ones, type variables of kind @*@ are assumed to require a 'TextShow' constraint, type
      variables of kind @* -> *@ are assumed to require a 'TextShow1' constraint, and type
      variables of kind @* -> * -> *@ are assumed to require a 'TextShow2' constraint. For
      more complicated scenarios, use 'makeLiftShowbPrec2'.

    * If using @-XDatatypeContexts@, a datatype constraint cannot mention either of the last
      two type variables. For example, @data Ord a => Illegal a b = Illegal a b@ cannot
      have a derived 'TextShow2' instance.

    * If either of the last two type variables is used within a data field of a constructor,
      it must only be used in the last two arguments of the data type constructor. For
      example, @data Legal a b = Legal (Int, Int, a, b)@ can have a derived 'TextShow2'
      instance, but @data Illegal a b = Illegal (a, b, a, b)@ cannot.

    * Data family instances must be able to eta-reduce the last two type variables. In other
      words, if you have a instance of the form:

      @
      data family Family a1 ... an t1 t2
      data instance Family e1 ... e2 v1 v2 = ...
      @

      Then the following conditions must hold:

      1. @v1@ and @v2@ must be distinct type variables.
      2. Neither @v1@ not @v2@ must be mentioned in any of @e1@, ..., @e2@.

    -}

    -- | Generates a 'TextShow2' instance declaration for the given data type or data
    -- family instance.
    --
    -- /Since: 2/
    deriveTextShow2 :: Name -> Q [Dec]
    deriveTextShow2 :: Name -> Q [Dec]
    deriveTextShow2 = Options -> Name -> Q [Dec]
    deriveTextShow2Options Options
    defaultOptions

    -- | Like 'deriveTextShow2', but takes an 'Options' argument.
    --
    -- /Since: 3.4/
    deriveTextShow2Options :: Options -> Name -> Q [Dec]
    deriveTextShow2Options :: Options -> Name -> Q [Dec]
    deriveTextShow2Options = TextShowClass -> Options -> Name -> Q [Dec]
    deriveTextShowClass TextShowClass
    TextShow2

    {- $make

    There may be scenarios in which you want to show an arbitrary data type or data
    family instance without having to make the type an instance of 'TextShow'. For these
    cases, this modules provides several functions (all prefixed with @make@-) that
    splice the appropriate lambda expression into your source code. Example:

    This is particularly useful for creating instances for sophisticated data types. For
    example, 'deriveTextShow' cannot infer the correct type context for
    @newtype HigherKinded f a = HigherKinded (f a)@, since @f@ is of kind @* -> *@.
    However, it is still possible to derive a 'TextShow' instance for @HigherKinded@
    without too much trouble using 'makeShowbPrec':

    @
    &#123;-&#35; LANGUAGE FlexibleContexts, TemplateHaskell &#35;-&#125;
    import TextShow
    import TextShow.TH

    instance TextShow (f a) => TextShow (HigherKinded f a) where
        showbPrec = $(makeShowbPrec ''HigherKinded)
    @

    -}

    -- | Generates a lambda expression which behaves like 'showt' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowt :: Name -> Q Exp
    makeShowt :: Name -> Q Exp
    makeShowt name :: Name
    name = Name -> Q Exp
    makeShowtPrec Name
    name Q Exp -> Q Exp -> Q Exp
    `appE` Int -> Q Exp
    integerE 0

    -- | Generates a lambda expression which behaves like 'showtl' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowtl :: Name -> Q Exp
    makeShowtl :: Name -> Q Exp
    makeShowtl name :: Name
    name = Name -> Q Exp
    makeShowtlPrec Name
    name Q Exp -> Q Exp -> Q Exp
    `appE` Int -> Q Exp
    integerE 0

    -- | Generates a lambda expression which behaves like 'showtPrec' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowtPrec :: Name -> Q Exp
    makeShowtPrec :: Name -> Q Exp
    makeShowtPrec = TextShowClass -> TextShowFun -> Options -> Name -> Q Exp
    makeShowbPrecClass TextShowClass
    TextShow TextShowFun
    ShowtPrec Options
    defaultOptions

    -- | Generates a lambda expression which behaves like 'showtlPrec' (without
    -- requiring a 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowtlPrec :: Name -> Q Exp
    makeShowtlPrec :: Name -> Q Exp
    makeShowtlPrec = TextShowClass -> TextShowFun -> Options -> Name -> Q Exp
    makeShowbPrecClass TextShowClass
    TextShow TextShowFun
    ShowtlPrec Options
    defaultOptions

    -- | Generates a lambda expression which behaves like 'showtList' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowtList :: Name -> Q Exp
    makeShowtList :: Name -> Q Exp
    makeShowtList name :: Name
    name = [| toStrict . $(makeShowtlList name) |]

    -- | Generates a lambda expression which behaves like 'showtlList' (without
    -- requiring a 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowtlList :: Name -> Q Exp
    makeShowtlList :: Name -> Q Exp
    makeShowtlList name :: Name
    name = [| toLazyText . $(makeShowbList name) |]

    -- | Generates a lambda expression which behaves like 'showb' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowb :: Name -> Q Exp
    makeShowb :: Name -> Q Exp
    makeShowb name :: Name
    name = Name -> Q Exp
    makeShowbPrec Name
    name Q Exp -> Q Exp -> Q Exp
    `appE` Int -> Q Exp
    integerE 0

    -- | Generates a lambda expression which behaves like 'showbPrec' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowbPrec :: Name -> Q Exp
    makeShowbPrec :: Name -> Q Exp
    makeShowbPrec = TextShowClass -> TextShowFun -> Options -> Name -> Q Exp
    makeShowbPrecClass TextShowClass
    TextShow TextShowFun
    ShowbPrec Options
    defaultOptions

    -- | Generates a lambda expression which behaves like 'liftShowbPrec' (without
    -- requiring a 'TextShow1' instance).
    --
    -- /Since: 3/
    makeLiftShowbPrec :: Name -> Q Exp
    makeLiftShowbPrec :: Name -> Q Exp
    makeLiftShowbPrec = TextShowClass -> TextShowFun -> Options -> Name -> Q Exp
    makeShowbPrecClass TextShowClass
    TextShow1 TextShowFun
    ShowbPrec Options
    defaultOptions

    -- | Generates a lambda expression which behaves like 'showbPrec1' (without
    -- requiring a 'TextShow1' instance).
    --
    -- /Since: 2/
    makeShowbPrec1 :: Name -> Q Exp
    makeShowbPrec1 :: Name -> Q Exp
    makeShowbPrec1 name :: Name
    name = [| $(makeLiftShowbPrec name) showbPrec showbList |]

    -- | Generates a lambda expression which behaves like 'liftShowbPrec2' (without
    -- requiring a 'TextShow2' instance).
    --
    -- /Since: 3/
    makeLiftShowbPrec2 :: Name -> Q Exp
    makeLiftShowbPrec2 :: Name -> Q Exp
    makeLiftShowbPrec2 = TextShowClass -> TextShowFun -> Options -> Name -> Q Exp
    makeShowbPrecClass TextShowClass
    TextShow2 TextShowFun
    ShowbPrec Options
    defaultOptions

    -- | Generates a lambda expression which behaves like 'showbPrec2' (without
    -- requiring a 'TextShow2' instance).
    --
    -- /Since: 2/
    makeShowbPrec2 :: Name -> Q Exp
    makeShowbPrec2 :: Name -> Q Exp
    makeShowbPrec2 name :: Name
    name = [| $(makeLiftShowbPrec2 name) showbPrec showbList showbPrec showbList |]

    -- | Generates a lambda expression which behaves like 'showbList' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeShowbList :: Name -> Q Exp
    makeShowbList :: Name -> Q Exp
    makeShowbList name :: Name
    name = [| showbListWith $(makeShowb name) |]

    -- | Generates a lambda expression which behaves like 'printT' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makePrintT :: Name -> Q Exp
    makePrintT :: Name -> Q Exp
    makePrintT name :: Name
    name = [| TS.putStrLn . $(makeShowt name) |]

    -- | Generates a lambda expression which behaves like 'printTL' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makePrintTL :: Name -> Q Exp
    makePrintTL :: Name -> Q Exp
    makePrintTL name :: Name
    name = [| TL.putStrLn . $(makeShowtl name) |]

    -- | Generates a lambda expression which behaves like 'hPrintT' (without requiring a
    -- 'TextShow' instance).
    --
    -- /Since: 2/
    makeHPrintT :: Name -> Q Exp
    makeHPrintT :: Name -> Q Exp
    makeHPrintT name :: Name
    name = [| \h -> TS.hPutStrLn h . $(makeShowt name) |]

    -- | Generates a lambda expression which behaves like 'hPrintTL' (without
    -- requiring a 'TextShow' instance).
    --
    -- /Since: 2/
    makeHPrintTL :: Name -> Q Exp
    makeHPrintTL :: Name -> Q Exp
    makeHPrintTL name :: Name
    name = [| \h -> TL.hPutStrLn h . $(makeShowtl name) |]

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

    -- | Derive a TextShow(1)(2) instance declaration (depending on the TextShowClass
    -- argument's value).
    deriveTextShowClass :: TextShowClass -> Options -> Name -> Q [Dec]
    deriveTextShowClass :: TextShowClass -> Options -> Name -> Q [Dec]
    deriveTextShowClass tsClass :: TextShowClass
    tsClass opts :: Options
    opts name :: Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTys
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } -> do
          (instanceCxt :: Cxt
    instanceCxt, instanceType :: Type
    instanceType)
            <- TextShowClass
    -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance TextShowClass
    tsClass Name
    parentName Cxt
    ctxt Cxt
    instTys DatatypeVariant
    variant
          (Dec -> [Dec] -> [Dec]
    forall a. a -> [a] -> [a]
    :[]) (Dec -> [Dec]) -> Q Dec -> Q [Dec]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CxtQ -> TypeQ -> [Q Dec] -> Q Dec
    instanceD (Cxt -> CxtQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Cxt
    instanceCxt)
                              (Type -> TypeQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    instanceType)
                              (TextShowClass -> Options -> Cxt -> [ConstructorInfo] -> [Q Dec]
    showbPrecDecs TextShowClass
    tsClass Options
    opts Cxt
    instTys [ConstructorInfo]
    cons)

    -- | Generates a declaration defining the primary function corresponding to a
    -- particular class (showbPrec for TextShow, liftShowbPrec for TextShow1, and
    -- liftShowbPrec2 for TextShow2).
    showbPrecDecs :: TextShowClass -> Options -> [Type] -> [ConstructorInfo] -> [Q Dec]
    showbPrecDecs :: TextShowClass -> Options -> Cxt -> [ConstructorInfo] -> [Q Dec]
    showbPrecDecs tsClass :: TextShowClass
    tsClass opts :: Options
    opts instTys :: Cxt
    instTys cons :: [ConstructorInfo]
    cons =
        [TextShowFun -> Name -> Q Dec
    genMethod TextShowFun
    ShowbPrec (TextShowClass -> Name
    showbPrecName TextShowClass
    tsClass)]
        [Q Dec] -> [Q Dec] -> [Q Dec]
    forall a. [a] -> [a] -> [a]
    ++ if TextShowClass
    tsClass TextShowClass -> TextShowClass -> Bool
    forall a. Eq a => a -> a -> Bool
    == TextShowClass
    TextShow Bool -> Bool -> Bool
    && Bool
    shouldGenTextMethods
              then [TextShowFun -> Name -> Q Dec
    genMethod TextShowFun
    ShowtPrec 'showtPrec, TextShowFun -> Name -> Q Dec
    genMethod TextShowFun
    ShowtlPrec 'showtlPrec]
              else []
      where
        shouldGenTextMethods :: Bool
        shouldGenTextMethods :: Bool
    shouldGenTextMethods = case Options -> GenTextMethods
    genTextMethods Options
    opts of
          AlwaysTextMethods    -> Bool
    True
          SometimesTextMethods -> (ConstructorInfo -> Bool) -> [ConstructorInfo] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ConstructorInfo -> Bool
    isNullaryCon [ConstructorInfo]
    cons
          NeverTextMethods     -> Bool
    False

        genMethod :: TextShowFun -> Name -> Q Dec
        genMethod :: TextShowFun -> Name -> Q Dec
    genMethod method :: TextShowFun
    method methodName :: Name
    methodName
          = Name -> [ClauseQ] -> Q Dec
    funD Name
    methodName
                 [ [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause []
                          (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ TextShowClass
    -> TextShowFun -> Options -> Cxt -> [ConstructorInfo] -> Q Exp
    makeTextShowForCons TextShowClass
    tsClass TextShowFun
    method Options
    opts Cxt
    instTys [ConstructorInfo]
    cons)
                          []
                 ]

    -- | Generates a lambda expression which behaves like showbPrec (for TextShow),
    -- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2).
    makeShowbPrecClass :: TextShowClass -> TextShowFun -> Options -> Name -> Q Exp
    makeShowbPrecClass :: TextShowClass -> TextShowFun -> Options -> Name -> Q Exp
    makeShowbPrecClass tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun opts :: Options
    opts name :: Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTys
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } ->
          -- We force buildTypeInstance here since it performs some checks for whether
          -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc.
          -- implemented for it, and produces errors if it can't.
          TextShowClass
    -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance TextShowClass
    tsClass Name
    parentName Cxt
    ctxt Cxt
    instTys DatatypeVariant
    variant
            Q (Cxt, Type) -> Q Exp -> Q Exp
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TextShowClass
    -> TextShowFun -> Options -> Cxt -> [ConstructorInfo] -> Q Exp
    makeTextShowForCons TextShowClass
    tsClass TextShowFun
    tsFun Options
    opts Cxt
    instTys [ConstructorInfo]
    cons

    -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the
    -- given constructors. All constructors must be from the same type.
    makeTextShowForCons :: TextShowClass -> TextShowFun -> Options -> [Type] -> [ConstructorInfo]
                        -> Q Exp
    makeTextShowForCons :: TextShowClass
    -> TextShowFun -> Options -> Cxt -> [ConstructorInfo] -> Q Exp
    makeTextShowForCons tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun opts :: Options
    opts instTys :: Cxt
    instTys cons :: [ConstructorInfo]
    cons = do
        Name
    p       <- String -> Q Name
    newName "p"
        Name
    value   <- String -> Q Name
    newName "value"
        [Name]
    sps     <- String -> Int -> Q [Name]
    newNameList "sp" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ TextShowClass -> Int
    forall a. Enum a => a -> Int
    fromEnum TextShowClass
    tsClass
        [Name]
    sls     <- String -> Int -> Q [Name]
    newNameList "sl" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ TextShowClass -> Int
    forall a. Enum a => a -> Int
    fromEnum TextShowClass
    tsClass
        let spls :: [(Name, Name)]
    spls       = [Name] -> [Name] -> [(Name, Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    sps [Name]
    sls
            spsAndSls :: [Name]
    spsAndSls  = [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    interleave [Name]
    sps [Name]
    sls
            lastTyVars :: [Name]
    lastTyVars = (Type -> Name) -> Cxt -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Name
    varTToName (Cxt -> [Name]) -> Cxt -> [Name]
    forall a b. (a -> b) -> a -> b
    $ Int -> Cxt -> Cxt
    forall a. Int -> [a] -> [a]
    drop (Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    instTys Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - TextShowClass -> Int
    forall a. Enum a => a -> Int
    fromEnum TextShowClass
    tsClass) Cxt
    instTys
            splMap :: Map Name (Name, Name)
    splMap     = [(Name, (Name, Name))] -> Map Name (Name, Name)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, (Name, Name))] -> Map Name (Name, Name))
    -> [(Name, (Name, Name))] -> Map Name (Name, Name)
    forall a b. (a -> b) -> a -> b
    $ [Name] -> [(Name, Name)] -> [(Name, (Name, Name))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    lastTyVars [(Name, Name)]
    spls

            makeFun :: Q Exp
    makeFun
              | [ConstructorInfo] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConstructorInfo]
    cons Bool -> Bool -> Bool
    && Options -> Bool
    emptyCaseBehavior Options
    opts Bool -> Bool -> Bool
    && Bool
    ghc7'8OrLater
              = Q Exp -> [MatchQ] -> Q Exp
    caseE (Name -> Q Exp
    varE Name
    value) []

              | [ConstructorInfo] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConstructorInfo]
    cons
              = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE 'seq) (Name -> Q Exp
    varE Name
    value) Q Exp -> Q Exp -> Q Exp
    `appE`
                Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE 'error)
                     (String -> Q Exp
    stringE (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ "Void " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase (TextShowClass -> TextShowFun -> Name
    showPrecName TextShowClass
    tsClass TextShowFun
    tsFun))

              | Bool
    otherwise
              = Q Exp -> [MatchQ] -> Q Exp
    caseE (Name -> Q Exp
    varE Name
    value)
                      ((ConstructorInfo -> MatchQ) -> [ConstructorInfo] -> [MatchQ]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name
    -> TextShowClass
    -> TextShowFun
    -> Map Name (Name, Name)
    -> ConstructorInfo
    -> MatchQ
    makeTextShowForCon Name
    p TextShowClass
    tsClass TextShowFun
    tsFun Map Name (Name, Name)
    splMap) [ConstructorInfo]
    cons)

        [PatQ] -> Q Exp -> Q Exp
    lamE ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP ([Name] -> [PatQ]) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> a -> b
    $ [Name]
    spsAndSls [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [Name
    p, Name
    value])
            (Q Exp -> Q Exp) -> ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Q Exp] -> Q Exp
    appsE
            ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [ Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ TextShowClass -> TextShowFun -> Name
    showPrecConstName TextShowClass
    tsClass TextShowFun
    tsFun
              , Q Exp
    makeFun
              ] [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Q Exp) -> [Name] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Exp
    varE [Name]
    spsAndSls
                [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ [Name -> Q Exp
    varE Name
    p, Name -> Q Exp
    varE Name
    value]
      where
        ghc7'8OrLater :: Bool
    #if __GLASGOW_HASKELL__ >= 708
        ghc7'8OrLater :: Bool
    ghc7'8OrLater = Bool
    True
    #else
        ghc7'8OrLater = False
    #endif

    -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a
    -- single constructor.
    makeTextShowForCon :: Name
                       -> TextShowClass
                       -> TextShowFun
                       -> TyVarMap
                       -> ConstructorInfo
                       -> Q Match
    makeTextShowForCon :: Name
    -> TextShowClass
    -> TextShowFun
    -> Map Name (Name, Name)
    -> ConstructorInfo
    -> MatchQ
    makeTextShowForCon _ _ tsFun :: TextShowFun
    tsFun _
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName, constructorFields :: ConstructorInfo -> Cxt
    constructorFields = [] }) =
        PatQ -> BodyQ -> [Q Dec] -> MatchQ
    match
          (Name -> [PatQ] -> PatQ
    conP Name
    conName [])
          (Q Exp -> BodyQ
    normalB  (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE (TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` String -> Q Exp
    stringE (Name -> String -> String
    parenInfixConName Name
    conName ""))
          []
    makeTextShowForCon p :: Name
    p tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun tvMap :: Map Name (Name, Name)
    tvMap
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    conName
                       , constructorVariant :: ConstructorInfo -> ConstructorVariant
    constructorVariant = ConstructorVariant
    NormalConstructor
                       , constructorFields :: ConstructorInfo -> Cxt
    constructorFields  = [argTy :: Type
    argTy] }) = do
        Type
    argTy' <- Type -> TypeQ
    resolveTypeSynonyms Type
    argTy
        Name
    arg <- String -> Q Name
    newName "arg"

        let showArg :: Q Exp
    showArg  = Int
    -> TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Type
    -> Name
    -> Q Exp
    makeTextShowForArg Int
    appPrec1 TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap Type
    argTy' Name
    arg
            namedArg :: Q Exp
    namedArg = Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE (TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` String -> Q Exp
    stringE (Name -> String -> String
    parenInfixConName Name
    conName " "))
                                [| (<>) |]
                                Q Exp
    showArg

        PatQ -> BodyQ -> [Q Dec] -> MatchQ
    match
          (Name -> [PatQ] -> PatQ
    conP Name
    conName [Name -> PatQ
    varP Name
    arg])
          (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE (TextShowFun -> Name
    showParenName TextShowFun
    tsFun)
                      Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE Name
    p) [| (>) |] (Int -> Q Exp
    integerE Int
    appPrec)
                      Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp
    namedArg)
          []
    makeTextShowForCon p :: Name
    p tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun tvMap :: Map Name (Name, Name)
    tvMap
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    conName
                       , constructorVariant :: ConstructorInfo -> ConstructorVariant
    constructorVariant = ConstructorVariant
    NormalConstructor
                       , constructorFields :: ConstructorInfo -> Cxt
    constructorFields  = Cxt
    argTys }) = do
        Cxt
    argTys' <- (Type -> TypeQ) -> Cxt -> CxtQ
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> TypeQ
    resolveTypeSynonyms Cxt
    argTys
        [Name]
    args <- String -> Int -> Q [Name]
    newNameList "arg" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    argTys'

        if Name -> Bool
    isNonUnitTuple Name
    conName
           then do
             let showArgs :: [Q Exp]
    showArgs       = (Type -> Name -> Q Exp) -> Cxt -> [Name] -> [Q Exp]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Int
    -> TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Type
    -> Name
    -> Q Exp
    makeTextShowForArg 0 TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap) Cxt
    argTys' [Name]
    args
                 parenCommaArgs :: [Q Exp]
    parenCommaArgs = (Name -> Q Exp
    varE (TextShowFun -> Name
    singletonName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` Char -> Q Exp
    charE '(')
                                  Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    : Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    intersperse (Name -> Q Exp
    varE (TextShowFun -> Name
    singletonName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` Char -> Q Exp
    charE ',') [Q Exp]
    showArgs
                 mappendArgs :: Q Exp
    mappendArgs    = (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr' (Q Exp -> Q Exp -> Q Exp -> Q Exp
    `infixApp` [| (<>) |])
                                         (Name -> Q Exp
    varE (TextShowFun -> Name
    singletonName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` Char -> Q Exp
    charE ')')
                                         [Q Exp]
    parenCommaArgs

             PatQ -> BodyQ -> [Q Dec] -> MatchQ
    match (Name -> [PatQ] -> PatQ
    conP Name
    conName ([PatQ] -> PatQ) -> [PatQ] -> PatQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    args)
                   (Q Exp -> BodyQ
    normalB Q Exp
    mappendArgs)
                   []
           else do
             let showArgs :: [Q Exp]
    showArgs    = (Type -> Name -> Q Exp) -> Cxt -> [Name] -> [Q Exp]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Int
    -> TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Type
    -> Name
    -> Q Exp
    makeTextShowForArg Int
    appPrec1 TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap) Cxt
    argTys' [Name]
    args
                 mappendArgs :: Q Exp
    mappendArgs = (Q Exp -> Q Exp -> Q Exp) -> [Q Exp] -> Q Exp
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\v :: Q Exp
    v q :: Q Exp
    q -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp Q Exp
    v
                                                        [| (<>) |]
                                                        (Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ TextShowFun -> Name
    showSpaceName TextShowFun
    tsFun)
                                                                  [| (<>) |]
                                                                  Q Exp
    q)) [Q Exp]
    showArgs
                 namedArgs :: Q Exp
    namedArgs   = Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE (TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` String -> Q Exp
    stringE (Name -> String -> String
    parenInfixConName Name
    conName " "))
                                        [| (<>) |]
                                        Q Exp
    mappendArgs

             PatQ -> BodyQ -> [Q Dec] -> MatchQ
    match (Name -> [PatQ] -> PatQ
    conP Name
    conName ([PatQ] -> PatQ) -> [PatQ] -> PatQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    args)
                   (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE (TextShowFun -> Name
    showParenName TextShowFun
    tsFun)
                                Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE Name
    p) [| (>) |] (Int -> Q Exp
    integerE Int
    appPrec)
                                Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp
    namedArgs)
                   []
    makeTextShowForCon p :: Name
    p tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun tvMap :: Map Name (Name, Name)
    tvMap
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    conName
                       , constructorVariant :: ConstructorInfo -> ConstructorVariant
    constructorVariant = RecordConstructor argNames :: [Name]
    argNames
                       , constructorFields :: ConstructorInfo -> Cxt
    constructorFields  = Cxt
    argTys }) = do
        Cxt
    argTys' <- (Type -> TypeQ) -> Cxt -> CxtQ
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> TypeQ
    resolveTypeSynonyms Cxt
    argTys
        [Name]
    args <- String -> Int -> Q [Name]
    newNameList "arg" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    argTys'

        let showArgs :: [Q Exp]
    showArgs       = ((Name, Type, Name) -> [Q Exp]) -> [(Name, Type, Name)] -> [Q Exp]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\(argName :: Name
    argName, argTy :: Type
    argTy, arg :: Name
    arg)
                                          -> let argNameBase :: String
    argNameBase = Name -> String
    nameBase Name
    argName
                                                 infixRec :: String
    infixRec    = Bool -> (String -> String) -> String -> String
    showParen (String -> Bool
    isSymVar String
    argNameBase)
                                                                         (String -> String -> String
    showString String
    argNameBase) ""
                                             in [ Name -> Q Exp
    varE (TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` String -> Q Exp
    stringE (String
    infixRec String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " = ")
                                                , Int
    -> TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Type
    -> Name
    -> Q Exp
    makeTextShowForArg 0 TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap Type
    argTy Name
    arg
                                                , Name -> Q Exp
    varE (TextShowFun -> Name
    showCommaSpaceName TextShowFun
    tsFun)
                                                ]
                                       )
                                       ([Name] -> Cxt -> [Name] -> [(Name, Type, Name)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Name]
    argNames Cxt
    argTys' [Name]
    args)
            braceCommaArgs :: [Q Exp]
    braceCommaArgs = (Name -> Q Exp
    varE (TextShowFun -> Name
    singletonName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` Char -> Q Exp
    charE '{') Q Exp -> [Q Exp] -> [Q Exp]
    forall a. a -> [a] -> [a]
    : Int -> [Q Exp] -> [Q Exp]
    forall a. Int -> [a] -> [a]
    take ([Q Exp] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Q Exp]
    showArgs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) [Q Exp]
    showArgs
            mappendArgs :: Q Exp
    mappendArgs    = (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr' (Q Exp -> Q Exp -> Q Exp -> Q Exp
    `infixApp` [| (<>) |])
                                    (Name -> Q Exp
    varE (TextShowFun -> Name
    singletonName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` Char -> Q Exp
    charE '}')
                                    [Q Exp]
    braceCommaArgs
            namedArgs :: Q Exp
    namedArgs      = Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE (TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` String -> Q Exp
    stringE (Name -> String -> String
    parenInfixConName Name
    conName " "))
                                      [| (<>) |]
                                      Q Exp
    mappendArgs

        PatQ -> BodyQ -> [Q Dec] -> MatchQ
    match
          (Name -> [PatQ] -> PatQ
    conP Name
    conName ([PatQ] -> PatQ) -> [PatQ] -> PatQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    args)
          (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    varE (TextShowFun -> Name
    showParenName TextShowFun
    tsFun)
                      Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE Name
    p) [| (>) |] (Int -> Q Exp
    integerE Int
    appPrec)
                      Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp
    namedArgs)
          []
    makeTextShowForCon p :: Name
    p tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun tvMap :: Map Name (Name, Name)
    tvMap
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    conName
                       , constructorVariant :: ConstructorInfo -> ConstructorVariant
    constructorVariant = ConstructorVariant
    InfixConstructor
                       , constructorFields :: ConstructorInfo -> Cxt
    constructorFields  = Cxt
    argTys }) = do
        [alTy :: Type
    alTy, arTy :: Type
    arTy] <- (Type -> TypeQ) -> Cxt -> CxtQ
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> TypeQ
    resolveTypeSynonyms Cxt
    argTys
        Name
    al <- String -> Q Name
    newName "argL"
        Name
    ar <- String -> Q Name
    newName "argR"
        Fixity
    fi <- Fixity -> Maybe Fixity -> Fixity
    forall a. a -> Maybe a -> a
    fromMaybe Fixity
    defaultFixity (Maybe Fixity -> Fixity) -> Q (Maybe Fixity) -> Q Fixity
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> Q (Maybe Fixity)
    reifyFixityCompat Name
    conName
        let conPrec :: Int
    conPrec  = case Fixity
    fi of Fixity prec :: Int
    prec _ -> Int
    prec
            opName :: String
    opName   = Name -> String
    nameBase Name
    conName
            infixOpE :: Q Exp
    infixOpE = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) (Q Exp -> Q Exp) -> (String -> Q Exp) -> String -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Q Exp
    stringE (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                         if String -> Bool
    isInfixDataCon String
    opName
                            then " "  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    opName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " "
                            else " `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    opName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "` "

        PatQ -> BodyQ -> [Q Dec] -> MatchQ
    match
          (PatQ -> Name -> PatQ -> PatQ
    infixP (Name -> PatQ
    varP Name
    al) Name
    conName (Name -> PatQ
    varP Name
    ar))
          (Q Exp -> BodyQ
    normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q Exp
    varE (TextShowFun -> Name
    showParenName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Name -> Q Exp
    varE Name
    p) [| (>) |] (Int -> Q Exp
    integerE Int
    conPrec))
                       Q Exp -> Q Exp -> Q Exp
    `appE` (Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Int
    -> TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Type
    -> Name
    -> Q Exp
    makeTextShowForArg (Int
    conPrec Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap Type
    alTy Name
    al)
                                        [| (<>) |]
                                        (Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp Q Exp
    infixOpE
                                                  [| (<>) |]
                                                  (Int
    -> TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Type
    -> Name
    -> Q Exp
    makeTextShowForArg (Int
    conPrec Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap Type
    arTy Name
    ar)))
          )
          []

    -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for an
    -- argument of a constructor.
    makeTextShowForArg :: Int
                       -> TextShowClass
                       -> TextShowFun
                       -> Name
                       -> TyVarMap
                       -> Type
                       -> Name
                       -> Q Exp
    makeTextShowForArg :: Int
    -> TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Type
    -> Name
    -> Q Exp
    makeTextShowForArg p :: Int
    p _ tsFun :: TextShowFun
    tsFun _ _ (ConT tyName :: Name
    tyName) tyExpName :: Name
    tyExpName =
        Q Exp
    showE
      where
        tyVarE, showPrecE :: Q Exp
        tyVarE :: Q Exp
    tyVarE    = Name -> Q Exp
    varE Name
    tyExpName
        showPrecE :: Q Exp
    showPrecE = Name -> Q Exp
    varE (TextShowClass -> TextShowFun -> Name
    showPrecName TextShowClass
    TextShow TextShowFun
    tsFun)

        showE :: Q Exp
        showE :: Q Exp
    showE =
          case Name -> Map Name PrimShow -> Maybe PrimShow
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    tyName Map Name PrimShow
    primShowTbl of
            Just ps :: PrimShow
    ps -> PrimShow -> Q Exp
    showPrimE PrimShow
    ps
            Nothing -> Q Exp
    showPrecE Q Exp -> Q Exp -> Q Exp
    `appE` Int -> Q Exp
    integerE Int
    p Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp
    tyVarE

        showPrimE :: PrimShow -> Q Exp
        showPrimE :: PrimShow -> Q Exp
    showPrimE PrimShow{ Q Exp -> Q Exp
    primShowBoxer :: PrimShow -> Q Exp -> Q Exp
    primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer
    #if __GLASGOW_HASKELL__ >= 800
                          , TextShowFun -> Q Exp
    primShowPostfixMod :: PrimShow -> TextShowFun -> Q Exp
    primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod, TextShowFun -> Q Exp -> Q Exp
    primShowConv :: PrimShow -> TextShowFun -> Q Exp -> Q Exp
    primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv
    #endif
                          }
    #if __GLASGOW_HASKELL__ >= 800
            -- Starting with GHC 8.0, data types containing unlifted types with
            -- derived Show instances show hashed literals with actual hash signs,
            -- and negative hashed literals are not surrounded with parentheses.
          = TextShowFun -> Q Exp -> Q Exp
    primShowConv TextShowFun
    tsFun (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Q Exp -> Q Exp -> Q Exp
    infixApp (Int -> Q Exp
    primE 0) [| (<>) |] (TextShowFun -> Q Exp
    primShowPostfixMod TextShowFun
    tsFun)
    #else
          = primE p
    #endif
          where
            primE :: Int -> Q Exp
            primE :: Int -> Q Exp
    primE prec :: Int
    prec = Q Exp
    showPrecE Q Exp -> Q Exp -> Q Exp
    `appE` Int -> Q Exp
    integerE Int
    prec Q Exp -> Q Exp -> Q Exp
    `appE` Q Exp -> Q Exp
    primShowBoxer Q Exp
    tyVarE

    makeTextShowForArg p :: Int
    p tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun conName :: Name
    conName tvMap :: Map Name (Name, Name)
    tvMap ty :: Type
    ty tyExpName :: Name
    tyExpName =
        [| $(makeTextShowForType tsClass tsFun conName tvMap False ty) p $(varE tyExpName) |]

    -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a
    -- specific type. The generated expression depends on the number of type variables.
    --
    -- 1. If the type is of kind * (T), apply showbPrec.
    -- 2. If the type is of kind * -> * (T a), apply liftShowbPrec $(makeTextShowForType a)
    -- 3. If the type is of kind * -> * -> * (T a b), apply
    --    liftShowbPrec2 $(makeTextShowForType a) $(makeTextShowForType b)
    makeTextShowForType :: TextShowClass
                        -> TextShowFun
                        -> Name
                        -> TyVarMap
                        -> Bool -- ^ True if we are using the function of type ([a] -> Builder),
                                --   False if we are using the function of type (Int -> a -> Builder).
                        -> Type
                        -> Q Exp
    makeTextShowForType :: TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Bool
    -> Type
    -> Q Exp
    makeTextShowForType _ tsFun :: TextShowFun
    tsFun _ tvMap :: Map Name (Name, Name)
    tvMap sl :: Bool
    sl (VarT tyName :: Name
    tyName) =
        Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ case Name -> Map Name (Name, Name) -> Maybe (Name, Name)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    tyName Map Name (Name, Name)
    tvMap of
             Just (spExp :: Name
    spExp, slExp :: Name
    slExp) -> if Bool
    sl then Name
    slExp else Name
    spExp
             Nothing             -> if Bool
    sl then TextShowClass -> TextShowFun -> Name
    showListName TextShowClass
    TextShow TextShowFun
    tsFun
                                          else TextShowClass -> TextShowFun -> Name
    showPrecName TextShowClass
    TextShow TextShowFun
    tsFun
    makeTextShowForType tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun conName :: Name
    conName tvMap :: Map Name (Name, Name)
    tvMap sl :: Bool
    sl (SigT ty :: Type
    ty _) =
        TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Bool
    -> Type
    -> Q Exp
    makeTextShowForType TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap Bool
    sl Type
    ty
    makeTextShowForType tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun conName :: Name
    conName tvMap :: Map Name (Name, Name)
    tvMap sl :: Bool
    sl (ForallT _ _ ty :: Type
    ty) =
        TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Bool
    -> Type
    -> Q Exp
    makeTextShowForType TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap Bool
    sl Type
    ty
    makeTextShowForType tsClass :: TextShowClass
    tsClass tsFun :: TextShowFun
    tsFun conName :: Name
    conName tvMap :: Map Name (Name, Name)
    tvMap sl :: Bool
    sl ty :: Type
    ty = do
        let tyCon :: Type
            tyArgs :: [Type]
            tyCon :: Type
    tyCon :| tyArgs :: Cxt
    tyArgs = Type -> NonEmpty Type
    unapplyTy Type
    ty

            numLastArgs :: Int
            numLastArgs :: Int
    numLastArgs = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (TextShowClass -> Int
    forall a. Enum a => a -> Int
    fromEnum TextShowClass
    tsClass) (Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    tyArgs)

            lhsArgs, rhsArgs :: [Type]
            (lhsArgs :: Cxt
    lhsArgs, rhsArgs :: Cxt
    rhsArgs) = Int -> Cxt -> (Cxt, Cxt)
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    tyArgs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    numLastArgs) Cxt
    tyArgs

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

        Bool
    itf <- Type -> Q Bool
    isTyFamily Type
    tyCon
        if (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    lhsArgs
              Bool -> Bool -> Bool
    || Bool
    itf Bool -> Bool -> Bool
    && (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    tyArgs
           then TextShowClass -> Name -> Q Exp
    forall a. TextShowClass -> Name -> a
    outOfPlaceTyVarError TextShowClass
    tsClass Name
    conName
           else if (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    rhsArgs
                   then [Q Exp] -> Q Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [ Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Bool -> TextShowClass -> TextShowFun -> Name
    showPrecOrListName Bool
    sl (Int -> TextShowClass
    forall a. Enum a => Int -> a
    toEnum Int
    numLastArgs) TextShowFun
    tsFun]
                                [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ (Bool -> Type -> Q Exp) -> [Bool] -> Cxt -> [Q Exp]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (TextShowClass
    -> TextShowFun
    -> Name
    -> Map Name (Name, Name)
    -> Bool
    -> Type
    -> Q Exp
    makeTextShowForType TextShowClass
    tsClass TextShowFun
    tsFun Name
    conName Map Name (Name, Name)
    tvMap)
                                           ([Bool] -> [Bool]
    forall a. [a] -> [a]
    cycle [Bool
    False,Bool
    True])
                                           (Cxt -> Cxt -> Cxt
    forall a. [a] -> [a] -> [a]
    interleave Cxt
    rhsArgs Cxt
    rhsArgs)
                   else Name -> Q Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ if Bool
    sl then TextShowClass -> TextShowFun -> Name
    showListName TextShowClass
    TextShow TextShowFun
    tsFun
                                     else TextShowClass -> TextShowFun -> Name
    showPrecName TextShowClass
    TextShow TextShowFun
    tsFun

    -------------------------------------------------------------------------------
    -- Template Haskell reifying and AST manipulation
    -------------------------------------------------------------------------------

    -- For the given Types, generate an instance context and head. 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 :: TextShowClass
                      -- ^ TextShow, TextShow1, or TextShow2
                      -> Name
                      -- ^ The type constructor or data family name
                      -> Cxt
                      -- ^ The datatype context
                      -> [Type]
                      -- ^ The types to instantiate the instance with
                      -> DatatypeVariant
                      -- ^ Are we dealing with a data family instance or not
                      -> Q (Cxt, Type)
    buildTypeInstance :: TextShowClass
    -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance tsClass :: TextShowClass
    tsClass tyConName :: Name
    tyConName dataCxt :: Cxt
    dataCxt varTysOrig :: Cxt
    varTysOrig variant :: DatatypeVariant
    variant = 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.)
        Cxt
    varTysExp <- (Type -> TypeQ) -> Cxt -> CxtQ
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> TypeQ
    resolveTypeSynonyms Cxt
    varTysOrig

        let remainingLength :: Int
            remainingLength :: Int
    remainingLength = Cxt -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    varTysOrig Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - TextShowClass -> Int
    forall a. Enum a => a -> Int
    fromEnum TextShowClass
    tsClass

            droppedTysExp :: [Type]
            droppedTysExp :: Cxt
    droppedTysExp = Int -> Cxt -> Cxt
    forall a. Int -> [a] -> [a]
    drop Int
    remainingLength Cxt
    varTysExp

            droppedStarKindStati :: [StarKindStatus]
            droppedStarKindStati :: [StarKindStatus]
    droppedStarKindStati = (Type -> StarKindStatus) -> Cxt -> [StarKindStatus]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> StarKindStatus
    canRealizeKindStar Cxt
    droppedTysExp

        -- Check there are enough types to drop and that all of them are either of
        -- kind * or kind k (for some kind variable k). If not, throw an error.
        Bool -> Q () -> Q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    remainingLength Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 Bool -> Bool -> Bool
    || (StarKindStatus -> Bool) -> [StarKindStatus] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (StarKindStatus -> StarKindStatus -> Bool
    forall a. Eq a => a -> a -> Bool
    == StarKindStatus
    NotKindStar) [StarKindStatus]
    droppedStarKindStati) (Q () -> Q ()) -> Q () -> Q ()
    forall a b. (a -> b) -> a -> b
    $
          TextShowClass -> Name -> Q ()
    forall a. TextShowClass -> Name -> a
    derivingKindError TextShowClass
    tsClass Name
    tyConName

        let droppedKindVarNames :: [Name]
            droppedKindVarNames :: [Name]
    droppedKindVarNames = [StarKindStatus] -> [Name]
    catKindVarNames [StarKindStatus]
    droppedStarKindStati

            -- Substitute kind * for any dropped kind variables
            varTysExpSubst :: [Type]
            varTysExpSubst :: Cxt
    varTysExpSubst = (Type -> Type) -> Cxt -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map ([Name] -> Type -> Type
    substNamesWithKindStar [Name]
    droppedKindVarNames) Cxt
    varTysExp

            remainingTysExpSubst, droppedTysExpSubst :: [Type]
            (remainingTysExpSubst :: Cxt
    remainingTysExpSubst, droppedTysExpSubst :: Cxt
    droppedTysExpSubst) =
              Int -> Cxt -> (Cxt, Cxt)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    remainingLength Cxt
    varTysExpSubst

            -- All of the type variables mentioned in the dropped types
            -- (post-synonym expansion)
            droppedTyVarNames :: [Name]
            droppedTyVarNames :: [Name]
    droppedTyVarNames = Cxt -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables Cxt
    droppedTysExpSubst

        -- If any of the dropped types were polykinded, ensure that they are of kind *
        -- after substituting * for the dropped kind variables. If not, throw an error.
        Bool -> Q () -> Q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ((Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    hasKindStar Cxt
    droppedTysExpSubst) (Q () -> Q ()) -> Q () -> Q ()
    forall a b. (a -> b) -> a -> b
    $
          TextShowClass -> Name -> Q ()
    forall a. TextShowClass -> Name -> a
    derivingKindError TextShowClass
    tsClass Name
    tyConName

        let preds    :: [Maybe Pred]
            kvNames  :: [[Name]]
            kvNames' :: [Name]
            -- Derive instance constraints (and any kind variables which are specialized
            -- to * in those constraints)
            (preds :: [Maybe Type]
    preds, kvNames :: [[Name]]
    kvNames) = [(Maybe Type, [Name])] -> ([Maybe Type], [[Name]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Maybe Type, [Name])] -> ([Maybe Type], [[Name]]))
    -> [(Maybe Type, [Name])] -> ([Maybe Type], [[Name]])
    forall a b. (a -> b) -> a -> b
    $ (Type -> (Maybe Type, [Name])) -> Cxt -> [(Maybe Type, [Name])]
    forall a b. (a -> b) -> [a] -> [b]
    map (TextShowClass -> Type -> (Maybe Type, [Name])
    deriveConstraint TextShowClass
    tsClass) Cxt
    remainingTysExpSubst
            kvNames' :: [Name]
    kvNames' = [[Name]] -> [Name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Name]]
    kvNames

            -- Substitute the kind variables specialized in the constraints with *
            remainingTysExpSubst' :: [Type]
            remainingTysExpSubst' :: Cxt
    remainingTysExpSubst' =
              (Type -> Type) -> Cxt -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map ([Name] -> Type -> Type
    substNamesWithKindStar [Name]
    kvNames') Cxt
    remainingTysExpSubst

            -- 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])
            remainingTysOrigSubst :: [Type]
            remainingTysOrigSubst :: Cxt
    remainingTysOrigSubst =
              (Type -> Type) -> Cxt -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map ([Name] -> Type -> Type
    substNamesWithKindStar ([Name] -> [Name] -> [Name]
    forall a. Eq a => [a] -> [a] -> [a]
    union [Name]
    droppedKindVarNames [Name]
    kvNames'))
                (Cxt -> Cxt) -> Cxt -> Cxt
    forall a b. (a -> b) -> a -> b
    $ Int -> Cxt -> Cxt
    forall a. Int -> [a] -> [a]
    take Int
    remainingLength Cxt
    varTysOrig

            isDataFamily :: Bool
            isDataFamily :: Bool
    isDataFamily = case DatatypeVariant
    variant of
                             Datatype        -> Bool
    False
                             Newtype         -> Bool
    False
                             DataInstance    -> Bool
    True
                             NewtypeInstance -> Bool
    True

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

            instanceCxt :: Cxt
            instanceCxt :: Cxt
    instanceCxt = [Maybe Type] -> Cxt
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Type]
    preds

            instanceType :: Type
            instanceType :: Type
    instanceType = Type -> Type -> Type
    AppT (Name -> Type
    ConT (Name -> Type) -> Name -> Type
    forall a b. (a -> b) -> a -> b
    $ TextShowClass -> Name
    textShowClassName TextShowClass
    tsClass)
                         (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Name -> Cxt -> Type
    applyTyCon Name
    tyConName Cxt
    remainingTysOrigSubst'

        -- If the datatype context mentions any of the dropped type variables,
        -- we can't derive an instance, so throw an error.
        Bool -> Q () -> Q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `predMentionsName` [Name]
    droppedTyVarNames) Cxt
    dataCxt) (Q () -> Q ()) -> Q () -> Q ()
    forall a b. (a -> b) -> a -> b
    $
          Name -> Type -> Q ()
    forall a. Name -> Type -> a
    datatypeContextError Name
    tyConName Type
    instanceType
        -- Also ensure the dropped types can be safely eta-reduced. Otherwise,
        -- throw an error.
        Bool -> Q () -> Q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Cxt -> Cxt -> Bool
    canEtaReduce Cxt
    remainingTysExpSubst' Cxt
    droppedTysExpSubst) (Q () -> Q ()) -> Q () -> Q ()
    forall a b. (a -> b) -> a -> b
    $
          Type -> Q ()
    forall a. Type -> a
    etaReductionError Type
    instanceType
        (Cxt, Type) -> Q (Cxt, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Cxt
    instanceCxt, Type
    instanceType)

    -- | Attempt to derive a constraint on a Type. If successful, return
    -- Just the constraint and any kind variable names constrained to *.
    -- Otherwise, return Nothing and the empty list.
    --
    -- See Note [Type inference in derived instances] for the heuristics used to
    -- come up with constraints.
    deriveConstraint :: TextShowClass -> Type -> (Maybe Pred, [Name])
    deriveConstraint :: TextShowClass -> Type -> (Maybe Type, [Name])
    deriveConstraint tsClass :: TextShowClass
    tsClass t :: Type
    t
      | Bool -> Bool
    not (Type -> Bool
    isTyVar Type
    t) = (Maybe Type
    forall a. Maybe a
    Nothing, [])
      | Type -> Bool
    hasKindStar Type
    t   = (Type -> Maybe Type
    forall a. a -> Maybe a
    Just (Name -> Name -> Type
    applyClass ''TextShow Name
    tName), [])
      | Bool
    otherwise = case Int -> Type -> Maybe [Name]
    hasKindVarChain 1 Type
    t of
          Just ns :: [Name]
    ns | TextShowClass
    tsClass TextShowClass -> TextShowClass -> Bool
    forall a. Ord a => a -> a -> Bool
    >= TextShowClass
    TextShow1
                  -> (Type -> Maybe Type
    forall a. a -> Maybe a
    Just (Name -> Name -> Type
    applyClass ''TextShow1 Name
    tName), [Name]
    ns)
          _ -> case Int -> Type -> Maybe [Name]
    hasKindVarChain 2 Type
    t of
               Just ns :: [Name]
    ns | TextShowClass
    tsClass TextShowClass -> TextShowClass -> Bool
    forall a. Eq a => a -> a -> Bool
    == TextShowClass
    TextShow2
                       -> (Type -> Maybe Type
    forall a. a -> Maybe a
    Just (Name -> Name -> Type
    applyClass ''TextShow2 Name
    tName), [Name]
    ns)
               _ -> (Maybe Type
    forall a. Maybe a
    Nothing, [])
      where
        tName :: Name
        tName :: Name
    tName = Type -> Name
    varTToName Type
    t

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

    It is possible to put explicit kind signatures into the derived instances, e.g.,

      instance C a => C (Data (f :: * -> *)) where ...

    But it is preferable to avoid this if possible. If we come up with an incorrect
    kind signature (which is entirely possible, since our type inferencer is pretty
    unsophisticated - see Note [Type inference in derived instances]), then GHC will
    flat-out reject the instance, which is quite unfortunate.

    Plain old datatypes have the advantage that you can avoid using any kind signatures
    at all in their instances. This is because a datatype declaration uses all type
    variables, so the types that we use in a derived instance uniquely determine their
    kinds. As long as we plug in the right types, the kind inferencer can do the rest
    of the work. For this reason, we use unSigT to remove all kind signatures before
    splicing in the instance context and head.

    Data family instances are trickier, since a data family can have two instances that
    are distinguished by kind alone, e.g.,

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

    If we dropped the kind signatures for C (Fam a), then GHC will have no way of
    knowing which instance we are talking about. To avoid this scenario, we always
    include explicit kind signatures in data family instances. There is a chance that
    the inferred kind signatures will be incorrect, but if so, we can always fall back
    on the make- functions.

    Note [Type inference in derived instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Type inference is can be tricky to get right, and we want to avoid recreating the
    entirety of GHC's type inferencer in Template Haskell. For this reason, we will
    probably never come up with derived instance contexts that are as accurate as
    GHC's. But that doesn't mean we can't do anything! There are a couple of simple
    things we can do to make instance contexts that work for 80% of use cases:

    1. If one of the last type parameters is polykinded, then its kind will be
       specialized to * in the derived instance. We note what kind variable the type
       parameter had and substitute it with * in the other types as well. For example,
       imagine you had

         data Data (a :: k) (b :: k)

       Then you'd want to derived instance to be:

         instance C (Data (a :: *))

       Not:

         instance C (Data (a :: k))

    2. We naïvely come up with instance constraints using the following criteria:

       (i)   If there's a type parameter n of kind *, generate a TextShow n constraint.
       (ii)  If there's a type parameter n of kind k1 -> k2 (where k1/k2 are * or kind
             variables), then generate a TextShow1 n constraint, and if k1/k2 are kind
             variables, then substitute k1/k2 with * elsewhere in the types. We must
             consider the case where they are kind variables because you might have a
             scenario like this:

               newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1)
                 = Compose (f (g a))

             Which would have a derived TextShow1 instance of:

               instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where ...
       (iii) If there's a type parameter n of kind k1 -> k2 -> k3 (where k1/k2/k3 are
             * or kind variables), then generate a TextShow2 constraint and perform
             kind substitution as in the other cases.
    -}

    -------------------------------------------------------------------------------
    -- Error messages
    -------------------------------------------------------------------------------

    -- | Either the given data type doesn't have enough type variables, or one of
    -- the type variables to be eta-reduced cannot realize kind *.
    derivingKindError :: TextShowClass -> Name -> a
    derivingKindError :: TextShowClass -> Name -> a
    derivingKindError tsClass :: TextShowClass
    tsClass tyConName :: Name
    tyConName = String -> a
    forall a. HasCallStack => String -> a
    error
        (String -> a) -> (String -> String) -> String -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString "Cannot derive well-kinded instance of form ‘"
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    className
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    showChar ' '
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> (String -> String) -> String -> String
    showParen Bool
    True
          ( String -> String -> String
    showString (Name -> String
    nameBase Name
    tyConName)
          (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString " ..."
          )
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString "‘\n\tClass "
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    className
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString " expects an argument of kind "
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (Type -> String
    forall a. Ppr a => a -> String
    pprint (Type -> String) -> (Int -> Type) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Type
    createKindChain (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TextShowClass -> Int
    forall a. Enum a => a -> Int
    fromEnum TextShowClass
    tsClass)
        (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ ""
      where
        className :: String
        className :: String
    className = Name -> String
    nameBase (Name -> String) -> Name -> String
    forall a b. (a -> b) -> a -> b
    $ TextShowClass -> Name
    textShowClassName TextShowClass
    tsClass

    -- | One of the last type variables cannot be eta-reduced (see the canEtaReduce
    -- function for the criteria it would have to meet).
    etaReductionError :: Type -> a
    etaReductionError :: Type -> a
    etaReductionError instanceType :: Type
    instanceType = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $
        "Cannot eta-reduce to an instance of form \n\tinstance (...) => "
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    instanceType

    -- | The data type has a DatatypeContext which mentions one of the eta-reduced
    -- type variables.
    datatypeContextError :: Name -> Type -> a
    datatypeContextError :: Name -> Type -> a
    datatypeContextError dataName :: Name
    dataName instanceType :: Type
    instanceType = String -> a
    forall a. HasCallStack => String -> a
    error
        (String -> a) -> (String -> String) -> String -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString "Can't make a derived instance of ‘"
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    instanceType)
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString "‘:\n\tData type ‘"
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (Name -> String
    nameBase Name
    dataName)
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString "‘ must not have a class context involving the last type argument(s)"
        (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ ""

    -- | The data type mentions one of the n eta-reduced type variables in a place other
    -- than the last nth positions of a data type in a constructor's field.
    outOfPlaceTyVarError :: TextShowClass -> Name -> a
    outOfPlaceTyVarError :: TextShowClass -> Name -> a
    outOfPlaceTyVarError tsClass :: TextShowClass
    tsClass conName :: Name
    conName = String -> a
    forall a. HasCallStack => String -> a
    error
        (String -> a) -> (String -> String) -> String -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString "Constructor ‘"
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (Name -> String
    nameBase Name
    conName)
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString "‘ must only use its last "
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Show a => a -> String -> String
    shows Int
    n
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString " type variable(s) within the last "
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Show a => a -> String -> String
    shows Int
    n
        (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString " argument(s) of a data type"
        (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ ""
      where
        n :: Int
        n :: Int
    n = TextShowClass -> Int
    forall a. Enum a => a -> Int
    fromEnum TextShowClass
    tsClass

    -------------------------------------------------------------------------------
    -- Expanding type synonyms
    -------------------------------------------------------------------------------

    applySubstitutionKind :: Map Name Kind -> Type -> Type
    #if MIN_VERSION_template_haskell(2,8,0)
    applySubstitutionKind :: Map Name Type -> Type -> Type
    applySubstitutionKind = Map Name Type -> Type -> Type
    forall a. TypeSubstitution a => Map Name Type -> a -> a
    applySubstitution
    #else
    applySubstitutionKind _ t = t
    #endif

    substNameWithKind :: Name -> Kind -> Type -> Type
    substNameWithKind :: Name -> Type -> Type -> Type
    substNameWithKind n :: Name
    n k :: Type
    k = Map Name Type -> Type -> Type
    applySubstitutionKind (Name -> Type -> Map Name Type
    forall k a. k -> a -> Map k a
    Map.singleton Name
    n Type
    k)

    substNamesWithKindStar :: [Name] -> Type -> Type
    substNamesWithKindStar :: [Name] -> Type -> Type
    substNamesWithKindStar ns :: [Name]
    ns t :: Type
    t = (Name -> Type -> Type) -> Type -> [Name] -> Type
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr' ((Name -> Type -> Type -> Type) -> Type -> Name -> Type -> Type
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Name -> Type -> Type -> Type
    substNameWithKind Type
    starK) Type
    t [Name]
    ns

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

    -- | A representation of which TextShow variant is being derived.
    data TextShowClass = TextShow | TextShow1 | TextShow2
      deriving (Int -> TextShowClass
    TextShowClass -> Int
    TextShowClass -> [TextShowClass]
    TextShowClass -> TextShowClass
    TextShowClass -> TextShowClass -> [TextShowClass]
    TextShowClass -> TextShowClass -> TextShowClass -> [TextShowClass]
    (TextShowClass -> TextShowClass)
    -> (TextShowClass -> TextShowClass)
    -> (Int -> TextShowClass)
    -> (TextShowClass -> Int)
    -> (TextShowClass -> [TextShowClass])
    -> (TextShowClass -> TextShowClass -> [TextShowClass])
    -> (TextShowClass -> TextShowClass -> [TextShowClass])
    -> (TextShowClass
        -> TextShowClass -> TextShowClass -> [TextShowClass])
    -> Enum TextShowClass
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    enumFromThenTo :: TextShowClass -> TextShowClass -> TextShowClass -> [TextShowClass]
    $cenumFromThenTo :: TextShowClass -> TextShowClass -> TextShowClass -> [TextShowClass]
    enumFromTo :: TextShowClass -> TextShowClass -> [TextShowClass]
    $cenumFromTo :: TextShowClass -> TextShowClass -> [TextShowClass]
    enumFromThen :: TextShowClass -> TextShowClass -> [TextShowClass]
    $cenumFromThen :: TextShowClass -> TextShowClass -> [TextShowClass]
    enumFrom :: TextShowClass -> [TextShowClass]
    $cenumFrom :: TextShowClass -> [TextShowClass]
    fromEnum :: TextShowClass -> Int
    $cfromEnum :: TextShowClass -> Int
    toEnum :: Int -> TextShowClass
    $ctoEnum :: Int -> TextShowClass
    pred :: TextShowClass -> TextShowClass
    $cpred :: TextShowClass -> TextShowClass
    succ :: TextShowClass -> TextShowClass
    $csucc :: TextShowClass -> TextShowClass
    Enum, TextShowClass -> TextShowClass -> Bool
    (TextShowClass -> TextShowClass -> Bool)
    -> (TextShowClass -> TextShowClass -> Bool) -> Eq TextShowClass
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: TextShowClass -> TextShowClass -> Bool
    $c/= :: TextShowClass -> TextShowClass -> Bool
    == :: TextShowClass -> TextShowClass -> Bool
    $c== :: TextShowClass -> TextShowClass -> Bool
    Eq, Eq TextShowClass
    Eq TextShowClass =>
    (TextShowClass -> TextShowClass -> Ordering)
    -> (TextShowClass -> TextShowClass -> Bool)
    -> (TextShowClass -> TextShowClass -> Bool)
    -> (TextShowClass -> TextShowClass -> Bool)
    -> (TextShowClass -> TextShowClass -> Bool)
    -> (TextShowClass -> TextShowClass -> TextShowClass)
    -> (TextShowClass -> TextShowClass -> TextShowClass)
    -> Ord TextShowClass
    TextShowClass -> TextShowClass -> Bool
    TextShowClass -> TextShowClass -> Ordering
    TextShowClass -> TextShowClass -> TextShowClass
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: TextShowClass -> TextShowClass -> TextShowClass
    $cmin :: TextShowClass -> TextShowClass -> TextShowClass
    max :: TextShowClass -> TextShowClass -> TextShowClass
    $cmax :: TextShowClass -> TextShowClass -> TextShowClass
    >= :: TextShowClass -> TextShowClass -> Bool
    $c>= :: TextShowClass -> TextShowClass -> Bool
    > :: TextShowClass -> TextShowClass -> Bool
    $c> :: TextShowClass -> TextShowClass -> Bool
    <= :: TextShowClass -> TextShowClass -> Bool
    $c<= :: TextShowClass -> TextShowClass -> Bool
    < :: TextShowClass -> TextShowClass -> Bool
    $c< :: TextShowClass -> TextShowClass -> Bool
    compare :: TextShowClass -> TextShowClass -> Ordering
    $ccompare :: TextShowClass -> TextShowClass -> Ordering
    $cp1Ord :: Eq TextShowClass
    Ord)

    -- | A representation of which TextShow method is being used to
    -- implement something.
    data TextShowFun = ShowbPrec | ShowtPrec | ShowtlPrec

    fromStringName :: TextShowFun -> Name
    fromStringName :: TextShowFun -> Name
    fromStringName ShowbPrec  = 'TB.fromString
    fromStringName ShowtPrec  = 'TS.pack
    fromStringName ShowtlPrec = 'TL.pack

    singletonName :: TextShowFun -> Name
    singletonName :: TextShowFun -> Name
    singletonName ShowbPrec  = 'TB.singleton
    singletonName ShowtPrec  = 'TS.singleton
    singletonName ShowtlPrec = 'TL.singleton

    showParenName :: TextShowFun -> Name
    showParenName :: TextShowFun -> Name
    showParenName ShowbPrec  = 'showbParen
    showParenName ShowtPrec  = 'showtParen
    showParenName ShowtlPrec = 'showtlParen

    showCommaSpaceName :: TextShowFun -> Name
    showCommaSpaceName :: TextShowFun -> Name
    showCommaSpaceName ShowbPrec  = 'showbCommaSpace
    showCommaSpaceName ShowtPrec  = 'showtCommaSpace
    showCommaSpaceName ShowtlPrec = 'showtlCommaSpace

    showSpaceName :: TextShowFun -> Name
    showSpaceName :: TextShowFun -> Name
    showSpaceName ShowbPrec  = 'showbSpace
    showSpaceName ShowtPrec  = 'showtSpace
    showSpaceName ShowtlPrec = 'showtlSpace

    showPrecConstName :: TextShowClass -> TextShowFun -> Name
    showPrecConstName :: TextShowClass -> TextShowFun -> Name
    showPrecConstName tsClass :: TextShowClass
    tsClass  ShowbPrec  = TextShowClass -> Name
    showbPrecConstName TextShowClass
    tsClass
    showPrecConstName TextShow ShowtPrec  = 'showtPrecConst
    showPrecConstName TextShow ShowtlPrec = 'showtlPrecConst
    showPrecConstName _        _          = String -> Name
    forall a. HasCallStack => String -> a
    error "showPrecConstName"

    showbPrecConstName :: TextShowClass -> Name
    showbPrecConstName :: TextShowClass -> Name
    showbPrecConstName TextShow  = 'showbPrecConst
    showbPrecConstName TextShow1 = 'liftShowbPrecConst
    showbPrecConstName TextShow2 = 'liftShowbPrec2Const

    textShowClassName :: TextShowClass -> Name
    textShowClassName :: TextShowClass -> Name
    textShowClassName TextShow  = ''TextShow
    textShowClassName TextShow1 = ''TextShow1
    textShowClassName TextShow2 = ''TextShow2

    showPrecName :: TextShowClass -> TextShowFun -> Name
    showPrecName :: TextShowClass -> TextShowFun -> Name
    showPrecName tsClass :: TextShowClass
    tsClass  ShowbPrec  = TextShowClass -> Name
    showbPrecName TextShowClass
    tsClass
    showPrecName TextShow ShowtPrec  = 'showtPrec
    showPrecName TextShow ShowtlPrec = 'showtlPrec
    showPrecName _        _          = String -> Name
    forall a. HasCallStack => String -> a
    error "showPrecName"

    showbPrecName :: TextShowClass -> Name
    showbPrecName :: TextShowClass -> Name
    showbPrecName TextShow  = 'showbPrec
    showbPrecName TextShow1 = 'liftShowbPrec
    showbPrecName TextShow2 = 'liftShowbPrec2

    showListName :: TextShowClass -> TextShowFun -> Name
    showListName :: TextShowClass -> TextShowFun -> Name
    showListName tsClass :: TextShowClass
    tsClass  ShowbPrec  = TextShowClass -> Name
    showbListName TextShowClass
    tsClass
    showListName TextShow ShowtPrec  = 'showtPrec
    showListName TextShow ShowtlPrec = 'showtlPrec
    showListName _        _          = String -> Name
    forall a. HasCallStack => String -> a
    error "showListName"

    showbListName :: TextShowClass -> Name
    showbListName :: TextShowClass -> Name
    showbListName TextShow  = 'showbList
    showbListName TextShow1 = 'liftShowbList
    showbListName TextShow2 = 'liftShowbList2

    showPrecOrListName :: Bool -- ^ showbListName if True, showbPrecName if False
                       -> TextShowClass
                       -> TextShowFun
                       -> Name
    showPrecOrListName :: Bool -> TextShowClass -> TextShowFun -> Name
    showPrecOrListName False = TextShowClass -> TextShowFun -> Name
    showPrecName
    showPrecOrListName True  = TextShowClass -> TextShowFun -> Name
    showListName

    -- | A type-restricted version of 'const'. This is useful when generating the lambda
    -- expression in 'makeShowbPrec' for a data type with only nullary constructors (since
    -- the expression wouldn't depend on the precedence). For example, if you had @data
    -- Nullary = Nullary@ and attempted to run @$(makeShowbPrec ''Nullary) Nullary@, simply
    -- ignoring the precedence argument would cause the type signature of @$(makeShowbPrec
    -- ''Nullary)@ to be @a -> Nullary -> Builder@, not @Int -> Nullary -> Builder@.
    showbPrecConst :: Builder
                   -> Int -> a -> Builder
    showbPrecConst :: Builder -> Int -> a -> Builder
    showbPrecConst b :: Builder
    b _ _ = Builder
    b

    showtPrecConst :: TS.Text
                   -> Int -> a -> TS.Text
    showtPrecConst :: Text -> Int -> a -> Text
    showtPrecConst t :: Text
    t _ _ = Text
    t

    showtlPrecConst :: TL.Text
                    -> Int -> a -> TL.Text
    showtlPrecConst :: Text -> Int -> a -> Text
    showtlPrecConst tl :: Text
    tl _ _ = Text
    tl

    liftShowbPrecConst :: Builder
                       -> (Int -> a -> Builder) -> ([a] -> Builder)
                       -> Int -> f a -> Builder
    liftShowbPrecConst :: Builder
    -> (Int -> a -> Builder)
    -> ([a] -> Builder)
    -> Int
    -> f a
    -> Builder
    liftShowbPrecConst b :: Builder
    b _ _ _ _ = Builder
    b

    liftShowbPrec2Const :: Builder
                        -> (Int -> a -> Builder) -> ([a] -> Builder)
                        -> (Int -> b -> Builder) -> ([b] -> Builder)
                        -> Int -> f a b -> Builder
    liftShowbPrec2Const :: Builder
    -> (Int -> a -> Builder)
    -> ([a] -> Builder)
    -> (Int -> b -> Builder)
    -> ([b] -> Builder)
    -> Int
    -> f a b
    -> Builder
    liftShowbPrec2Const b :: Builder
    b _ _ _ _ _ _ = Builder
    b

    -------------------------------------------------------------------------------
    -- StarKindStatus
    -------------------------------------------------------------------------------

    -- | Whether a type is not of kind *, is of kind *, or is a kind variable.
    data StarKindStatus = NotKindStar
                        | KindStar
                        | IsKindVar Name
      deriving StarKindStatus -> StarKindStatus -> Bool
    (StarKindStatus -> StarKindStatus -> Bool)
    -> (StarKindStatus -> StarKindStatus -> Bool) -> Eq StarKindStatus
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: StarKindStatus -> StarKindStatus -> Bool
    $c/= :: StarKindStatus -> StarKindStatus -> Bool
    == :: StarKindStatus -> StarKindStatus -> Bool
    $c== :: StarKindStatus -> StarKindStatus -> Bool
    Eq

    -- | Does a Type have kind * or k (for some kind variable k)?
    canRealizeKindStar :: Type -> StarKindStatus
    canRealizeKindStar :: Type -> StarKindStatus
    canRealizeKindStar t :: Type
    t
      | Type -> Bool
    hasKindStar Type
    t = StarKindStatus
    KindStar
      | Bool
    otherwise = case Type
    t of
    #if MIN_VERSION_template_haskell(2,8,0)
                         SigT _ (VarT k :: Name
    k) -> Name -> StarKindStatus
    IsKindVar Name
    k
    #endif
                         _               -> StarKindStatus
    NotKindStar

    -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
    -- Otherwise, returns 'Nothing'.
    starKindStatusToName :: StarKindStatus -> Maybe Name
    starKindStatusToName :: StarKindStatus -> Maybe Name
    starKindStatusToName (IsKindVar n :: Name
    n) = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
    starKindStatusToName _             = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Concat together all of the StarKindStatuses that are IsKindVar and extract
    -- the kind variables' Names out.
    catKindVarNames :: [StarKindStatus] -> [Name]
    catKindVarNames :: [StarKindStatus] -> [Name]
    catKindVarNames = (StarKindStatus -> Maybe Name) -> [StarKindStatus] -> [Name]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe StarKindStatus -> Maybe Name
    starKindStatusToName

    -------------------------------------------------------------------------------
    -- PrimShow
    -------------------------------------------------------------------------------

    data PrimShow = PrimShow
      { PrimShow -> Q Exp -> Q Exp
    primShowBoxer      :: Q Exp -> Q Exp
      , PrimShow -> TextShowFun -> Q Exp
    primShowPostfixMod :: TextShowFun -> Q Exp
      , PrimShow -> TextShowFun -> Q Exp -> Q Exp
    primShowConv       :: TextShowFun -> Q Exp -> Q Exp
      }

    primShowTbl :: Map Name PrimShow
    primShowTbl :: Map Name PrimShow
    primShowTbl = [(Name, PrimShow)] -> Map Name PrimShow
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
        [ (''Char#,   PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'C#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    oneHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = \_ x :: Q Exp
    x -> Q Exp
    x
                        })
        , (''Double#, PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'D#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    twoHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = \_ x :: Q Exp
    x -> Q Exp
    x
                        })
        , (''Float#,  PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'F#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    oneHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = \_ x :: Q Exp
    x -> Q Exp
    x
                        })
        , (''Int#,    PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'I#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    oneHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = \_ x :: Q Exp
    x -> Q Exp
    x
                        })
        , (''Word#,   PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'W#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    twoHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = \_ x :: Q Exp
    x -> Q Exp
    x
                        })
    #if MIN_VERSION_base(4,13,0)
        , (''Int8#,   PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'I#) (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE 'extendInt8#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    oneHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = String -> TextShowFun -> Q Exp -> Q Exp
    mkNarrowE "narrowInt8#"
                        })
        , (''Int16#,  PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'I#) (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE 'extendInt16#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    oneHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = String -> TextShowFun -> Q Exp -> Q Exp
    mkNarrowE "narrowInt16#"
                        })
        , (''Word8#,  PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'W#) (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE 'extendWord8#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    twoHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = String -> TextShowFun -> Q Exp -> Q Exp
    mkNarrowE "narrowWord8#"
                        })
        , (''Word16#, PrimShow :: (Q Exp -> Q Exp)
    -> (TextShowFun -> Q Exp)
    -> (TextShowFun -> Q Exp -> Q Exp)
    -> PrimShow
    PrimShow
                        { primShowBoxer :: Q Exp -> Q Exp
    primShowBoxer      = Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    conE 'W#) (Q Exp -> Q Exp) -> (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q Exp -> Q Exp -> Q Exp
    appE (Name -> Q Exp
    varE 'extendWord16#)
                        , primShowPostfixMod :: TextShowFun -> Q Exp
    primShowPostfixMod = TextShowFun -> Q Exp
    twoHashE
                        , primShowConv :: TextShowFun -> Q Exp -> Q Exp
    primShowConv       = String -> TextShowFun -> Q Exp -> Q Exp
    mkNarrowE "narrowWord16#"
                        })
    #endif
        ]

    #if MIN_VERSION_base(4,13,0)
    mkNarrowE :: String -> TextShowFun -> Q Exp -> Q Exp
    mkNarrowE :: String -> TextShowFun -> Q Exp -> Q Exp
    mkNarrowE narrowStr :: String
    narrowStr tsFun :: TextShowFun
    tsFun e :: Q Exp
    e =
      (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Q Exp -> Q Exp -> Q Exp -> Q Exp
    `infixApp` [| (<>) |])
            (Name -> Q Exp
    varE (TextShowFun -> Name
    singletonName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` Char -> Q Exp
    charE ')')
            [ Name -> Q Exp
    varE (TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` String -> Q Exp
    stringE ('('Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    narrowStr String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " ")
            , Q Exp
    e
            ]
    #endif

    oneHashE, twoHashE :: TextShowFun -> Q Exp
    oneHashE :: TextShowFun -> Q Exp
    oneHashE tsFun :: TextShowFun
    tsFun = Name -> Q Exp
    varE (TextShowFun -> Name
    singletonName TextShowFun
    tsFun)  Q Exp -> Q Exp -> Q Exp
    `appE` Char -> Q Exp
    charE '#'
    twoHashE :: TextShowFun -> Q Exp
    twoHashE tsFun :: TextShowFun
    tsFun = Name -> Q Exp
    varE (TextShowFun -> Name
    fromStringName TextShowFun
    tsFun) Q Exp -> Q Exp -> Q Exp
    `appE` String -> Q Exp
    stringE "##"

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

    integerE :: Int -> Q Exp
    integerE :: Int -> Q Exp
    integerE = Lit -> Q Exp
    litE (Lit -> Q Exp) -> (Int -> Lit) -> Int -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Lit
    integerL (Integer -> Lit) -> (Int -> Integer) -> Int -> Lit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    charE :: Char -> Q Exp
    charE :: Char -> Q Exp
    charE = Lit -> Q Exp
    litE (Lit -> Q Exp) -> (Char -> Lit) -> Char -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Lit
    charL

    -- | Returns True if a Type has kind *.
    hasKindStar :: Type -> Bool
    hasKindStar :: Type -> Bool
    hasKindStar VarT{}         = Bool
    True
    #if MIN_VERSION_template_haskell(2,8,0)
    hasKindStar (SigT _ StarT) = Bool
    True
    #else
    hasKindStar (SigT _ StarK) = True
    #endif
    hasKindStar _              = Bool
    False

    -- Returns True is a kind is equal to *, or if it is a kind variable.
    isStarOrVar :: Kind -> Bool
    #if MIN_VERSION_template_haskell(2,8,0)
    isStarOrVar :: Type -> Bool
    isStarOrVar StarT  = Bool
    True
    isStarOrVar VarT{} = Bool
    True
    #else
    isStarOrVar StarK  = True
    #endif
    isStarOrVar _      = Bool
    False

    -- Generate a list of fresh names with a common prefix, and numbered suffixes.
    newNameList :: String -> Int -> Q [Name]
    newNameList :: String -> Int -> Q [Name]
    newNameList prefix :: String
    prefix n :: Int
    n = (Int -> Q Name) -> [Int] -> Q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> Q Name
    newName (String -> Q Name) -> (Int -> String) -> Int -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [1..Int
    n]

    -- | @hasKindVarChain n kind@ Checks if @kind@ is of the form
    -- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or
    -- kind variables.
    hasKindVarChain :: Int -> Type -> Maybe [Name]
    hasKindVarChain :: Int -> Type -> Maybe [Name]
    hasKindVarChain kindArrows :: Int
    kindArrows t :: Type
    t =
      let uk :: NonEmpty Type
    uk = Type -> NonEmpty Type
    uncurryKind (Type -> Type
    tyKind Type
    t)
      in if (NonEmpty Type -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length NonEmpty Type
    uk Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    kindArrows) Bool -> Bool -> Bool
    && (Type -> Bool) -> NonEmpty Type -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    isStarOrVar NonEmpty Type
    uk
            then [Name] -> Maybe [Name]
    forall a. a -> Maybe a
    Just ((Type -> [Name]) -> NonEmpty Type -> [Name]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Type -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables NonEmpty Type
    uk)
            else Maybe [Name]
    forall a. Maybe a
    Nothing

    -- | If a Type is a SigT, returns its kind signature. Otherwise, return *.
    tyKind :: Type -> Kind
    tyKind :: Type -> Type
    tyKind (SigT _ k :: Type
    k) = Type
    k
    tyKind _          = Type
    starK

    -- | A mapping of type variable Names to their show function Names. For example, in a
    -- TextShow2 declaration, a TyVarMap might look like (a ~> sp1, b ~> sp2), where
    -- a and b are the last two type variables of the datatype, and sp1 and sp2 are the two
    -- functions which show their respective type variables.
    type TyVarMap = Map Name (Name, Name)

    -- | Checks if a 'Name' represents a tuple type constructor (other than '()')
    isNonUnitTuple :: Name -> Bool
    isNonUnitTuple :: Name -> Bool
    isNonUnitTuple = String -> Bool
    isTupleString (String -> Bool) -> (Name -> String) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase

    -- | Parenthesize an infix constructor name if it is being applied as a prefix
    -- function (e.g., data Amp a = (:&) a a)
    parenInfixConName :: Name -> ShowS
    parenInfixConName :: Name -> String -> String
    parenInfixConName conName :: Name
    conName =
        let conNameBase :: String
    conNameBase = Name -> String
    nameBase Name
    conName
         in Bool -> (String -> String) -> String -> String
    showParen (String -> Bool
    isInfixDataCon String
    conNameBase) ((String -> String) -> String -> String)
    -> (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    showString String
    conNameBase

    -- | Applies a typeclass constraint to a type.
    applyClass :: Name -> Name -> Pred
    #if MIN_VERSION_template_haskell(2,10,0)
    applyClass :: Name -> Name -> Type
    applyClass con :: Name
    con t :: Name
    t = Type -> Type -> Type
    AppT (Name -> Type
    ConT Name
    con) (Name -> Type
    VarT Name
    t)
    #else
    applyClass con t = ClassP con [VarT t]
    #endif

    -- | Checks to see if the last types in a data family instance can be safely eta-
    -- reduced (i.e., dropped), given the other types. This checks for three conditions:
    --
    -- (1) All of the dropped types are type variables
    -- (2) All of the dropped types are distinct
    -- (3) None of the remaining types mention any of the dropped types
    canEtaReduce :: [Type] -> [Type] -> Bool
    canEtaReduce :: Cxt -> Cxt -> Bool
    canEtaReduce remaining :: Cxt
    remaining dropped :: Cxt
    dropped =
           (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    isTyVar Cxt
    dropped
        Bool -> Bool -> Bool
    && [Name] -> Bool
    forall a. Ord a => [a] -> Bool
    allDistinct [Name]
    droppedNames -- Make sure not to pass something of type [Type], since Type
                                    -- didn't have an Ord instance until template-haskell-2.10.0.0
        Bool -> Bool -> Bool
    && Bool -> Bool
    not ((Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    droppedNames) Cxt
    remaining)
      where
        droppedNames :: [Name]
        droppedNames :: [Name]
    droppedNames = (Type -> Name) -> Cxt -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Name
    varTToName Cxt
    dropped

    -- | Extract Just the Name from a type variable. If the argument Type is not a
    -- type variable, return Nothing.
    varTToName_maybe :: Type -> Maybe Name
    varTToName_maybe :: Type -> Maybe Name
    varTToName_maybe (VarT n :: Name
    n)   = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
    varTToName_maybe (SigT t :: Type
    t _) = Type -> Maybe Name
    varTToName_maybe Type
    t
    varTToName_maybe _          = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Extract the Name from a type variable. If the argument Type is not a
    -- type variable, throw an error.
    varTToName :: Type -> Name
    varTToName :: Type -> Name
    varTToName = Name -> Maybe Name -> Name
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Name
    forall a. HasCallStack => String -> a
    error "Not a type variable!") (Maybe Name -> Name) -> (Type -> Maybe Name) -> Type -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Maybe Name
    varTToName_maybe

    -- | Peel off a kind signature from a Type (if it has one).
    unSigT :: Type -> Type
    unSigT :: Type -> Type
    unSigT (SigT t :: Type
    t _) = Type
    t
    unSigT t :: Type
    t          = Type
    t

    -- | Is the given type a variable?
    isTyVar :: Type -> Bool
    isTyVar :: Type -> Bool
    isTyVar (VarT _)   = Bool
    True
    isTyVar (SigT t :: Type
    t _) = Type -> Bool
    isTyVar Type
    t
    isTyVar _          = Bool
    False

    -- | Is the given type a type family constructor (and not a data family constructor)?
    isTyFamily :: Type -> Q Bool
    isTyFamily :: Type -> Q Bool
    isTyFamily (ConT n :: Name
    n) = do
        Info
    info <- Name -> Q Info
    reify Name
    n
        Bool -> Q Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Q Bool) -> Bool -> Q Bool
    forall a b. (a -> b) -> a -> b
    $ case Info
    info of
    #if MIN_VERSION_template_haskell(2,11,0)
             FamilyI OpenTypeFamilyD{} _       -> Bool
    True
    #else
             FamilyI (FamilyD TypeFam _ _ _) _ -> True
    #endif
    #if MIN_VERSION_template_haskell(2,9,0)
             FamilyI ClosedTypeFamilyD{} _     -> Bool
    True
    #endif
             _ -> Bool
    False
    isTyFamily _ = Bool -> Q Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- | Are all of the items in a list (which have an ordering) distinct?
    --
    -- This uses Set (as opposed to nub) for better asymptotic time complexity.
    allDistinct :: Ord a => [a] -> Bool
    allDistinct :: [a] -> Bool
    allDistinct = Set a -> [a] -> Bool
    forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' Set a
    forall a. Set a
    Set.empty
      where
        allDistinct' :: Ord a => Set a -> [a] -> Bool
        allDistinct' :: Set a -> [a] -> Bool
    allDistinct' uniqs :: Set a
    uniqs (x :: a
    x:xs :: [a]
    xs)
            | a
    x a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set a
    uniqs = Bool
    False
            | Bool
    otherwise            = Set a -> [a] -> Bool
    forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' (a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    Set.insert a
    x Set a
    uniqs) [a]
    xs
        allDistinct' _ _           = Bool
    True

    -- | Does the given type mention any of the Names in the list?
    mentionsName :: Type -> [Name] -> Bool
    mentionsName :: Type -> [Name] -> Bool
    mentionsName = Type -> [Name] -> Bool
    go
      where
        go :: Type -> [Name] -> Bool
        go :: Type -> [Name] -> Bool
    go (AppT t1 :: Type
    t1 t2 :: Type
    t2) names :: [Name]
    names = Type -> [Name] -> Bool
    go Type
    t1 [Name]
    names Bool -> Bool -> Bool
    || Type -> [Name] -> Bool
    go Type
    t2 [Name]
    names
        go (SigT t :: Type
    t _k :: Type
    _k)  names :: [Name]
    names = Type -> [Name] -> Bool
    go Type
    t [Name]
    names
    #if MIN_VERSION_template_haskell(2,8,0)
                                  Bool -> Bool -> Bool
    || Type -> [Name] -> Bool
    go Type
    _k [Name]
    names
    #endif
        go (VarT n :: Name
    n)     names :: [Name]
    names = Name
    n Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    names
        go _            _     = Bool
    False

    -- | Does an instance predicate mention any of the Names in the list?
    predMentionsName :: Pred -> [Name] -> Bool
    #if MIN_VERSION_template_haskell(2,10,0)
    predMentionsName :: Type -> [Name] -> Bool
    predMentionsName = Type -> [Name] -> Bool
    mentionsName
    #else
    predMentionsName (ClassP n tys) names = n `elem` names || any (`mentionsName` names) tys
    predMentionsName (EqualP t1 t2) names = mentionsName t1 names || mentionsName t2 names
    #endif

    -- | Construct a type via curried application.
    applyTy :: Type -> [Type] -> Type
    applyTy :: Type -> Cxt -> Type
    applyTy = (Type -> Type -> Type) -> Type -> Cxt -> Type
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Type -> Type -> Type
    AppT

    -- | Fully applies a type constructor to its type variables.
    applyTyCon :: Name -> [Type] -> Type
    applyTyCon :: Name -> Cxt -> Type
    applyTyCon = Type -> Cxt -> Type
    applyTy (Type -> Cxt -> Type) -> (Name -> Type) -> Name -> Cxt -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Type
    ConT

    -- | Split an applied type into its individual components. For example, this:
    --
    -- @
    -- Either Int Char
    -- @
    --
    -- would split to this:
    --
    -- @
    -- [Either, Int, Char]
    -- @
    unapplyTy :: Type -> NonEmpty Type
    unapplyTy :: Type -> NonEmpty Type
    unapplyTy = NonEmpty Type -> NonEmpty Type
    forall a. NonEmpty a -> NonEmpty a
    NE.reverse (NonEmpty Type -> NonEmpty Type)
    -> (Type -> NonEmpty Type) -> Type -> NonEmpty Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> NonEmpty Type
    go
      where
        go :: Type -> NonEmpty Type
        go :: Type -> NonEmpty Type
    go (AppT t1 :: Type
    t1 t2 :: Type
    t2)    = Type
    t2 Type -> NonEmpty Type -> NonEmpty Type
    forall a. a -> NonEmpty a -> NonEmpty a
    <| Type -> NonEmpty Type
    go Type
    t1
        go (SigT t :: Type
    t _)      = Type -> NonEmpty Type
    go Type
    t
        go (ForallT _ _ t :: Type
    t) = Type -> NonEmpty Type
    go Type
    t
        go t :: Type
    t               = Type
    t Type -> Cxt -> NonEmpty Type
    forall a. a -> [a] -> NonEmpty a
    :| []

    -- | Split a type signature by the arrows on its spine. For example, this:
    --
    -- @
    -- (Int -> String) -> Char -> ()
    -- @
    --
    -- would split to this:
    --
    -- @
    -- [Int -> String, Char, ()]
    -- @
    uncurryTy :: Type -> NonEmpty Type
    uncurryTy :: Type -> NonEmpty Type
    uncurryTy (AppT (AppT ArrowT t1 :: Type
    t1) t2 :: Type
    t2) = Type
    t1 Type -> NonEmpty Type -> NonEmpty Type
    forall a. a -> NonEmpty a -> NonEmpty a
    <| Type -> NonEmpty Type
    uncurryTy Type
    t2
    uncurryTy (SigT t :: Type
    t _)                 = Type -> NonEmpty Type
    uncurryTy Type
    t
    uncurryTy (ForallT _ _ t :: Type
    t)            = Type -> NonEmpty Type
    uncurryTy Type
    t
    uncurryTy t :: Type
    t                          = Type
    t Type -> Cxt -> NonEmpty Type
    forall a. a -> [a] -> NonEmpty a
    :| []

    -- | Like uncurryType, except on a kind level.
    uncurryKind :: Kind -> NonEmpty Kind
    #if MIN_VERSION_template_haskell(2,8,0)
    uncurryKind :: Type -> NonEmpty Type
    uncurryKind = Type -> NonEmpty Type
    uncurryTy
    #else
    uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2
    uncurryKind k              = k :| []
    #endif

    createKindChain :: Int -> Kind
    createKindChain :: Int -> Type
    createKindChain = Type -> Int -> Type
    go Type
    starK
      where
        go :: Kind -> Int -> Kind
        go :: Type -> Int -> Type
    go k :: Type
    k !Int
    0 = Type
    k
        go k :: Type
    k !Int
    n = Type -> Int -> Type
    go (Type -> Type -> Type
    arrowKCompat Type
    starK Type
    k) (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)

    isNullaryCon :: ConstructorInfo -> Bool
    isNullaryCon :: ConstructorInfo -> Bool
    isNullaryCon (ConstructorInfo { constructorFields :: ConstructorInfo -> Cxt
    constructorFields = [] }) = Bool
    True
    isNullaryCon _                                            = Bool
    False

    interleave :: [a] -> [a] -> [a]
    interleave :: [a] -> [a] -> [a]
    interleave (a1 :: a
    a1:a1s :: [a]
    a1s) (a2 :: a
    a2:a2s :: [a]
    a2s) = a
    a1a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :a
    a2a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    interleave [a]
    a1s [a]
    a2s
    interleave _        _        = []

    {-
    Note [Matching functions with GADT type variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When deriving TextShow2, there is a tricky corner case to consider:

      data Both a b where
        BothCon :: x -> x -> Both x x

    Which show functions should be applied to which arguments of BothCon? We have a
    choice, since both the function of type (Int -> a -> Builder) and of type
    (Int -> b -> Builder) can be applied to either argument. In such a scenario, the
    second show function takes precedence over the first show function, so the
    derived TextShow2 instance would be:

      instance TextShow Both where
        liftShowsPrec2 sp1 sp2 p (BothCon x1 x2) =
          showbParen (p > appPrec) $
            "BothCon " <> sp2 appPrec1 x1 <> showbSpace <> sp2 appPrec1 x2

    This is not an arbitrary choice, as this definition ensures that
    liftShowsPrec2 showsPrec = liftShowsPrec for a derived TextShow1 instance for
    Both.
    -}