    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Singletons.Deriving.Show
    -- Copyright   :  (C) 2017 Ryan Scott
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  Ryan Scott
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Implements deriving of Show instances
    --
    ----------------------------------------------------------------------------
    {-# LANGUAGE ScopedTypeVariables #-}
    module Data.Singletons.Deriving.Show (
        mkShowInstance
      , ShowMode(..)
      , mkShowSingContext
      ) where

    import Language.Haskell.TH.Syntax hiding (showName)
    import Language.Haskell.TH.Desugar
    import Data.Singletons.Names
    import Data.Singletons.Util
    import Data.Singletons.Syntax
    import Data.Singletons.Deriving.Infer
    import Data.Singletons.Deriving.Util
    import Data.Maybe (fromMaybe)
    import GHC.Lexeme (startsConSym, startsVarSym)
    import GHC.Show (appPrec, appPrec1)

    mkShowInstance :: DsMonad q => ShowMode -> DerivDesc q
    mkShowInstance :: ShowMode -> DerivDesc q
    mkShowInstance mode :: ShowMode
    mode mb_ctxt :: Maybe DCxt
    mb_ctxt ty :: DType
    ty (DataDecl _ _ cons :: [DCon]
    cons) = do
      [DClause]
    clauses <- ShowMode -> [DCon] -> q [DClause]
    forall (q :: * -> *).
    DsMonad q =>
    ShowMode -> [DCon] -> q [DClause]
    mk_showsPrec ShowMode
    mode [DCon]
    cons
      DCxt
    constraints <- Maybe DCxt -> DType -> DType -> [DCon] -> q DCxt
    forall (q :: * -> *).
    DsMonad q =>
    Maybe DCxt -> DType -> DType -> [DCon] -> q DCxt
    inferConstraintsDef ((DCxt -> DCxt) -> Maybe DCxt -> Maybe DCxt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ShowMode -> DCxt -> DCxt
    mkShowSingContext ShowMode
    mode) Maybe DCxt
    mb_ctxt)
                                         (Name -> DType
    DConT (ShowMode -> Name
    mk_Show_name ShowMode
    mode))
                                         DType
    ty [DCon]
    cons
      DType
    ty' <- ShowMode -> DType -> q DType
    forall (q :: * -> *). Quasi q => ShowMode -> DType -> q DType
    mk_Show_inst_ty ShowMode
    mode DType
    ty
      InstDecl Unannotated -> q (InstDecl Unannotated)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InstDecl Unannotated -> q (InstDecl Unannotated))
    -> InstDecl Unannotated -> q (InstDecl Unannotated)
    forall a b. (a -> b) -> a -> b
    $ InstDecl :: forall (ann :: AnnotationFlag).
    DCxt
    -> Name
    -> DCxt
    -> OMap Name DType
    -> [(Name, LetDecRHS ann)]
    -> InstDecl ann
    InstDecl { id_cxt :: DCxt
    id_cxt = DCxt
    constraints
                        , id_name :: Name
    id_name = Name
    showName
                        , id_arg_tys :: DCxt
    id_arg_tys = [DType
    ty']
                        , id_sigs :: OMap Name DType
    id_sigs  = OMap Name DType
    forall a. Monoid a => a
    mempty
                        , id_meths :: [(Name, LetDecRHS Unannotated)]
    id_meths = [ (Name
    showsPrecName, [DClause] -> LetDecRHS Unannotated
    UFunction [DClause]
    clauses) ] }

    mk_showsPrec :: DsMonad q => ShowMode -> [DCon] -> q [DClause]
    mk_showsPrec :: ShowMode -> [DCon] -> q [DClause]
    mk_showsPrec mode :: ShowMode
    mode cons :: [DCon]
    cons = do
        Name
    p <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "p" -- The precedence argument (not always used)
        if [DCon] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DCon]
    cons
           then do Name
    v <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "v"
                   [DClause] -> q [DClause]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [[DPat] -> DExp -> DClause
    DClause [DPat
    DWildP, Name -> DPat
    DVarP Name
    v] (DExp -> [DMatch] -> DExp
    DCaseE (Name -> DExp
    DVarE Name
    v) [])]
           else (DCon -> q DClause) -> [DCon] -> q [DClause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (ShowMode -> Name -> DCon -> q DClause
    forall (q :: * -> *).
    DsMonad q =>
    ShowMode -> Name -> DCon -> q DClause
    mk_showsPrec_clause ShowMode
    mode Name
    p) [DCon]
    cons

    mk_showsPrec_clause :: forall q. DsMonad q
                        => ShowMode -> Name -> DCon
                        -> q DClause
    mk_showsPrec_clause :: ShowMode -> Name -> DCon -> q DClause
    mk_showsPrec_clause mode :: ShowMode
    mode p :: Name
    p (DCon _ _ con_name :: Name
    con_name con_fields :: DConFields
    con_fields _) = DConFields -> q DClause
    go DConFields
    con_fields
      where
        con_name' :: Name
        con_name' :: Name
    con_name' = case ShowMode
    mode of
                      ForPromotion  -> Name
    con_name
                      ForShowSing{} -> Name -> Name
    singDataConName Name
    con_name

        go :: DConFields -> q DClause

        -- No fields: print just the constructor name, with no parentheses
        go :: DConFields -> q DClause
    go (DNormalC _ []) = DClause -> q DClause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DClause -> q DClause) -> DClause -> q DClause
    forall a b. (a -> b) -> a -> b
    $
          [DPat] -> DExp -> DClause
    DClause [DPat
    DWildP, Name -> [DPat] -> DPat
    DConP Name
    con_name' []] (DExp -> DClause) -> DExp -> DClause
    forall a b. (a -> b) -> a -> b
    $
            Name -> DExp
    DVarE Name
    showStringName DExp -> DExp -> DExp
    `DAppE` String -> DExp
    dStringE (Name -> ShowS
    parenInfixConName Name
    con_name' "")

        -- Infix constructors have special Show treatment.
        go (DNormalC True tys :: [DBangType]
    tys@[_, _])
            -- Although the (:) constructor is infix, its singled counterpart SCons
            -- is not, which matters if we're deriving a ShowSing instance.
            -- Unless we remove this special case (see #234), we will simply
            -- shunt it along as if we were dealing with a prefix constructor.
          | ForShowSing{} <- ShowMode
    mode
          , Name
    con_name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    consName
          = DConFields -> q DClause
    go (Bool -> [DBangType] -> DConFields
    DNormalC Bool
    False [DBangType]
    tys)

          | Bool
    otherwise
          = do Name
    argL   <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "argL"
               Name
    argR   <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "argR"
               Name
    argTyL <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "argTyL"
               Name
    argTyR <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "argTyR"
               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)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe Fixity)
    reifyFixityWithLocals Name
    con_name'
               let con_prec :: Int
    con_prec = case Fixity
    fi of Fixity prec :: Int
    prec _ -> Int
    prec
                   op_name :: String
    op_name  = Name -> String
    nameBase Name
    con_name'
                   infixOpE :: DExp
    infixOpE = DExp -> DExp -> DExp
    DAppE (Name -> DExp
    DVarE Name
    showStringName) (DExp -> DExp) -> (String -> DExp) -> String -> DExp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> DExp
    dStringE (String -> DExp) -> String -> DExp
    forall a b. (a -> b) -> a -> b
    $
                                if String -> Bool
    isInfixDataCon String
    op_name
                                   then " "  String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    op_name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " "
                                   -- Make sure to handle infix data constructors
                                   -- like (Int `Foo` Int)
                                   else " `" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    op_name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "` "
               DClause -> q DClause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DClause -> q DClause) -> DClause -> q DClause
    forall a b. (a -> b) -> a -> b
    $ [DPat] -> DExp -> DClause
    DClause [ Name -> DPat
    DVarP Name
    p
                                , Name -> [DPat] -> DPat
    DConP Name
    con_name' ([DPat] -> DPat) -> [DPat] -> DPat
    forall a b. (a -> b) -> a -> b
    $
                                  (Name -> Name -> DPat) -> [Name] -> [Name] -> [DPat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (ShowMode -> Name -> Name -> DPat
    mk_Show_arg_pat ShowMode
    mode) [Name
    argL, Name
    argR] [Name
    argTyL, Name
    argTyR]
                                ] (DExp -> DClause) -> DExp -> DClause
    forall a b. (a -> b) -> a -> b
    $
                 ShowMode -> [Name] -> DExp -> DExp
    mk_Show_rhs_sig ShowMode
    mode [Name
    argTyL, Name
    argTyR] (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $
                 (Name -> DExp
    DVarE Name
    showParenName DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    gtName DExp -> DExp -> DExp
    `DAppE` Name -> DExp
    DVarE Name
    p
                                                            DExp -> DExp -> DExp
    `DAppE` Int -> DExp
    dIntegerE Int
    con_prec))
                   DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    composeName
                              DExp -> DExp -> DExp
    `DAppE` Int -> Name -> DExp
    showsPrecE (Int
    con_prec Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) Name
    argL
                              DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    composeName
                                         DExp -> DExp -> DExp
    `DAppE` DExp
    infixOpE
                                         DExp -> DExp -> DExp
    `DAppE` Int -> Name -> DExp
    showsPrecE (Int
    con_prec Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) Name
    argR))

        go (DNormalC _ tys :: [DBangType]
    tys) = do
          [Name]
    args   <- (DBangType -> q Name) -> [DBangType] -> q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (q Name -> DBangType -> q Name
    forall a b. a -> b -> a
    const (q Name -> DBangType -> q Name) -> q Name -> DBangType -> q Name
    forall a b. (a -> b) -> a -> b
    $ String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "arg")   [DBangType]
    tys
          [Name]
    argTys <- (DBangType -> q Name) -> [DBangType] -> q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (q Name -> DBangType -> q Name
    forall a b. a -> b -> a
    const (q Name -> DBangType -> q Name) -> q Name -> DBangType -> q Name
    forall a b. (a -> b) -> a -> b
    $ String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "argTy") [DBangType]
    tys
          let show_args :: [DExp]
    show_args     = (Name -> DExp) -> [Name] -> [DExp]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Name -> DExp
    showsPrecE Int
    appPrec1) [Name]
    args
              composed_args :: DExp
    composed_args = (DExp -> DExp -> DExp) -> [DExp] -> DExp
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\v :: DExp
    v q :: DExp
    q -> Name -> DExp
    DVarE Name
    composeName
                                               DExp -> DExp -> DExp
    `DAppE` DExp
    v
                                               DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    composeName
                                                         DExp -> DExp -> DExp
    `DAppE` Name -> DExp
    DVarE Name
    showSpaceName
                                                         DExp -> DExp -> DExp
    `DAppE` DExp
    q)) [DExp]
    show_args
              named_args :: DExp
    named_args = Name -> DExp
    DVarE Name
    composeName
                             DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    showStringName
                                       DExp -> DExp -> DExp
    `DAppE` String -> DExp
    dStringE (Name -> ShowS
    parenInfixConName Name
    con_name' " "))
                             DExp -> DExp -> DExp
    `DAppE` DExp
    composed_args
          DClause -> q DClause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DClause -> q DClause) -> DClause -> q DClause
    forall a b. (a -> b) -> a -> b
    $ [DPat] -> DExp -> DClause
    DClause [ Name -> DPat
    DVarP Name
    p
                           , Name -> [DPat] -> DPat
    DConP Name
    con_name' ([DPat] -> DPat) -> [DPat] -> DPat
    forall a b. (a -> b) -> a -> b
    $
                             (Name -> Name -> DPat) -> [Name] -> [Name] -> [DPat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (ShowMode -> Name -> Name -> DPat
    mk_Show_arg_pat ShowMode
    mode) [Name]
    args [Name]
    argTys
                           ] (DExp -> DClause) -> DExp -> DClause
    forall a b. (a -> b) -> a -> b
    $
            ShowMode -> [Name] -> DExp -> DExp
    mk_Show_rhs_sig ShowMode
    mode [Name]
    argTys (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $
            Name -> DExp
    DVarE Name
    showParenName
              DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    gtName DExp -> DExp -> DExp
    `DAppE` Name -> DExp
    DVarE Name
    p DExp -> DExp -> DExp
    `DAppE` Int -> DExp
    dIntegerE Int
    appPrec)
              DExp -> DExp -> DExp
    `DAppE` DExp
    named_args

        -- We show a record constructor with no fields the same way we'd show a
        -- normal constructor with no fields.
        go (DRecC []) = DConFields -> q DClause
    go (Bool -> [DBangType] -> DConFields
    DNormalC Bool
    False [])

        go (DRecC tys :: [DVarBangType]
    tys) = do
          [Name]
    args   <- (DVarBangType -> q Name) -> [DVarBangType] -> q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (q Name -> DVarBangType -> q Name
    forall a b. a -> b -> a
    const (q Name -> DVarBangType -> q Name)
    -> q Name -> DVarBangType -> q Name
    forall a b. (a -> b) -> a -> b
    $ String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "arg")   [DVarBangType]
    tys
          [Name]
    argTys <- (DVarBangType -> q Name) -> [DVarBangType] -> q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (q Name -> DVarBangType -> q Name
    forall a b. a -> b -> a
    const (q Name -> DVarBangType -> q Name)
    -> q Name -> DVarBangType -> q Name
    forall a b. (a -> b) -> a -> b
    $ String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    newUniqueName "argTy") [DVarBangType]
    tys
          let show_args :: [DExp]
    show_args =
                ((DVarBangType, Name) -> [DExp])
    -> [(DVarBangType, Name)] -> [DExp]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\((arg_name :: Name
    arg_name, _, _), arg :: Name
    arg) ->
                            let arg_name' :: Name
    arg_name'    = case ShowMode
    mode of
                                                 ForPromotion  -> Name
    arg_name
                                                 ForShowSing{} -> Name -> Name
    singValName Name
    arg_name
                                arg_nameBase :: String
    arg_nameBase = Name -> String
    nameBase Name
    arg_name'
                                infix_rec :: String
    infix_rec    = Bool -> ShowS -> ShowS
    showParen (String -> Bool
    isSym String
    arg_nameBase)
                                                         (String -> ShowS
    showString String
    arg_nameBase) ""
                            in [ Name -> DExp
    DVarE Name
    showStringName DExp -> DExp -> DExp
    `DAppE` String -> DExp
    dStringE (String
    infix_rec String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " = ")
                               , Int -> Name -> DExp
    showsPrecE 0 Name
    arg
                               , Name -> DExp
    DVarE Name
    showCommaSpaceName
                               ])
                          ([DVarBangType] -> [Name] -> [(DVarBangType, Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [DVarBangType]
    tys [Name]
    args)
              brace_comma_args :: [DExp]
    brace_comma_args =   (Name -> DExp
    DVarE Name
    showCharName DExp -> DExp -> DExp
    `DAppE` ShowMode -> Char -> DExp
    dCharE ShowMode
    mode '{')
                                 DExp -> [DExp] -> [DExp]
    forall a. a -> [a] -> [a]
    : Int -> [DExp] -> [DExp]
    forall a. Int -> [a] -> [a]
    take ([DExp] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DExp]
    show_args Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) [DExp]
    show_args
              composed_args :: DExp
    composed_args = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\x :: DExp
    x y :: DExp
    y -> Name -> DExp
    DVarE Name
    composeName DExp -> DExp -> DExp
    `DAppE` DExp
    x DExp -> DExp -> DExp
    `DAppE` DExp
    y)
                                    (Name -> DExp
    DVarE Name
    showCharName DExp -> DExp -> DExp
    `DAppE` ShowMode -> Char -> DExp
    dCharE ShowMode
    mode '}')
                                    [DExp]
    brace_comma_args
              named_args :: DExp
    named_args = Name -> DExp
    DVarE Name
    composeName
                             DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    showStringName
                                       DExp -> DExp -> DExp
    `DAppE` String -> DExp
    dStringE (Name -> ShowS
    parenInfixConName Name
    con_name' " "))
                             DExp -> DExp -> DExp
    `DAppE` DExp
    composed_args
          DClause -> q DClause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DClause -> q DClause) -> DClause -> q DClause
    forall a b. (a -> b) -> a -> b
    $ [DPat] -> DExp -> DClause
    DClause [ Name -> DPat
    DVarP Name
    p
                           , Name -> [DPat] -> DPat
    DConP Name
    con_name' ([DPat] -> DPat) -> [DPat] -> DPat
    forall a b. (a -> b) -> a -> b
    $
                             (Name -> Name -> DPat) -> [Name] -> [Name] -> [DPat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (ShowMode -> Name -> Name -> DPat
    mk_Show_arg_pat ShowMode
    mode) [Name]
    args [Name]
    argTys
                           ] (DExp -> DClause) -> DExp -> DClause
    forall a b. (a -> b) -> a -> b
    $
            ShowMode -> [Name] -> DExp -> DExp
    mk_Show_rhs_sig ShowMode
    mode [Name]
    argTys (DExp -> DExp) -> DExp -> DExp
    forall a b. (a -> b) -> a -> b
    $
            Name -> DExp
    DVarE Name
    showParenName
              DExp -> DExp -> DExp
    `DAppE` (Name -> DExp
    DVarE Name
    gtName DExp -> DExp -> DExp
    `DAppE` Name -> DExp
    DVarE Name
    p DExp -> DExp -> DExp
    `DAppE` Int -> DExp
    dIntegerE Int
    appPrec)
              DExp -> DExp -> DExp
    `DAppE` DExp
    named_args

    -- | 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 -> ShowS
    parenInfixConName conName :: Name
    conName =
        let conNameBase :: String
    conNameBase = Name -> String
    nameBase Name
    conName
        in Bool -> ShowS -> ShowS
    showParen (String -> Bool
    isInfixDataCon String
    conNameBase) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString String
    conNameBase

    showsPrecE :: Int -> Name -> DExp
    showsPrecE :: Int -> Name -> DExp
    showsPrecE prec :: Int
    prec n :: Name
    n = Name -> DExp
    DVarE Name
    showsPrecName DExp -> DExp -> DExp
    `DAppE` Int -> DExp
    dIntegerE Int
    prec DExp -> DExp -> DExp
    `DAppE` Name -> DExp
    DVarE Name
    n

    dCharE :: ShowMode -> Char -> DExp
    dCharE :: ShowMode -> Char -> DExp
    dCharE mode :: ShowMode
    mode = Lit -> DExp
    DLitE (Lit -> DExp) -> (Char -> Lit) -> Char -> DExp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Lit
    to_lit
      where
        to_lit :: Char -> Lit
        to_lit :: Char -> Lit
    to_lit c :: Char
    c = case ShowMode
    mode of
                     ForPromotion  -> String -> Lit
    StringL [Char
    c] -- There aren't type-level characters yet,
                                                  -- so fake it with a string
                     ForShowSing{} -> Char -> Lit
    CharL Char
    c

    dStringE :: String -> DExp
    dStringE :: String -> DExp
    dStringE = Lit -> DExp
    DLitE (Lit -> DExp) -> (String -> Lit) -> String -> DExp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Lit
    StringL

    dIntegerE :: Int -> DExp
    dIntegerE :: Int -> DExp
    dIntegerE = Lit -> DExp
    DLitE (Lit -> DExp) -> (Int -> Lit) -> Int -> DExp
    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

    isSym :: String -> Bool
    isSym :: String -> Bool
    isSym ""      = Bool
    False
    isSym (c :: Char
    c : _) = Char -> Bool
    startsVarSym Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    startsConSym Char
    c

    -----
    -- ShowMode
    -----

    -- | Is a 'Show' instance being generated to be promoted/singled, or is it
    -- being generated to create a 'Show' instance for a singleton type?
    data ShowMode = ForPromotion      -- ^ For promotion/singling
                  | ForShowSing Name  -- ^ For a 'Show' instance.
                                      --   Bundles the 'Name' of the data type.

    -- | Turn a context like @('Show' a, 'Show' b)@ into @('ShowSing' a, 'ShowSing' b)@.
    -- This is necessary for 'Show' instances for singleton types.
    mkShowSingContext :: ShowMode -> DCxt -> DCxt
    mkShowSingContext :: ShowMode -> DCxt -> DCxt
    mkShowSingContext ForPromotion  = DCxt -> DCxt
    forall a. a -> a
    id
    mkShowSingContext ForShowSing{} = (DType -> DType) -> DCxt -> DCxt
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> DType
    show_to_SingShow
      where
        show_to_SingShow :: DPred -> DPred
        show_to_SingShow :: DType -> DType
    show_to_SingShow = (Name -> Name) -> DType -> DType
    modifyConNameDType ((Name -> Name) -> DType -> DType)
    -> (Name -> Name) -> DType -> DType
    forall a b. (a -> b) -> a -> b
    $ \n :: Name
    n ->
                             if Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    showName
                                then Name
    showSingName
                                else Name
    n

    mk_Show_name :: ShowMode -> Name
    mk_Show_name :: ShowMode -> Name
    mk_Show_name ForPromotion  = Name
    showName
    mk_Show_name ForShowSing{} = Name
    showSingName

    -- If we're creating a 'Show' instance for a singleon type, decorate the type
    -- appropriately (e.g., turn @Maybe a@ into @SMaybe (z :: Maybe a)@).
    -- Otherwise, return the type (@Maybe a@) unchanged.
    mk_Show_inst_ty :: Quasi q => ShowMode -> DType -> q DType
    mk_Show_inst_ty :: ShowMode -> DType -> q DType
    mk_Show_inst_ty ForPromotion           ty :: DType
    ty = DType -> q DType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure DType
    ty
    mk_Show_inst_ty (ForShowSing ty_tycon :: Name
    ty_tycon) ty :: DType
    ty = do
      Name
    z <- String -> q Name
    forall (q :: * -> *). Quasi q => String -> q Name
    qNewName "z"
      DType -> q DType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (DType -> q DType) -> DType -> q DType
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT (Name -> Name
    singTyConName Name
    ty_tycon) DType -> DType -> DType
    `DAppT` (Name -> DType
    DVarT Name
    z DType -> DType -> DType
    `DSigT` DType
    ty)

    -- If we're creating a 'Show' instance for a singleton type, create a pattern
    -- of the form @(sx :: Sing x)@. Otherwise, simply return the pattern @sx@.
    mk_Show_arg_pat :: ShowMode -> Name -> Name -> DPat
    mk_Show_arg_pat :: ShowMode -> Name -> Name -> DPat
    mk_Show_arg_pat ForPromotion  arg :: Name
    arg _      = Name -> DPat
    DVarP Name
    arg
    mk_Show_arg_pat ForShowSing{} arg :: Name
    arg arg_ty :: Name
    arg_ty =
      DPat -> DType -> DPat
    DSigP (Name -> DPat
    DVarP Name
    arg) (Name -> DType
    DConT Name
    singFamilyName DType -> DType -> DType
    `DAppT` Name -> DType
    DVarT Name
    arg_ty)

    -- If we're creating a 'Show' instance for a singleton type, decorate the
    -- expression with an explicit signature of the form
    -- @e :: (ShowSing' a_1, ..., ShowSing' a_n) => ShowS@. Otherwise, return
    -- the expression (@e@) unchanged.
    mk_Show_rhs_sig :: ShowMode -> [Name] -> DExp -> DExp
    mk_Show_rhs_sig :: ShowMode -> [Name] -> DExp -> DExp
    mk_Show_rhs_sig ForPromotion  _            e :: DExp
    e = DExp
    e
    mk_Show_rhs_sig ForShowSing{} arg_ty_names :: [Name]
    arg_ty_names e :: DExp
    e =
      DExp
    e DExp -> DType -> DExp
    `DSigE` [DTyVarBndr] -> DCxt -> DType -> DType
    DForallT [] ((Name -> DType) -> [Name] -> DCxt
    forall a b. (a -> b) -> [a] -> [b]
    map (DType -> DType -> DType
    DAppT (Name -> DType
    DConT Name
    showSing'Name) (DType -> DType) -> (Name -> DType) -> Name -> DType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> DType
    DVarT) [Name]
    arg_ty_names)
                            (Name -> DType
    DConT Name
    showSName)