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

    Exports functions to mechanically derive 'Show', 'Show1', and 'Show2' instances.

    Note: this is an internal module, and as such, the API presented here is not
    guaranteed to be stable, even between minor releases of this library.
    -}
    module Text.Show.Deriving.Internal (
          -- * 'Show'
          deriveShow
        , deriveShowOptions
        , makeShowsPrec
        , makeShowsPrecOptions
        , makeShow
        , makeShowOptions
        , makeShowList
        , makeShowListOptions
          -- * 'Show1'
        , deriveShow1
        , deriveShow1Options
    #if defined(NEW_FUNCTOR_CLASSES)
        , makeLiftShowsPrec
        , makeLiftShowsPrecOptions
        , makeLiftShowList
        , makeLiftShowListOptions
    #endif
        , makeShowsPrec1
        , makeShowsPrec1Options
    #if defined(NEW_FUNCTOR_CLASSES)
          -- * 'Show2'
        , deriveShow2
        , deriveShow2Options
        , makeLiftShowsPrec2
        , makeLiftShowsPrec2Options
        , makeLiftShowList2
        , makeLiftShowList2Options
        , makeShowsPrec2
        , makeShowsPrec2Options
    #endif
          -- * 'ShowOptions'
        , ShowOptions(..)
        , defaultShowOptions
        , legacyShowOptions
        ) where

    import           Data.Deriving.Internal
    import           Data.List
    import qualified Data.Map as Map
    import           Data.Map (Map)
    import           Data.Maybe (fromMaybe)

    import           GHC.Show (appPrec, appPrec1)

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

    -- | Options that further configure how the functions in "Text.Show.Deriving"
    -- should behave.
    data ShowOptions = ShowOptions
      { ghc8ShowBehavior :: Bool
        -- ^ If 'True', the derived 'Show', 'Show1', or 'Show2' instance will not
        --   surround the output of showing fields of unlifted types with parentheses,
        --   and the output will be suffixed with hash signs (@#@).
      , showEmptyCaseBehavior :: Bool
        -- ^ If 'True', derived instances for empty data types (i.e., ones with
        --   no data constructors) will use the @EmptyCase@ language extension.
        --   If 'False', derived instances will simply use 'seq' instead.
        --   (This has no effect on GHCs before 7.8, since @EmptyCase@ is only
        --   available in 7.8 or later.)
      } deriving (Eq, Ord, Read, Show)

    -- | 'ShowOptions' that match the behavior of the most recent GHC release.
    defaultShowOptions :: ShowOptions
    defaultShowOptions =
      ShowOptions { ghc8ShowBehavior      = True
                  , showEmptyCaseBehavior = False
                  }

    -- | 'ShowOptions' that match the behavior of the installed version of GHC.
    legacyShowOptions :: ShowOptions
    legacyShowOptions = ShowOptions
      { ghc8ShowBehavior =
    #if __GLASGOW_HASKELL__ >= 711
                           True
    #else
                           False
    #endif
      , showEmptyCaseBehavior = False
      }

    -- | Generates a 'Show' instance declaration for the given data type or data
    -- family instance.
    deriveShow :: Name -> Q [Dec]
    deriveShow = deriveShowOptions defaultShowOptions

    -- | Like 'deriveShow', but takes a 'ShowOptions' argument.
    deriveShowOptions :: ShowOptions -> Name -> Q [Dec]
    deriveShowOptions = deriveShowClass Show

    -- | Generates a lambda expression which behaves like 'show' (without
    -- requiring a 'Show' instance).
    makeShow :: Name -> Q Exp
    makeShow = makeShowOptions defaultShowOptions

    -- | Like 'makeShow', but takes a 'ShowOptions' argument.
    makeShowOptions :: ShowOptions -> Name -> Q Exp
    makeShowOptions opts name = do
        x <- newName "x"
        lam1E (varP x) $ makeShowsPrecOptions opts name
                         `appE` integerE 0
                         `appE` varE x
                         `appE` stringE ""

    -- | Generates a lambda expression which behaves like 'showsPrec' (without
    -- requiring a 'Show' instance).
    makeShowsPrec :: Name -> Q Exp
    makeShowsPrec = makeShowsPrecOptions defaultShowOptions

    -- | Like 'makeShowsPrec', but takes a 'ShowOptions' argument.
    makeShowsPrecOptions :: ShowOptions -> Name -> Q Exp
    makeShowsPrecOptions = makeShowsPrecClass Show

    -- | Generates a lambda expression which behaves like 'showList' (without
    -- requiring a 'Show' instance).
    makeShowList :: Name -> Q Exp
    makeShowList = makeShowListOptions defaultShowOptions

    -- | Like 'makeShowList', but takes a 'ShowOptions' argument.
    makeShowListOptions :: ShowOptions -> Name -> Q Exp
    makeShowListOptions opts name =
        varE showListWithValName `appE` (makeShowsPrecOptions opts name `appE` integerE 0)

    -- | Generates a 'Show1' instance declaration for the given data type or data
    -- family instance.
    deriveShow1 :: Name -> Q [Dec]
    deriveShow1 = deriveShow1Options defaultShowOptions

    -- | Like 'deriveShow1', but takes a 'ShowOptions' argument.
    deriveShow1Options :: ShowOptions -> Name -> Q [Dec]
    deriveShow1Options = deriveShowClass Show1

    -- | Generates a lambda expression which behaves like 'showsPrec1' (without
    -- requiring a 'Show1' instance).
    makeShowsPrec1 :: Name -> Q Exp
    makeShowsPrec1 = makeShowsPrec1Options defaultShowOptions

    #if defined(NEW_FUNCTOR_CLASSES)
    -- | Generates a lambda expression which behaves like 'liftShowsPrec' (without
    -- requiring a 'Show1' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowsPrec :: Name -> Q Exp
    makeLiftShowsPrec = makeLiftShowsPrecOptions defaultShowOptions

    -- | Like 'makeLiftShowsPrec', but takes a 'ShowOptions' argument.
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowsPrecOptions :: ShowOptions -> Name -> Q Exp
    makeLiftShowsPrecOptions = makeShowsPrecClass Show1

    -- | Generates a lambda expression which behaves like 'liftShowList' (without
    -- requiring a 'Show' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowList :: Name -> Q Exp
    makeLiftShowList = makeLiftShowListOptions defaultShowOptions

    -- | Like 'makeLiftShowList', but takes a 'ShowOptions' argument.
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowListOptions :: ShowOptions -> Name -> Q Exp
    makeLiftShowListOptions opts name = do
        sp' <- newName "sp'"
        sl' <- newName "sl'"
        lamE [varP sp', varP sl'] $ varE showListWithValName `appE`
            (makeLiftShowsPrecOptions opts name `appE` varE sp' `appE` varE sl'
                                                `appE` integerE 0)

    -- | Like 'makeShowsPrec1', but takes a 'ShowOptions' argument.
    makeShowsPrec1Options :: ShowOptions -> Name -> Q Exp
    makeShowsPrec1Options opts name = makeLiftShowsPrecOptions opts name
                               `appE` varE showsPrecValName
                               `appE` varE showListValName
    #else
    -- | Like 'makeShowsPrec1', but takes a 'ShowOptions' argument.
    makeShowsPrec1Options :: ShowOptions -> Name -> Q Exp
    makeShowsPrec1Options = makeShowsPrecClass Show1
    #endif

    #if defined(NEW_FUNCTOR_CLASSES)
    -- | Generates a 'Show2' instance declaration for the given data type or data
    -- family instance.
    --
    -- This function is not available with @transformers-0.4@.
    deriveShow2 :: Name -> Q [Dec]
    deriveShow2 = deriveShow2Options defaultShowOptions

    -- | Like 'deriveShow2', but takes a 'ShowOptions' argument.
    --
    -- This function is not available with @transformers-0.4@.
    deriveShow2Options :: ShowOptions -> Name -> Q [Dec]
    deriveShow2Options = deriveShowClass Show2

    -- | Generates a lambda expression which behaves like 'liftShowsPrec2' (without
    -- requiring a 'Show2' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowsPrec2 :: Name -> Q Exp
    makeLiftShowsPrec2 = makeLiftShowsPrec2Options defaultShowOptions

    -- | Like 'makeLiftShowsPrec2', but takes a 'ShowOptions' argument.
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowsPrec2Options :: ShowOptions -> Name -> Q Exp
    makeLiftShowsPrec2Options = makeShowsPrecClass Show2

    -- | Generates a lambda expression which behaves like 'liftShowList2' (without
    -- requiring a 'Show' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowList2 :: Name -> Q Exp
    makeLiftShowList2 = makeLiftShowList2Options defaultShowOptions

    -- | Like 'makeLiftShowList2', but takes a 'ShowOptions' argument.
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftShowList2Options :: ShowOptions -> Name -> Q Exp
    makeLiftShowList2Options opts name = do
        sp1' <- newName "sp1'"
        sl1' <- newName "sl1'"
        sp2' <- newName "sp2'"
        sl2' <- newName "sl2'"
        lamE [varP sp1', varP sl1', varP sp2', varP sl2'] $
            varE showListWithValName `appE`
                (makeLiftShowsPrec2Options opts name `appE` varE sp1' `appE` varE sl1'
                                                     `appE` varE sp2' `appE` varE sl2'
                                                     `appE` integerE 0)

    -- | Generates a lambda expression which behaves like 'showsPrec2' (without
    -- requiring a 'Show2' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeShowsPrec2 :: Name -> Q Exp
    makeShowsPrec2 = makeShowsPrec2Options defaultShowOptions

    -- | Like 'makeShowsPrec2', but takes a 'ShowOptions' argument.
    --
    -- This function is not available with @transformers-0.4@.
    makeShowsPrec2Options :: ShowOptions -> Name -> Q Exp
    makeShowsPrec2Options opts name = makeLiftShowsPrec2Options opts name
                               `appE` varE showsPrecValName
                               `appE` varE showListValName
                               `appE` varE showsPrecValName
                               `appE` varE showListValName
    #endif

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

    -- | Derive a Show(1)(2) instance declaration (depending on the ShowClass
    -- argument's value).
    deriveShowClass :: ShowClass -> ShowOptions -> Name -> Q [Dec]
    deriveShowClass sClass opts name = do
      info <- reifyDatatype name
      case info of
        DatatypeInfo { datatypeContext   = ctxt
                     , datatypeName      = parentName
    #if MIN_VERSION_th_abstraction(0,3,0)
                     , datatypeInstTypes = instTypes
    #else
                     , datatypeVars      = instTypes
    #endif
                     , datatypeVariant   = variant
                     , datatypeCons      = cons
                     } -> do
          (instanceCxt, instanceType)
              <- buildTypeInstance sClass parentName ctxt instTypes variant
          (:[]) `fmap` instanceD (return instanceCxt)
                                 (return instanceType)
                                 (showsPrecDecs sClass opts instTypes cons)

    -- | Generates a declaration defining the primary function corresponding to a
    -- particular class (showsPrec for Show, liftShowsPrec for Show1, and
    -- liftShowsPrec2 for Show2).
    showsPrecDecs :: ShowClass -> ShowOptions -> [Type] -> [ConstructorInfo] -> [Q Dec]
    showsPrecDecs sClass opts instTypes cons =
        [ funD (showsPrecName sClass)
               [ clause []
                        (normalB $ makeShowForCons sClass opts instTypes cons)
                        []
               ]
        ]

    -- | Generates a lambda expression which behaves like showsPrec (for Show),
    -- liftShowsPrec (for Show1), or liftShowsPrec2 (for Show2).
    makeShowsPrecClass :: ShowClass -> ShowOptions -> Name -> Q Exp
    makeShowsPrecClass sClass opts name = do
      info <- reifyDatatype name
      case info of
        DatatypeInfo { datatypeContext   = ctxt
                     , datatypeName      = parentName
    #if MIN_VERSION_th_abstraction(0,3,0)
                     , datatypeInstTypes = instTypes
    #else
                     , datatypeVars      = instTypes
    #endif
                     , datatypeVariant   = variant
                     , datatypeCons      = cons
                     } -> do
          -- We force buildTypeInstance here since it performs some checks for whether
          -- or not the provided datatype can actually have showsPrec/liftShowsPrec/etc.
          -- implemented for it, and produces errors if it can't.
          buildTypeInstance sClass parentName ctxt instTypes variant
            >> makeShowForCons sClass opts instTypes cons

    -- | Generates a lambda expression for showsPrec/liftShowsPrec/etc. for the
    -- given constructors. All constructors must be from the same type.
    makeShowForCons :: ShowClass -> ShowOptions -> [Type] -> [ConstructorInfo] -> Q Exp
    makeShowForCons sClass opts instTypes cons = do
        p     <- newName "p"
        value <- newName "value"
        sps   <- newNameList "sp" $ arity sClass
        sls   <- newNameList "sl" $ arity sClass
        let spls       = zip sps sls
            _spsAndSls = interleave sps sls
            lastTyVars = map varTToName $ drop (length instTypes - fromEnum sClass) instTypes
            splMap     = Map.fromList $ zipWith (\x (y, z) -> (x, TwoNames y z)) lastTyVars spls

            makeFun
              | null cons && showEmptyCaseBehavior opts && ghc7'8OrLater
              = caseE (varE value) []

              | null cons
              = appE (varE seqValName) (varE value) `appE`
                appE (varE errorValName)
                     (stringE $ "Void " ++ nameBase (showsPrecName sClass))

              | otherwise
              = caseE (varE value)
                      (map (makeShowForCon p sClass opts splMap) cons)

        lamE (map varP $
    #if defined(NEW_FUNCTOR_CLASSES)
                         _spsAndSls ++
    #endif
                         [p, value])
            . appsE
            $ [ varE $ showsPrecConstName sClass
              , makeFun
              ]
    #if defined(NEW_FUNCTOR_CLASSES)
                ++ map varE _spsAndSls
    #endif
                ++ [varE p, varE value]

    -- | Generates a lambda expression for showsPrec/liftShowsPrec/etc. for a
    -- single constructor.
    makeShowForCon :: Name
                   -> ShowClass
                   -> ShowOptions
                   -> TyVarMap2
                   -> ConstructorInfo
                   -> Q Match
    makeShowForCon _ _ _ _
      (ConstructorInfo { constructorName = conName, constructorFields = [] }) =
        match
          (conP conName [])
          (normalB $ varE showStringValName `appE` stringE (parenInfixConName conName ""))
          []
    makeShowForCon p sClass opts tvMap
      (ConstructorInfo { constructorName    = conName
                       , constructorVariant = NormalConstructor
                       , constructorFields  = [argTy] }) = do
        argTy' <- resolveTypeSynonyms argTy
        arg <- newName "arg"

        let showArg  = makeShowForArg appPrec1 sClass opts conName tvMap argTy' arg
            namedArg = infixApp (varE showStringValName `appE` stringE (parenInfixConName conName " "))
                                (varE composeValName)
                                showArg

        match
          (conP conName [varP arg])
          (normalB $ varE showParenValName
                      `appE` infixApp (varE p) (varE gtValName) (integerE appPrec)
                      `appE` namedArg)
          []
    makeShowForCon p sClass opts tvMap
      (ConstructorInfo { constructorName    = conName
                       , constructorVariant = NormalConstructor
                       , constructorFields  = argTys }) = do
        argTys' <- mapM resolveTypeSynonyms argTys
        args <- newNameList "arg" $ length argTys'

        if isNonUnitTuple conName
           then do
             let showArgs       = zipWith (makeShowForArg 0 sClass opts conName tvMap) argTys' args
                 parenCommaArgs = (varE showCharValName `appE` charE '(')
                                  : intersperse (varE showCharValName `appE` charE ',') showArgs
                 mappendArgs    = foldr (`infixApp` varE composeValName)
                                        (varE showCharValName `appE` charE ')')
                                        parenCommaArgs

             match (conP conName $ map varP args)
                   (normalB mappendArgs)
                   []
           else do
             let showArgs    = zipWith (makeShowForArg appPrec1 sClass opts conName tvMap) argTys' args
                 mappendArgs = foldr1 (\v q -> infixApp v (varE composeValName)
                                                        (infixApp (varE showSpaceValName)
                                                                (varE composeValName)
                                                                q)) showArgs
                 namedArgs   = infixApp (varE showStringValName `appE` stringE (parenInfixConName conName " "))
                                        (varE composeValName)
                                        mappendArgs

             match (conP conName $ map varP args)
                   (normalB $ varE showParenValName
                                `appE` infixApp (varE p) (varE gtValName) (integerE appPrec)
                                `appE` namedArgs)
                   []
    makeShowForCon p sClass opts tvMap
      (ConstructorInfo { constructorName    = conName
                       , constructorVariant = RecordConstructor argNames
                       , constructorFields  = argTys }) = do
        argTys' <- mapM resolveTypeSynonyms argTys
        args <- newNameList "arg" $ length argTys'

        let showArgs       = concatMap (\(argName, argTy, arg)
                                          -> let argNameBase = nameBase argName
                                                 infixRec    = showParen (isSym argNameBase)
                                                                         (showString argNameBase) ""
                                             in [ varE showStringValName `appE` stringE (infixRec ++ " = ")
                                                , makeShowForArg 0 sClass opts conName tvMap argTy arg
                                                , varE showCommaSpaceValName
                                                ]
                                       )
                                       (zip3 argNames argTys' args)
            braceCommaArgs = (varE showCharValName `appE` charE '{') : take (length showArgs - 1) showArgs
            mappendArgs    = foldr (`infixApp` varE composeValName)
                                   (varE showCharValName `appE` charE '}')
                                   braceCommaArgs
            namedArgs      = infixApp (varE showStringValName `appE` stringE (parenInfixConName conName " "))
                                      (varE composeValName)
                                      mappendArgs

        match
          (conP conName $ map varP args)
          (normalB $ varE showParenValName
                       `appE` infixApp (varE p) (varE gtValName) (integerE appPrec)
                       `appE` namedArgs)
          []
    makeShowForCon p sClass opts tvMap
      (ConstructorInfo { constructorName    = conName
                       , constructorVariant = InfixConstructor
                       , constructorFields  = argTys }) = do
        [alTy, arTy] <- mapM resolveTypeSynonyms argTys
        al   <- newName "argL"
        ar   <- newName "argR"
        fi <- fromMaybe defaultFixity `fmap` reifyFixityCompat conName
        let conPrec  = case fi of Fixity prec _ -> prec
            opName   = nameBase conName
            infixOpE = appE (varE showStringValName) . stringE $
                         if isInfixDataCon opName
                            then " "  ++ opName ++ " "
                            else " `" ++ opName ++ "` "

        match
          (infixP (varP al) conName (varP ar))
          (normalB $ (varE showParenValName `appE` infixApp (varE p) (varE gtValName) (integerE conPrec))
                       `appE` (infixApp (makeShowForArg (conPrec + 1) sClass opts conName tvMap alTy al)
                                        (varE composeValName)
                                        (infixApp infixOpE
                                                  (varE composeValName)
                                                  (makeShowForArg (conPrec + 1) sClass opts conName tvMap arTy ar)))
          )
          []

    -- | Generates a lambda expression for showsPrec/liftShowsPrec/etc. for an
    -- argument of a constructor.
    makeShowForArg :: Int
                   -> ShowClass
                   -> ShowOptions
                   -> Name
                   -> TyVarMap2
                   -> Type
                   -> Name
                   -> Q Exp
    makeShowForArg p _ opts _ _ (ConT tyName) tyExpName =
        showE
      where
        tyVarE :: Q Exp
        tyVarE = varE tyExpName

        showE :: Q Exp
        showE =
          case Map.lookup tyName primShowTbl of
            Just ps -> showPrimE ps
            Nothing -> varE showsPrecValName `appE` integerE p `appE` tyVarE

        showPrimE :: PrimShow -> Q Exp
        showPrimE PrimShow{primShowBoxer, primShowPostfixMod, primShowConv}
            -- 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.
          | ghc8ShowBehavior opts
          = primShowConv $ infixApp (primE 0) (varE composeValName) primShowPostfixMod
          | otherwise
          = primE p
          where
            primE :: Int -> Q Exp
            primE prec = varE showsPrecValName `appE` integerE prec
                                               `appE` primShowBoxer tyVarE
    makeShowForArg p sClass _ conName tvMap ty tyExpName =
        makeShowForType sClass conName tvMap False ty `appE` integerE p `appE` varE tyExpName

    -- | Generates a lambda expression for showsPrec/liftShowsPrec/etc. for a
    -- specific type. The generated expression depends on the number of type variables.
    --
    -- 1. If the type is of kind * (T), apply showsPrec.
    -- 2. If the type is of kind * -> * (T a), apply liftShowsPrec $(makeShowForType a)
    -- 3. If the type is of kind * -> * -> * (T a b), apply
    --    liftShowsPrec2 $(makeShowForType a) $(makeShowForType b)
    makeShowForType :: ShowClass
                    -> Name
                    -> TyVarMap2
                    -> Bool -- ^ True if we are using the function of type ([a] -> ShowS),
                            --   False if we are using the function of type (Int -> a -> ShowS).
                    -> Type
                    -> Q Exp
    #if defined(NEW_FUNCTOR_CLASSES)
    makeShowForType _ _ tvMap sl (VarT tyName) =
        varE $ case Map.lookup tyName tvMap of
          Just (TwoNames spExp slExp) -> if sl then slExp else spExp
          Nothing -> if sl then showListValName else showsPrecValName
    #else
    makeShowForType _ _ _ _ VarT{} = varE showsPrecValName
    #endif
    makeShowForType sClass conName tvMap sl (SigT ty _)      = makeShowForType sClass conName tvMap sl ty
    makeShowForType sClass conName tvMap sl (ForallT _ _ ty) = makeShowForType sClass conName tvMap sl ty
    #if defined(NEW_FUNCTOR_CLASSES)
    makeShowForType sClass conName tvMap sl ty = do
        let tyCon :: Type
            tyArgs :: [Type]
            tyCon:tyArgs = unapplyTy ty

            numLastArgs :: Int
            numLastArgs = min (arity sClass) (length tyArgs)

            lhsArgs, rhsArgs :: [Type]
            (lhsArgs, rhsArgs) = splitAt (length tyArgs - numLastArgs) tyArgs

            tyVarNames :: [Name]
            tyVarNames = Map.keys tvMap

        itf <- isTyFamily tyCon
        if any (`mentionsName` tyVarNames) lhsArgs
              || itf && any (`mentionsName` tyVarNames) tyArgs
           then outOfPlaceTyVarError sClass conName
           else if any (`mentionsName` tyVarNames) rhsArgs
                   then appsE $ [ varE . showsPrecOrListName sl $ toEnum numLastArgs]
                                ++ zipWith (makeShowForType sClass conName tvMap)
                                           (cycle [False,True])
                                           (interleave rhsArgs rhsArgs)
                   else varE $ if sl then showListValName else showsPrecValName
    #else
    makeShowForType sClass conName tvMap _ ty = do
      let varNames = Map.keys tvMap

      p'     <- newName "p'"
      value' <- newName "value'"
      case varNames of
        [] -> varE showsPrecValName
        varName:_ ->
          if mentionsName ty varNames
             then lamE [varP p', varP value'] $ varE showsPrec1ValName
                    `appE` varE p'
                    `appE` (makeFmapApplyNeg sClass conName ty varName `appE` varE value')
             else varE showsPrecValName
    #endif

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

    -- | A representation of which @Show@ variant is being derived.
    data ShowClass = Show
                   | Show1
    #if defined(NEW_FUNCTOR_CLASSES)
                   | Show2
    #endif
      deriving (Bounded, Enum)

    instance ClassRep ShowClass where
        arity = fromEnum

        allowExQuant _ = True

        fullClassName Show  = showTypeName
        fullClassName Show1 = show1TypeName
    #if defined(NEW_FUNCTOR_CLASSES)
        fullClassName Show2 = show2TypeName
    #endif

        classConstraint sClass i
          | sMin <= i && i <= sMax = Just $ fullClassName (toEnum i :: ShowClass)
          | otherwise              = Nothing
          where
            sMin, sMax :: Int
            sMin = fromEnum (minBound :: ShowClass)
            sMax = fromEnum sClass

    showsPrecConstName :: ShowClass -> Name
    showsPrecConstName Show  = showsPrecConstValName
    #if defined(NEW_FUNCTOR_CLASSES)
    showsPrecConstName Show1 = liftShowsPrecConstValName
    showsPrecConstName Show2 = liftShowsPrec2ConstValName
    #else
    showsPrecConstName Show1 = showsPrec1ConstValName
    #endif

    showsPrecName :: ShowClass -> Name
    showsPrecName Show  = showsPrecValName
    #if defined(NEW_FUNCTOR_CLASSES)
    showsPrecName Show1 = liftShowsPrecValName
    showsPrecName Show2 = liftShowsPrec2ValName
    #else
    showsPrecName Show1 = showsPrec1ValName
    #endif

    #if defined(NEW_FUNCTOR_CLASSES)
    showListName :: ShowClass -> Name
    showListName Show  = showListValName
    showListName Show1 = liftShowListValName
    showListName Show2 = liftShowList2ValName

    showsPrecOrListName :: Bool -- ^ showListName if True, showsPrecName if False
                        -> ShowClass
                        -> Name
    showsPrecOrListName False = showsPrecName
    showsPrecOrListName True  = showListName
    #endif

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

    -- | 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 conName =
        let conNameBase = nameBase conName
         in showParen (isInfixDataCon conNameBase) $ showString conNameBase

    charE :: Char -> Q Exp
    charE = litE . charL

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

    primShowTbl :: Map Name PrimShow
    primShowTbl = Map.fromList
        [ (charHashTypeName,   PrimShow
                                 { primShowBoxer      = appE (conE cHashDataName)
                                 , primShowPostfixMod = oneHashE
                                 , primShowConv       = id
                                 })
        , (doubleHashTypeName, PrimShow
                                 { primShowBoxer      = appE (conE dHashDataName)
                                 , primShowPostfixMod = twoHashE
                                 , primShowConv       = id
                                 })
        , (floatHashTypeName,  PrimShow
                                 { primShowBoxer      = appE (conE fHashDataName)
                                 , primShowPostfixMod = oneHashE
                                 , primShowConv       = id
                                 })
        , (intHashTypeName,    PrimShow
                                 { primShowBoxer      = appE (conE iHashDataName)
                                 , primShowPostfixMod = oneHashE
                                 , primShowConv       = id
                                 })
        , (wordHashTypeName,   PrimShow
                                 { primShowBoxer      = appE (conE wHashDataName)
                                 , primShowPostfixMod = twoHashE
                                 , primShowConv       = id
                                 })
    #if MIN_VERSION_base(4,13,0)
        , (int8HashTypeName,   PrimShow
                                 { primShowBoxer      = appE (conE iHashDataName) . appE (varE extendInt8HashValName)
                                 , primShowPostfixMod = oneHashE
                                 , primShowConv       = mkNarrowE "narrowInt8#"
                                 })
        , (int16HashTypeName,  PrimShow
                                 { primShowBoxer      = appE (conE iHashDataName) . appE (varE extendInt16HashValName)
                                 , primShowPostfixMod = oneHashE
                                 , primShowConv       = mkNarrowE "narrowInt16#"
                                 })
        , (word8HashTypeName,  PrimShow
                                 { primShowBoxer      = appE (conE wHashDataName) . appE (varE extendWord8HashValName)
                                 , primShowPostfixMod = twoHashE
                                 , primShowConv       = mkNarrowE "narrowWord8#"
                                 })
        , (word16HashTypeName, PrimShow
                                 { primShowBoxer      = appE (conE wHashDataName) . appE (varE extendWord16HashValName)
                                 , primShowPostfixMod = twoHashE
                                 , primShowConv       = mkNarrowE "narrowWord16#"
                                 })
    #endif
        ]

    #if MIN_VERSION_base(4,13,0)
    mkNarrowE :: String -> Q Exp -> Q Exp
    mkNarrowE narrowStr e =
      foldr (`infixApp` varE composeValName)
            (varE showCharValName `appE` charE ')')
            [ varE showStringValName `appE` stringE ('(':narrowStr ++ " ")
            , e
            ]
    #endif

    oneHashE, twoHashE :: Q Exp
    oneHashE = varE showCharValName `appE` charE '#'
    twoHashE = varE showStringValName `appE` stringE "##"