    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic DsMessage

    module GHC.HsToCore.Errors.Ppr where

    import GHC.Core.Predicate (isEvVar)
    import GHC.Core.Type
    import GHC.Driver.Flags
    import GHC.Hs
    import GHC.HsToCore.Errors.Types
    import GHC.Prelude
    import GHC.Types.Basic (pprRuleName)
    import GHC.Types.Error
    import GHC.Types.Error.Codes
    import GHC.Types.Id (idType)
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Utils.Outputable
    import qualified GHC.LanguageExtensions as LangExt
    import GHC.HsToCore.Pmc.Ppr

    instance Diagnostic DsMessage where
      type DiagnosticOpts DsMessage = NoDiagnosticOpts
      diagnosticMessage :: DiagnosticOpts DsMessage -> DsMessage -> DecoratedSDoc
    diagnosticMessage DiagnosticOpts DsMessage
    opts = \case
        DsUnknownMessage (UnknownDiagnostic DiagnosticOpts DsMessage -> DiagnosticOpts a
    f a
    m)
          -> DiagnosticOpts a -> a -> DecoratedSDoc
    forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
    diagnosticMessage (DiagnosticOpts DsMessage -> DiagnosticOpts a
    f DiagnosticOpts DsMessage
    opts) a
    m
        DsMessage
    DsEmptyEnumeration
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Enumeration is empty"
        DsIdentitiesFound Id
    conv_fn Type
    type_of_conv
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Call of" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    conv_fn SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    type_of_conv
                    , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "can probably be omitted"
                    ]
        DsOverflowedLiterals Integer
    i Name
    tc Maybe (MinBound, MaxBound)
    bounds NegLiteralExtEnabled
    _possiblyUsingNegativeLiterals
          -> let msg :: SDoc
    msg = case Maybe (MinBound, MaxBound)
    bounds of
                   Maybe (MinBound, MaxBound)
    Nothing
                     -> [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Literal" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    i
                           SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "is negative but" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    tc
                           SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "only supports positive numbers"
                             ]
                   Just (MinBound Integer
    minB, MaxBound Integer
    maxB)
                     -> [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Literal" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    i
                                     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "is out of the" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    tc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "range"
                                     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    minB SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ".." SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Integer -> SDoc
    forall doc. IsLine doc => Integer -> doc
    integer Integer
    maxB
                             ]
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated SDoc
    msg
        DsRedundantBangPatterns HsMatchContextRn
    ctx SDoc
    q
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ HsMatchContextRn -> SDoc -> String -> SDoc
    pprEqn HsMatchContextRn
    ctx SDoc
    q String
    "has redundant bang"
        DsOverlappingPatterns HsMatchContextRn
    ctx SDoc
    q
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ HsMatchContextRn -> SDoc -> String -> SDoc
    pprEqn HsMatchContextRn
    ctx SDoc
    q String
    "is redundant"
        DsInaccessibleRhs HsMatchContextRn
    ctx SDoc
    q
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ HsMatchContextRn -> SDoc -> String -> SDoc
    pprEqn HsMatchContextRn
    ctx SDoc
    q String
    "has inaccessible right hand side"
        DsMaxPmCheckModelsReached Int
    limit
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
               [ SDoc -> Int -> SDoc -> SDoc
    hang
                   (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pattern match checker ran into -fmax-pmcheck-models="
                     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    limit
                     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    " limit, so")
                   Int
    2
                   (  SDoc
    bullet SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Redundant clauses might not be reported at all"
                   SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc
    bullet SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Redundant clauses might be reported as inaccessible"
                   SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc
    bullet SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Patterns reported as unmatched might actually be matched")
               ]
        DsNonExhaustivePatterns HsMatchContextRn
    kind ExhaustivityCheckType
    _flag Int
    maxPatterns [Id]
    vars [Nabla]
    nablas
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               Bool
    -> HsMatchContextRn -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc
    pprContext Bool
    False HsMatchContextRn
    kind (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "are non-exhaustive") (((SDoc -> SDoc) -> SDoc) -> SDoc)
    -> ((SDoc -> SDoc) -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \SDoc -> SDoc
    _ ->
                 case [Id]
    vars of -- See #11245
                      [] -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Guards do not cover entire pattern space"
                      [Id]
    _  -> let us :: [SDoc]
    us = (Nabla -> SDoc) -> [Nabla] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Nabla
    nabla -> Nabla -> [Id] -> SDoc
    pprUncovered Nabla
    nabla [Id]
    vars) [Nabla]
    nablas
                                pp_tys :: SDoc
    pp_tys = [Type] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList ([Type] -> SDoc) -> [Type] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (Id -> Type) -> [Id] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    idType [Id]
    vars
                            in  SDoc -> Int -> SDoc -> SDoc
    hang
                                  (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Patterns of type" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    pp_tys SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "not matched:")
                                  Int
    4
                                  ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (Int -> [SDoc] -> [SDoc]
    forall a. Int -> [a] -> [a]
    take Int
    maxPatterns [SDoc]
    us) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Int -> [SDoc] -> SDoc
    forall a. Int -> [a] -> SDoc
    dots Int
    maxPatterns [SDoc]
    us)
        DsTopLevelBindsNotAllowed BindsType
    bindsType HsBindLR GhcTc GhcTc
    bind
          -> let desc :: String
    desc = case BindsType
    bindsType of
                   BindsType
    UnliftedTypeBinds -> String
    "bindings for unlifted types"
                   BindsType
    StrictBinds       -> String
    "strict bindings"
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                  SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Top-level" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    desc SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "aren't allowed:") Int
    2 (HsBindLR GhcTc GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsBindLR GhcTc GhcTc
    bind)
        DsUselessSpecialiseForClassMethodSelector Id
    poly_id
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Ignoring useless SPECIALISE pragma for class selector:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    poly_id)
        DsUselessSpecialiseForNoInlineFunction Id
    poly_id
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Ignoring useless SPECIALISE pragma for NOINLINE function:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    poly_id)
        DsMessage
    DsMultiplicityCoercionsNotSupported
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "GHC bug #19517: GHC currently does not support programs using GADTs or type families to witness equality of multiplicities"
        DsOrphanRule CoreRule
    rule
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Orphan rule:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreRule -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreRule
    rule
        DsRuleLhsTooComplicated CoreExpr
    orig_lhs CoreExpr
    lhs2
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "RULE left-hand side too complicated to desugar")
                          Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Optimised lhs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    lhs2
                                  , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Orig lhs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    orig_lhs])
        DsRuleIgnoredDueToConstructor DataCon
    con
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
               [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "A constructor," SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    con SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
                   String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    ", appears as outermost match in RULE lhs."
               , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "This rule will be ignored." ]
        DsRuleBindersNotBound [Id]
    unbound [Id]
    orig_bndrs CoreExpr
    orig_lhs CoreExpr
    lhs2
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((Id -> SDoc) -> [Id] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> SDoc
    pp_dead [Id]
    unbound)
             where
               pp_dead :: Id -> SDoc
    pp_dead Id
    bndr =
                 SDoc -> Int -> SDoc -> SDoc
    hang ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Forall'd" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Id -> SDoc
    pp_bndr Id
    bndr
                           , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "is not bound in RULE lhs"])
                    Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Orig bndrs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    orig_bndrs
                            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Orig lhs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    orig_lhs
                            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "optimised lhs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    lhs2 ])

               pp_bndr :: Id -> SDoc
    pp_bndr Id
    b
                | Id -> Bool
    isTyVar Id
    b = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "type variable" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    b)
                | Id -> Bool
    isEvVar Id
    b = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "constraint"    SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Id -> Type
    varType Id
    b))
                | Bool
    otherwise = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "variable"      SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    b)
        DsLazyPatCantBindVarsOfUnliftedType [Id]
    unlifted_bndrs
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
              SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "A lazy (~) pattern cannot bind variables of unlifted type." SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Unlifted variables:")
                 Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((Id -> SDoc) -> [Id] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Id
    id -> Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    id SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Id -> Type
    idType Id
    id)) [Id]
    unlifted_bndrs))
        DsNotYetHandledByTH ThRejectionReason
    reason
          -> case ThRejectionReason
    reason of
                 ThAmbiguousRecordUpdates HsRecUpdField GhcRn GhcRn
    fld
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Ambiguous record updates" (HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsRecUpdField GhcRn GhcRn
    HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    fld)
                 ThAbstractClosedTypeFamily LFamilyDecl GhcRn
    decl
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "abstract closed type family" (GenLocated SrcSpanAnnA (FamilyDecl GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LFamilyDecl GhcRn
    GenLocated SrcSpanAnnA (FamilyDecl GhcRn)
    decl)
                 ThForeignLabel CLabelString
    cls
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Foreign label" (SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    doubleQuotes (CLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CLabelString
    cls))
                 ThForeignExport LForeignDecl GhcRn
    decl
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Foreign export" (GenLocated SrcSpanAnnA (ForeignDecl GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LForeignDecl GhcRn
    GenLocated SrcSpanAnnA (ForeignDecl GhcRn)
    decl)
                 ThRejectionReason
    ThMinimalPragmas
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "MINIMAL pragmas" SDoc
    forall doc. IsOutput doc => doc
    empty
                 ThRejectionReason
    ThSCCPragmas
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "SCC pragmas" SDoc
    forall doc. IsOutput doc => doc
    empty
                 ThRejectionReason
    ThNoUserInline
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "NOUSERINLINE" SDoc
    forall doc. IsOutput doc => doc
    empty
                 ThExoticFormOfType HsType GhcRn
    ty
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Exotic form of type" (HsType GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsType GhcRn
    ty)
                 ThAmbiguousRecordSelectors HsExpr GhcRn
    e
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Ambiguous record selectors" (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    e)
                 ThMonadComprehensionSyntax HsExpr GhcRn
    e
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "monad comprehension and [: :]" (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    e)
                 ThCostCentres HsExpr GhcRn
    e
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Cost centres" (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    e)
                 ThExpressionForm HsExpr GhcRn
    e
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Expression form" (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    e)
                 ThExoticStatement [Stmt GhcRn (LHsExpr GhcRn)]
    other
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Exotic statement" ([Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Stmt GhcRn (LHsExpr GhcRn)]
    [Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    other)
                 ThExoticLiteral HsLit GhcRn
    lit
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Exotic literal" (HsLit GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsLit GhcRn
    lit)
                 ThExoticPattern Pat GhcRn
    pat
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Exotic pattern" (Pat GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcRn
    pat)
                 ThGuardedLambdas Match GhcRn (LHsExpr GhcRn)
    m
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Guarded lambdas" (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    Match (GhcPass idR) body -> SDoc
    pprMatch Match GhcRn (LHsExpr GhcRn)
    Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    m)
                 ThNegativeOverloadedPatterns Pat GhcRn
    pat
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Negative overloaded patterns" (Pat GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcRn
    pat)
                 ThRejectionReason
    ThHaddockDocumentation
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Haddock documentation" SDoc
    forall doc. IsOutput doc => doc
    empty
                 ThWarningAndDeprecationPragmas [LIdP GhcRn]
    decl
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "WARNING and DEPRECATION pragmas" (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                        String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pragma for declaration of" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [GenLocated SrcSpanAnnN Name] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [LIdP GhcRn]
    [GenLocated SrcSpanAnnN Name]
    decl
                 ThRejectionReason
    ThSplicesWithinDeclBrackets
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Splices within declaration brackets" SDoc
    forall doc. IsOutput doc => doc
    empty
                 ThRejectionReason
    ThNonLinearDataCon
                   -> String -> SDoc -> DecoratedSDoc
    mkMsg String
    "Non-linear fields in data constructors" SDoc
    forall doc. IsOutput doc => doc
    empty
             where
               mkMsg :: String -> SDoc -> DecoratedSDoc
    mkMsg String
    what SDoc
    doc =
                 SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                   SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    what SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "not (yet) handled by Template Haskell") Int
    2 SDoc
    doc
        DsAggregatedViewExpressions [[LHsExpr GhcTc]]
    views
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [SDoc]
    msgs)
             where
               msgs :: [SDoc]
    msgs = ([GenLocated SrcSpanAnnA (HsExpr GhcTc)] -> SDoc)
    -> [[GenLocated SrcSpanAnnA (HsExpr GhcTc)]] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\[GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    g -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Putting these view expressions into the same case:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ([GenLocated SrcSpanAnnA (HsExpr GhcTc)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    g)) [[LHsExpr GhcTc]]
    [[GenLocated SrcSpanAnnA (HsExpr GhcTc)]]
    views
        DsUnbangedStrictPatterns HsBindLR GhcTc GhcTc
    bind
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pattern bindings containing unlifted types should use" SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                     String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "an outermost bang pattern:")
                  Int
    2 (HsBindLR GhcTc GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsBindLR GhcTc GhcTc
    bind)
        DsCannotMixPolyAndUnliftedBindings HsBindLR GhcTc GhcTc
    bind
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "You can't mix polymorphic and unlifted bindings:")
                  Int
    2 (HsBindLR GhcTc GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsBindLR GhcTc GhcTc
    bind)
        DsWrongDoBind LHsExpr GhcTc
    _rhs Type
    elt_ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ Type -> SDoc
    badMonadBind Type
    elt_ty
        DsUnusedDoBind LHsExpr GhcTc
    _rhs Type
    elt_ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ Type -> SDoc
    badMonadBind Type
    elt_ty
        DsRecBindsNotAllowedForUnliftedTys [LHsBindLR GhcTc GhcTc]
    binds
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Recursive bindings for unlifted types aren't allowed:")
                  Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> SDoc)
    -> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [LHsBindLR GhcTc GhcTc]
    [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
    binds))
        DsRuleMightInlineFirst CLabelString
    rule_name Id
    lhs_id Activation
    _
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CLabelString -> SDoc
    pprRuleName CLabelString
    rule_name
                              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "may never fire")
                           Int
    2 (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "because" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    lhs_id)
                              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "might inline first")
                    ]
        DsAnotherRuleMightFireFirst CLabelString
    rule_name CLabelString
    bad_rule Id
    lhs_id
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CLabelString -> SDoc
    pprRuleName CLabelString
    rule_name
                              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "may never fire")
                           Int
    2 (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "because rule" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CLabelString -> SDoc
    pprRuleName CLabelString
    bad_rule
                              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "for"SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    lhs_id)
                              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "might fire first")
                    ]
        DsIncompleteRecordSelector Name
    name [ConLike]
    cons_wo_field Bool
    not_full_examples -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
          String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "The application of the record field" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name)
          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "may fail for the following constructors:"
          SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((ConLike -> SDoc) -> [ConLike] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ConLike]
    cons_wo_field [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "..." | Bool
    not_full_examples])

      diagnosticReason :: DsMessage -> DiagnosticReason
    diagnosticReason = \case
        DsUnknownMessage UnknownDiagnostic (DiagnosticOpts DsMessage)
    m          -> UnknownDiagnostic NoDiagnosticOpts -> DiagnosticReason
    forall a. Diagnostic a => a -> DiagnosticReason
    diagnosticReason UnknownDiagnostic NoDiagnosticOpts
    UnknownDiagnostic (DiagnosticOpts DsMessage)
    m
        DsMessage
    DsEmptyEnumeration          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnEmptyEnumerations
        DsIdentitiesFound{}         -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnIdentities
        DsOverflowedLiterals{}      -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnOverflowedLiterals
        DsRedundantBangPatterns{}   -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnRedundantBangPatterns
        DsOverlappingPatterns{}     -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnOverlappingPatterns
        DsInaccessibleRhs{}         -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnOverlappingPatterns
        DsMaxPmCheckModelsReached{} -> DiagnosticReason
    WarningWithoutFlag
        DsNonExhaustivePatterns HsMatchContextRn
    _ (ExhaustivityCheckType Maybe WarningFlag
    mb_flag) Int
    _ [Id]
    _ [Nabla]
    _
          -> DiagnosticReason
    -> (WarningFlag -> DiagnosticReason)
    -> Maybe WarningFlag
    -> DiagnosticReason
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DiagnosticReason
    WarningWithoutFlag WarningFlag -> DiagnosticReason
    WarningWithFlag Maybe WarningFlag
    mb_flag
        DsTopLevelBindsNotAllowed{}                 -> DiagnosticReason
    ErrorWithoutFlag
        DsUselessSpecialiseForClassMethodSelector{} -> DiagnosticReason
    WarningWithoutFlag
        DsUselessSpecialiseForNoInlineFunction{}    -> DiagnosticReason
    WarningWithoutFlag
        DsMultiplicityCoercionsNotSupported{}       -> DiagnosticReason
    ErrorWithoutFlag
        DsOrphanRule{}                              -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnOrphans
        DsRuleLhsTooComplicated{}                   -> DiagnosticReason
    WarningWithoutFlag
        DsRuleIgnoredDueToConstructor{}             -> DiagnosticReason
    WarningWithoutFlag
        DsRuleBindersNotBound{}                     -> DiagnosticReason
    WarningWithoutFlag
        DsLazyPatCantBindVarsOfUnliftedType{}       -> DiagnosticReason
    ErrorWithoutFlag
        DsNotYetHandledByTH{}                       -> DiagnosticReason
    ErrorWithoutFlag
        DsAggregatedViewExpressions{}               -> DiagnosticReason
    WarningWithoutFlag
        DsUnbangedStrictPatterns{}                  -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnUnbangedStrictPatterns
        DsCannotMixPolyAndUnliftedBindings{}        -> DiagnosticReason
    ErrorWithoutFlag
        DsWrongDoBind{}                             -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnWrongDoBind
        DsUnusedDoBind{}                            -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnUnusedDoBind
        DsRecBindsNotAllowedForUnliftedTys{}        -> DiagnosticReason
    ErrorWithoutFlag
        DsRuleMightInlineFirst{}                    -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnInlineRuleShadowing
        DsAnotherRuleMightFireFirst{}               -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnInlineRuleShadowing
        DsIncompleteRecordSelector{}                -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnIncompleteRecordSelectors

      diagnosticHints :: DsMessage -> [GhcHint]
    diagnosticHints = \case
        DsUnknownMessage UnknownDiagnostic (DiagnosticOpts DsMessage)
    m          -> UnknownDiagnostic NoDiagnosticOpts -> [GhcHint]
    forall a. Diagnostic a => a -> [GhcHint]
    diagnosticHints UnknownDiagnostic NoDiagnosticOpts
    UnknownDiagnostic (DiagnosticOpts DsMessage)
    m
        DsMessage
    DsEmptyEnumeration          -> [GhcHint]
    noHints
        DsIdentitiesFound{}         -> [GhcHint]
    noHints
        DsOverflowedLiterals Integer
    i Name
    _tc Maybe (MinBound, MaxBound)
    bounds NegLiteralExtEnabled
    usingNegLiterals
          -> case (Maybe (MinBound, MaxBound)
    bounds, NegLiteralExtEnabled
    usingNegLiterals) of
              (Just (MinBound Integer
    minB, MaxBound Integer
    _), NegLiteralExtEnabled
    NotUsingNegLiterals)
                | Integer
    minB Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == -Integer
    i -- Note [Suggest NegativeLiterals]
                , Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0
                -> [ SDoc -> Extension -> GhcHint
    suggestExtensionWithInfo (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "If you are trying to write a large negative literal")
                                              Extension
    LangExt.NegativeLiterals ]
              (Maybe (MinBound, MaxBound), NegLiteralExtEnabled)
    _ -> [GhcHint]
    noHints
        DsRedundantBangPatterns{}                   -> [GhcHint]
    noHints
        DsOverlappingPatterns{}                     -> [GhcHint]
    noHints
        DsInaccessibleRhs{}                         -> [GhcHint]
    noHints
        DsMaxPmCheckModelsReached{}                 -> [GhcHint
    SuggestIncreaseMaxPmCheckModels]
        DsNonExhaustivePatterns{}                   -> [GhcHint]
    noHints
        DsTopLevelBindsNotAllowed{}                 -> [GhcHint]
    noHints
        DsUselessSpecialiseForClassMethodSelector{} -> [GhcHint]
    noHints
        DsUselessSpecialiseForNoInlineFunction{}    -> [GhcHint]
    noHints
        DsMessage
    DsMultiplicityCoercionsNotSupported         -> [GhcHint]
    noHints
        DsOrphanRule{}                              -> [GhcHint]
    noHints
        DsRuleLhsTooComplicated{}                   -> [GhcHint]
    noHints
        DsRuleIgnoredDueToConstructor{}             -> [GhcHint]
    noHints
        DsRuleBindersNotBound{}                     -> [GhcHint]
    noHints
        DsLazyPatCantBindVarsOfUnliftedType{}       -> [GhcHint]
    noHints
        DsNotYetHandledByTH{}                       -> [GhcHint]
    noHints
        DsAggregatedViewExpressions{}               -> [GhcHint]
    noHints
        DsUnbangedStrictPatterns{}                  -> [GhcHint]
    noHints
        DsCannotMixPolyAndUnliftedBindings{}        -> [AvailableBindings -> GhcHint
    SuggestAddTypeSignatures AvailableBindings
    UnnamedBinding]
        DsWrongDoBind LHsExpr GhcTc
    rhs Type
    _                         -> [LHsExpr GhcTc -> GhcHint
    SuggestBindToWildcard LHsExpr GhcTc
    rhs]
        DsUnusedDoBind LHsExpr GhcTc
    rhs Type
    _                        -> [LHsExpr GhcTc -> GhcHint
    SuggestBindToWildcard LHsExpr GhcTc
    rhs]
        DsRecBindsNotAllowedForUnliftedTys{}        -> [GhcHint]
    noHints
        DsRuleMightInlineFirst CLabelString
    _ Id
    lhs_id Activation
    rule_act    -> [Id -> Activation -> GhcHint
    SuggestAddInlineOrNoInlinePragma Id
    lhs_id Activation
    rule_act]
        DsAnotherRuleMightFireFirst CLabelString
    _ CLabelString
    bad_rule Id
    _    -> [CLabelString -> GhcHint
    SuggestAddPhaseToCompetingRule CLabelString
    bad_rule]
        DsIncompleteRecordSelector{}                -> [GhcHint]
    noHints

      diagnosticCode :: DsMessage -> Maybe DiagnosticCode
    diagnosticCode = DsMessage -> Maybe DiagnosticCode
    forall diag.
    (Generic diag, GDiagnosticCode (Rep diag)) =>
    diag -> Maybe DiagnosticCode
    constructorCode

    {-
    Note [Suggest NegativeLiterals]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If you write
      x :: Int8
      x = -128
    it'll parse as (negate 128), and overflow.  In this case, suggest NegativeLiterals.
    We get an erroneous suggestion for
      x = 128
    but perhaps that does not matter too much.
    -}

    --
    -- Helper functions
    --

    badMonadBind :: Type -> SDoc
    badMonadBind :: Type -> SDoc
    badMonadBind Type
    elt_ty
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "A do-notation statement discarded a result of type")
           Int
    2 (SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    elt_ty))

    -- Print a single clause (for redundant/with-inaccessible-rhs)
    pprEqn :: HsMatchContextRn -> SDoc -> String -> SDoc
    pprEqn :: HsMatchContextRn -> SDoc -> String -> SDoc
    pprEqn HsMatchContextRn
    ctx SDoc
    q String
    txt = Bool
    -> HsMatchContextRn -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc
    pprContext Bool
    True HsMatchContextRn
    ctx (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    txt) (((SDoc -> SDoc) -> SDoc) -> SDoc)
    -> ((SDoc -> SDoc) -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \SDoc -> SDoc
    f ->
      SDoc -> SDoc
    f (SDoc
    q SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> HsMatchContext (GenLocated SrcSpanAnnN Name) -> SDoc
    forall fn. HsMatchContext fn -> SDoc
    matchSeparator HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    ctx SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "...")

    pprContext :: Bool -> HsMatchContextRn -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc
    pprContext :: Bool
    -> HsMatchContextRn -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc
    pprContext Bool
    singular HsMatchContextRn
    kind SDoc
    msg (SDoc -> SDoc) -> SDoc
    rest_of_msg_fun
      = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    txt SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    msg,
              [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "In" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    ppr_match SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ':'
                  , Int -> SDoc -> SDoc
    nest Int
    4 ((SDoc -> SDoc) -> SDoc
    rest_of_msg_fun SDoc -> SDoc
    pref)]]
      where
        txt :: String
    txt | Bool
    singular  = String
    "Pattern match"
            | Bool
    otherwise = String
    "Pattern match(es)"

        (SDoc
    ppr_match, SDoc -> SDoc
    pref)
            = case HsMatchContextRn
    kind of
                 FunRhs { mc_fun :: forall fn. HsMatchContext fn -> fn
    mc_fun = L SrcSpanAnnN
    _ Name
    fun }
                      -> (HsMatchContext (GenLocated SrcSpanAnnN Name) -> SDoc
    forall fn. Outputable fn => HsMatchContext fn -> SDoc
    pprMatchContext HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    kind, \ SDoc
    pp -> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fun SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    pp)
                 HsMatchContextRn
    _    -> (HsMatchContext (GenLocated SrcSpanAnnN Name) -> SDoc
    forall fn. Outputable fn => HsMatchContext fn -> SDoc
    pprMatchContext HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    kind, \ SDoc
    pp -> SDoc
    pp)

    dots :: Int -> [a] -> SDoc
    dots :: forall a. Int -> [a] -> SDoc
    dots Int
    maxPatterns [a]
    qs
        | [a]
    qs [a] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthExceeds` Int
    maxPatterns = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "..."
        | Bool
    otherwise                      = SDoc
    forall doc. IsOutput doc => doc
    empty