    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE RecordWildCards #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage

    module GHC.Tc.Errors.Ppr
      ( pprTypeDoesNotHaveFixedRuntimeRep
      , pprScopeError
      --
      , tidySkolemInfo
      , tidySkolemInfoAnon
      --
      , withHsDocContext
      , pprHsDocContext
      , inHsDocContext
      )
      where

    import GHC.Prelude

    import GHC.Builtin.Names

    import GHC.Core.Coercion
    import GHC.Core.Unify     ( tcMatchTys )
    import GHC.Core.TyCon
    import GHC.Core.Class
    import GHC.Core.DataCon
    import GHC.Core.Coercion.Axiom (coAxiomTyCon, coAxiomSingleBranch)
    import GHC.Core.ConLike
    import GHC.Core.FamInstEnv (famInstAxiom)
    import GHC.Core.InstEnv
    import GHC.Core.TyCo.Rep (Type(..))
    import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen,
                              pprSourceTyCon, pprTyVars, pprWithTYPE)
    import GHC.Core.PatSyn ( patSynName, pprPatSynType )
    import GHC.Core.Predicate
    import GHC.Core.Type

    import GHC.Driver.Flags

    import GHC.Hs

    import GHC.Tc.Errors.Types
    import GHC.Tc.Types.Constraint
    import {-# SOURCE #-} GHC.Tc.Types (getLclEnvLoc)
    import GHC.Tc.Types.Origin
    import GHC.Tc.Types.Rank (Rank(..))
    import GHC.Tc.Utils.TcType
    import GHC.Types.Error
    import GHC.Types.FieldLabel (flIsOverloaded)
    import GHC.Types.Hint (UntickedPromotedThing(..), pprUntickedConstructor, isBareSymbol)
    import GHC.Types.Hint.Ppr () -- Outputable GhcHint
    import GHC.Types.Basic
    import GHC.Types.Id
    import GHC.Types.Name
    import GHC.Types.Name.Reader ( GreName(..), pprNameProvenance
                                 , RdrName, rdrNameOcc, greMangledName )
    import GHC.Types.Name.Set
    import GHC.Types.SrcLoc
    import GHC.Types.TyThing
    import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
    import GHC.Types.Var
    import GHC.Types.Var.Set
    import GHC.Types.Var.Env

    import GHC.Unit.State (pprWithUnitState, UnitState)
    import GHC.Unit.Module

    import GHC.Data.Bag
    import GHC.Data.FastString
    import GHC.Data.List.SetOps ( nubOrdBy )
    import GHC.Data.Maybe
    import GHC.Utils.Misc
    import GHC.Utils.Outputable
    import GHC.Utils.Panic

    import qualified GHC.LanguageExtensions as LangExt

    import Data.List.NonEmpty (NonEmpty(..))
    import qualified Data.List.NonEmpty as NE
    import Data.Function (on)
    import Data.List ( groupBy, sortBy, tails
                     , partition, unfoldr )
    import Data.Ord ( comparing )
    import Data.Bifunctor
    import GHC.Types.Name.Env

    instance Diagnostic TcRnMessage where
      diagnosticMessage :: TcRnMessage -> DecoratedSDoc
    diagnosticMessage = \case
        TcRnUnknownMessage a
    m
          -> a -> DecoratedSDoc
    forall a. Diagnostic a => a -> DecoratedSDoc
    diagnosticMessage a
    m
        TcRnMessageWithInfo UnitState
    unit_state TcRnMessageDetailed
    msg_with_info
          -> case TcRnMessageDetailed
    msg_with_info of
               TcRnMessageDetailed ErrInfo
    err_info TcRnMessage
    msg
                 -> UnitState -> ErrInfo -> DecoratedSDoc -> DecoratedSDoc
    messageWithInfoDiagnosticMessage UnitState
    unit_state ErrInfo
    err_info (TcRnMessage -> DecoratedSDoc
    forall a. Diagnostic a => a -> DecoratedSDoc
    diagnosticMessage TcRnMessage
    msg)
        TcRnSolverReport [SolverReportWithCtxt]
    msgs DiagnosticReason
    _ [GhcHint]
    _
          -> [SDoc] -> DecoratedSDoc
    mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               (SolverReportWithCtxt -> SDoc) -> [SolverReportWithCtxt] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map SolverReportWithCtxt -> SDoc
    pprSolverReportWithCtxt [SolverReportWithCtxt]
    msgs
        TcRnRedundantConstraints [TcTyVar]
    redundants (SkolemInfoAnon
    info, Bool
    show_info)
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
             String -> SDoc
    text String
    "Redundant constraint" SDoc -> SDoc -> SDoc
    <> [TcTyVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TcTyVar]
    redundants SDoc -> SDoc -> SDoc
    <> SDoc
    colon
               SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    pprEvVarTheta [TcTyVar]
    redundants
             SDoc -> SDoc -> SDoc
    $$ if Bool
    show_info then String -> SDoc
    text String
    "In" SDoc -> SDoc -> SDoc
    <+> SkolemInfoAnon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfoAnon
    info else SDoc
    empty
        TcRnInaccessibleCode Implication
    implic NonEmpty SolverReportWithCtxt
    contras
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
             SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Inaccessible code in")
               Int
    2 (SkolemInfoAnon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Implication -> SkolemInfoAnon
    ic_info Implication
    implic))
             SDoc -> SDoc -> SDoc
    $$ [SDoc] -> SDoc
    vcat ((SolverReportWithCtxt -> SDoc) -> [SolverReportWithCtxt] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map SolverReportWithCtxt -> SDoc
    pprSolverReportWithCtxt (NonEmpty SolverReportWithCtxt -> [SolverReportWithCtxt]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty SolverReportWithCtxt
    contras))
        TcRnTypeDoesNotHaveFixedRuntimeRep Type
    ty FixedRuntimeRepProvenance
    prov (ErrInfo SDoc
    extra SDoc
    supplementary)
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [Type -> FixedRuntimeRepProvenance -> SDoc
    pprTypeDoesNotHaveFixedRuntimeRep Type
    ty FixedRuntimeRepProvenance
    prov, SDoc
    extra, SDoc
    supplementary]
        TcRnImplicitLift var
    id_or_name ErrInfo{SDoc
    errInfoContext :: SDoc
    errInfoSupplementary :: SDoc
    errInfoContext :: ErrInfo -> SDoc
    errInfoSupplementary :: ErrInfo -> SDoc
    ..}
          -> [SDoc] -> DecoratedSDoc
    mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               ( String -> SDoc
    text String
    "The variable" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr var
    id_or_name) SDoc -> SDoc -> SDoc
    <+>
                 String -> SDoc
    text String
    "is implicitly lifted in the TH quotation"
               ) SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : [SDoc
    errInfoContext, SDoc
    errInfoSupplementary]
        TcRnUnusedPatternBinds HsBind GhcRn
    bind
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "This pattern-binding binds no variables:") Int
    2 (HsBind GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsBind GhcRn
    bind)]
        TcRnDodgyImports RdrName
    name
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [SDoc -> RdrName -> IE GhcPs -> SDoc
    forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
    dodgy_msg (String -> SDoc
    text String
    "import") RdrName
    name (IdP GhcPs -> IE GhcPs
    forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
    dodgy_msg_insert IdP GhcPs
    RdrName
    name :: IE GhcPs)]
        TcRnDodgyExports Name
    name
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [SDoc -> Name -> IE GhcRn -> SDoc
    forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
    dodgy_msg (String -> SDoc
    text String
    "export") Name
    name (IdP GhcRn -> IE GhcRn
    forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
    dodgy_msg_insert IdP GhcRn
    Name
    name :: IE GhcRn)]
        TcRnMissingImportList IE GhcPs
    ie
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [ String -> SDoc
    text String
    "The import item" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (IE GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr IE GhcPs
    ie) SDoc -> SDoc -> SDoc
    <+>
                           String -> SDoc
    text String
    "does not have an explicit import list"
                         ]
        TcRnMessage
    TcRnUnsafeDueToPlugin
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [String -> SDoc
    text String
    "Use of plugins makes the module unsafe"]
        TcRnModMissingRealSrcSpan Module
    mod
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [String -> SDoc
    text String
    "Module does not have a RealSrcSpan:" SDoc -> SDoc -> SDoc
    <+> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod]
        TcRnIdNotExportedFromModuleSig Name
    name Module
    mod
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [ String -> SDoc
    text String
    "The identifier" SDoc -> SDoc -> SDoc
    <+> OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> OccName
    forall name. HasOccName name => name -> OccName
    occName Name
    name) SDoc -> SDoc -> SDoc
    <+>
                           String -> SDoc
    text String
    "does not exist in the signature for" SDoc -> SDoc -> SDoc
    <+> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod
                         ]
        TcRnIdNotExportedFromLocalSig Name
    name
          -> [SDoc] -> DecoratedSDoc
    mkDecorated [ String -> SDoc
    text String
    "The identifier" SDoc -> SDoc -> SDoc
    <+> OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> OccName
    forall name. HasOccName name => name -> OccName
    occName Name
    name) SDoc -> SDoc -> SDoc
    <+>
                           String -> SDoc
    text String
    "does not exist in the local signature."
                         ]
        TcRnShadowedName OccName
    occ ShadowedNameProvenance
    provenance
          -> let shadowed_locs :: [SDoc]
    shadowed_locs = case ShadowedNameProvenance
    provenance of
                   ShadowedNameProvenanceLocal SrcLoc
    n     -> [String -> SDoc
    text String
    "bound at" SDoc -> SDoc -> SDoc
    <+> SrcLoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcLoc
    n]
                   ShadowedNameProvenanceGlobal [GlobalRdrElt]
    gres -> (GlobalRdrElt -> SDoc) -> [GlobalRdrElt] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GlobalRdrElt -> SDoc
    pprNameProvenance [GlobalRdrElt]
    gres
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                [SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "This binding for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ)
                 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "shadows the existing binding" SDoc -> SDoc -> SDoc
    <> [SDoc] -> SDoc
    forall a. [a] -> SDoc
    plural [SDoc]
    shadowed_locs,
                       Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat [SDoc]
    shadowed_locs)]
        TcRnDuplicateWarningDecls LocatedN RdrName
    d RdrName
    rdr_name
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "Multiple warning declarations for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name),
                     String -> SDoc
    text String
    "also at " SDoc -> SDoc -> SDoc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (LocatedN RdrName -> SrcSpan
    forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
    getLocA LocatedN RdrName
    d)]
        TcRnSimplifierTooManyIterations Cts
    simples IntWithInf
    limit WantedConstraints
    wc
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "solveWanteds: too many iterations"
                       SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (String -> SDoc
    text String
    "limit =" SDoc -> SDoc -> SDoc
    <+> IntWithInf -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr IntWithInf
    limit))
                    Int
    2 ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Unsolved:" SDoc -> SDoc -> SDoc
    <+> WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    wc
                            , String -> SDoc
    text String
    "Simples:"  SDoc -> SDoc -> SDoc
    <+> Cts -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Cts
    simples
                            ])
        TcRnIllegalPatSynDecl LIdP GhcPs
    rdrname
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal pattern synonym declaration for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LIdP GhcPs
    LocatedN RdrName
    rdrname))
                  Int
    2 (String -> SDoc
    text String
    "Pattern synonym declarations are only valid at top level")
        TcRnLinearPatSyn Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Pattern synonyms do not support linear fields (GHC #18806):") Int
    2 (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)
        TcRnMessage
    TcRnEmptyRecordUpdate
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Empty record update"
        TcRnIllegalFieldPunning Located RdrName
    fld
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Illegal use of punning for field" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Located RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Located RdrName
    fld)
        TcRnIllegalWildcardsInRecord RecordFieldPart
    fld_part
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Illegal `..' in record" SDoc -> SDoc -> SDoc
    <+> RecordFieldPart -> SDoc
    pprRecordFieldPart RecordFieldPart
    fld_part
        TcRnIllegalWildcardInType Maybe Name
    mb_name BadAnonWildcardContext
    bad Maybe HsDocContext
    mb_ctxt
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [ SDoc
    main_msg, SDoc
    context_msg ]
          where
            main_msg :: SDoc
            main_msg :: SDoc
    main_msg = case BadAnonWildcardContext
    bad of
              BadAnonWildcardContext
    WildcardNotLastInConstraint ->
                SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    notAllowed Int
    2 SDoc
    constraint_hint_msg
              ExtraConstraintWildcardNotAllowed SoleExtraConstraintWildcardAllowed
    allow_sole ->
                case SoleExtraConstraintWildcardAllowed
    allow_sole of
                  SoleExtraConstraintWildcardAllowed
    SoleExtraConstraintWildcardNotAllowed ->
                    SDoc
    notAllowed
                  SoleExtraConstraintWildcardAllowed
    SoleExtraConstraintWildcardAllowed ->
                    SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    notAllowed Int
    2 SDoc
    sole_msg
              BadAnonWildcardContext
    WildcardsNotAllowedAtAll ->
                SDoc
    notAllowed
            context_msg :: SDoc
            context_msg :: SDoc
    context_msg = case Maybe HsDocContext
    mb_ctxt of
              Just HsDocContext
    ctxt -> Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "in" SDoc -> SDoc -> SDoc
    <+> HsDocContext -> SDoc
    pprHsDocContext HsDocContext
    ctxt)
              Maybe HsDocContext
    _         -> SDoc
    empty
            notAllowed, what, wildcard, how :: SDoc
            notAllowed :: SDoc
    notAllowed = SDoc
    what SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    wildcard SDoc -> SDoc -> SDoc
    <+> SDoc
    how
            wildcard :: SDoc
    wildcard = case Maybe Name
    mb_name of
              Maybe Name
    Nothing   -> SDoc
    pprAnonWildCard
              Just Name
    name -> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name
            what :: SDoc
    what
              | Just Name
    _ <- Maybe Name
    mb_name
              = String -> SDoc
    text String
    "Named wildcard"
              | ExtraConstraintWildcardNotAllowed {} <- BadAnonWildcardContext
    bad
              = String -> SDoc
    text String
    "Extra-constraint wildcard"
              | Bool
    otherwise
              = String -> SDoc
    text String
    "Wildcard"
            how :: SDoc
    how = case BadAnonWildcardContext
    bad of
              BadAnonWildcardContext
    WildcardNotLastInConstraint
                -> String -> SDoc
    text String
    "not allowed in a constraint"
              BadAnonWildcardContext
    _ -> String -> SDoc
    text String
    "not allowed"
            constraint_hint_msg :: SDoc
            constraint_hint_msg :: SDoc
    constraint_hint_msg
              | Just Name
    _ <- Maybe Name
    mb_name
              = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Extra-constraint wildcards must be anonymous"
                     , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "e.g  f :: (Eq a, _) => blah") ]
              | Bool
    otherwise
              = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "except as the last top-level constraint of a type signature"
                     , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "e.g  f :: (Eq a, _) => blah") ]
            sole_msg :: SDoc
            sole_msg :: SDoc
    sole_msg =
              [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "except as the sole constraint"
                   , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "e.g., deriving instance _ => Eq (Foo a)") ]
        TcRnDuplicateFieldName RecordFieldPart
    fld_part NonEmpty RdrName
    dups
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    hsep [String -> SDoc
    text String
    "duplicate field name",
                     SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (NonEmpty RdrName -> RdrName
    forall a. NonEmpty a -> a
    NE.head NonEmpty RdrName
    dups)),
                     String -> SDoc
    text String
    "in record", RecordFieldPart -> SDoc
    pprRecordFieldPart RecordFieldPart
    fld_part]
        TcRnIllegalViewPattern Pat GhcPs
    pat
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "Illegal view pattern: " SDoc -> SDoc -> SDoc
    <+> Pat GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcPs
    pat]
        TcRnCharLiteralOutOfRange Char
    c
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "character literal out of range: '\\" SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    c  SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '\''
        TcRnIllegalWildcardsInConstructor Name
    con
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Illegal `..' notation for constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    con)
                    , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "The constructor has no labelled fields") ]
        TcRnIgnoringAnnotations [LAnnDecl GhcRn]
    anns
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Ignoring ANN annotation" SDoc -> SDoc -> SDoc
    <> [GenLocated SrcSpanAnnA (AnnDecl GhcRn)] -> SDoc
    forall a. [a] -> SDoc
    plural [LAnnDecl GhcRn]
    [GenLocated SrcSpanAnnA (AnnDecl GhcRn)]
    anns SDoc -> SDoc -> SDoc
    <> SDoc
    comma
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi"
        TcRnMessage
    TcRnAnnotationInSafeHaskell
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Annotations are not compatible with Safe Haskell."
                    , String -> SDoc
    text String
    "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]
        TcRnInvalidTypeApplication Type
    fun_ty LHsWcType GhcRn
    hs_ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Cannot apply expression of type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    fun_ty) SDoc -> SDoc -> SDoc
    $$
               String -> SDoc
    text String
    "to a visible type argument" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsWcType GhcRn
    HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
    hs_ty)
        TcRnMessage
    TcRnTagToEnumMissingValArg
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "tagToEnum# must appear applied to one value argument"
        TcRnTagToEnumUnspecifiedResTy Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)
                  Int
    2 ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Specify the type by giving a type signature"
                          , String -> SDoc
    text String
    "e.g. (tagToEnum# x) :: Bool" ])
        TcRnTagToEnumResTyNotAnEnum Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)
                  Int
    2 (String -> SDoc
    text String
    "Result type must be an enumeration type")
        TcRnMessage
    TcRnArrowIfThenElsePredDependsOnResultTy
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Predicate type of `ifThenElse' depends on result type"
        TcRnMessage
    TcRnIllegalHsBootFileDecl
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal declarations in an hs-boot file"
        TcRnRecursivePatternSynonym LHsBinds GhcRn
    binds
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Recursive pattern synonym definition with following bindings:")
                   Int
    2 ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpanAnnA (HsBind GhcRn) -> SDoc)
    -> [GenLocated SrcSpanAnnA (HsBind GhcRn)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (HsBind GhcRn) -> SDoc
    forall a idR.
    CollectPass GhcRn =>
    GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
    pprLBind ([GenLocated SrcSpanAnnA (HsBind GhcRn)] -> [SDoc])
    -> (LHsBinds GhcRn -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
    -> LHsBinds GhcRn
    -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsBinds GhcRn -> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
    Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
    -> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
    forall a. Bag a -> [a]
    bagToList (LHsBinds GhcRn -> [SDoc]) -> LHsBinds GhcRn -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ LHsBinds GhcRn
    binds)
              where
                pprLoc :: a -> SDoc
    pprLoc a
    loc = SDoc -> SDoc
    parens (String -> SDoc
    text String
    "defined at" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    loc)
                pprLBind :: CollectPass GhcRn => GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
                pprLBind :: forall a idR.
    CollectPass GhcRn =>
    GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
    pprLBind (L SrcSpanAnn' a
    loc HsBindLR GhcRn idR
    bind) = (Name -> SDoc) -> [Name] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CollectFlag GhcRn -> HsBindLR GhcRn idR -> [IdP GhcRn]
    forall p idR.
    CollectPass p =>
    CollectFlag p -> HsBindLR p idR -> [IdP p]
    collectHsBindBinders CollectFlag GhcRn
    forall p. CollectFlag p
    CollNoDictBinders HsBindLR GhcRn idR
    bind)
                                            SDoc -> SDoc -> SDoc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    pprLoc (SrcSpanAnn' a -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnn' a
    loc)
        TcRnPartialTypeSigTyVarMismatch Name
    n1 Name
    n2 Name
    fn_name LHsSigWcType GhcRn
    hs_ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Couldn't match" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n1)
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n2))
                    Int
    2 (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "both bound by the partial type signature:")
                            Int
    2 (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fn_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigWcType GhcRn
    HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    hs_ty))
        TcRnPartialTypeSigBadQuantifier Name
    n Name
    fn_name Maybe Type
    m_unif_ty LHsSigWcType GhcRn
    hs_ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Can't quantify over" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n))
                    Int
    2 ([SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "bound by the partial type signature:")
                                 Int
    2 (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fn_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigWcType GhcRn
    HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
    hs_ty)
                            , SDoc
    extra ])
          where
            extra :: SDoc
    extra | Just Type
    rhs_ty <- Maybe Type
    m_unif_ty
                  = [SDoc] -> SDoc
    sep [ SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n), String -> SDoc
    text String
    "should really be", SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    rhs_ty) ]
                  | Bool
    otherwise
                  = SDoc
    empty
        TcRnMissingSignature MissingSignature
    what Exported
    _ Bool
    _ ->
          SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
          case MissingSignature
    what of
            MissingPatSynSig PatSyn
    p ->
              SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Pattern synonym with no type signature:")
                Int
    2 (String -> SDoc
    text String
    "pattern" SDoc -> SDoc -> SDoc
    <+> Name -> SDoc
    forall a. NamedThing a => a -> SDoc
    pprPrefixName (PatSyn -> Name
    patSynName PatSyn
    p) SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> PatSyn -> SDoc
    pprPatSynType PatSyn
    p)
            MissingTopLevelBindingSig Name
    name Type
    ty ->
              SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Top-level binding with no type signature:")
                Int
    2 (Name -> SDoc
    forall a. NamedThing a => a -> SDoc
    pprPrefixName Name
    name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprSigmaType Type
    ty)
            MissingTyConKindSig TyCon
    tc Bool
    cusks_enabled ->
              SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    msg
                Int
    2 (String -> SDoc
    text String
    "type" SDoc -> SDoc -> SDoc
    <+> Name -> SDoc
    forall a. NamedThing a => a -> SDoc
    pprPrefixName (TyCon -> Name
    tyConName TyCon
    tc) SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprKind (TyCon -> Type
    tyConKind TyCon
    tc))
              where
                msg :: SDoc
    msg | Bool
    cusks_enabled
                    = String -> SDoc
    text String
    "Top-level type constructor with no standalone kind signature or CUSK:"
                    | Bool
    otherwise
                    = String -> SDoc
    text String
    "Top-level type constructor with no standalone kind signature:"

        TcRnPolymorphicBinderMissingSig Name
    n Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Polymorphic local binding with no type signature:"
                   , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Name -> SDoc
    forall a. NamedThing a => a -> SDoc
    pprPrefixName Name
    n SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty ]
        TcRnOverloadedSig TcIdSigInfo
    sig
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Overloaded signature conflicts with monomorphism restriction")
                  Int
    2 (TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    sig)
        TcRnTupleConstraintInst Class
    _
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "You can't specify an instance for a tuple constraint"
        TcRnAbstractClassInst Class
    clas
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Cannot define instance for abstract class" SDoc -> SDoc -> SDoc
    <+>
               SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Class -> Name
    className Class
    clas))
        TcRnNoClassInstHead Type
    tau
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Instance head is not headed by a class:") Int
    2 (Type -> SDoc
    pprType Type
    tau)
        TcRnUserTypeError Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (Type -> SDoc
    pprUserTypeErrorTy Type
    ty)
        TcRnConstraintInKind Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal constraint in a kind:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType Type
    ty
        TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
    tuple_or_sum Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Illegal unboxed" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "type as function argument:"
                   , Type -> SDoc
    pprType Type
    ty ]
            where
              what :: SDoc
    what = case UnboxedTupleOrSum
    tuple_or_sum of
                UnboxedTupleOrSum
    UnboxedTupleType -> String -> SDoc
    text String
    "tuple"
                UnboxedTupleOrSum
    UnboxedSumType   -> String -> SDoc
    text String
    "sum"
        TcRnLinearFuncInKind Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal linear function in a kind:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType Type
    ty
        TcRnForAllEscapeError Type
    ty Type
    kind
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
               [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Quantified type's kind mentions quantified type variable")
                    Int
    2 (String -> SDoc
    text String
    "type:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty))
               , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "where the body of the forall has this kind:")
                    Int
    2 (SDoc -> SDoc
    quotes (Type -> SDoc
    pprKind Type
    kind)) ]
        TcRnVDQInTermType Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
               [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal visible, dependent quantification" SDoc -> SDoc -> SDoc
    <+>
                       String -> SDoc
    text String
    "in the type of a term:")
                    Int
    2 (Type -> SDoc
    pprType Type
    ty)
               , String -> SDoc
    text String
    "(GHC does not yet support this)" ]
        TcRnBadQuantPredHead Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Quantified predicate must have a class or type variable head:")
                  Int
    2 (Type -> SDoc
    pprType Type
    ty)
        TcRnIllegalTupleConstraint Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal tuple constraint:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType Type
    ty
        TcRnNonTypeVarArgInConstraint Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Non type-variable argument")
                  Int
    2 (String -> SDoc
    text String
    "in the constraint:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType Type
    ty)
        TcRnIllegalImplicitParam Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal implicit parameter" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprType Type
    ty)
        TcRnIllegalConstraintSynonymOfKind Type
    kind
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal constraint synonym of kind:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprKind Type
    kind)
        TcRnIllegalClassInst TyConFlavour
    tcf
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Illegal instance for a" SDoc -> SDoc -> SDoc
    <+> TyConFlavour -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyConFlavour
    tcf
                    , String -> SDoc
    text String
    "A class instance must be for a class" ]
        TcRnOversaturatedVisibleKindArg Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal oversaturated visible kind argument:" SDoc -> SDoc -> SDoc
    <+>
               SDoc -> SDoc
    quotes (Char -> SDoc
    char Char
    '@' SDoc -> SDoc -> SDoc
    <> Type -> SDoc
    pprParendType Type
    ty)
        TcRnBadAssociatedType Name
    clas Name
    tc
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "Class", SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    clas)
                    , String -> SDoc
    text String
    "does not have an associated type", SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    tc) ]
        TcRnForAllRankErr Rank
    rank Type
    ty
          -> let herald :: SDoc
    herald = case Type -> ([TcTyVar], Type)
    tcSplitForAllTyVars Type
    ty of
                   ([], Type
    _) -> String -> SDoc
    text String
    "Illegal qualified type:"
                   ([TcTyVar], Type)
    _       -> String -> SDoc
    text String
    "Illegal polymorphic type:"
                 extra :: SDoc
    extra = case Rank
    rank of
                   Rank
    MonoTypeConstraint -> String -> SDoc
    text String
    "A constraint must be a monotype"
                   Rank
    _                  -> SDoc
    empty
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 (Type -> SDoc
    pprType Type
    ty), SDoc
    extra]
        TcRnMonomorphicBindings [Name]
    bindings
          -> let pp_bndrs :: SDoc
    pp_bndrs = [Name] -> SDoc
    pprBindings [Name]
    bindings
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                  [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The Monomorphism Restriction applies to the binding"
                      SDoc -> SDoc -> SDoc
    <> [Name] -> SDoc
    forall a. [a] -> SDoc
    plural [Name]
    bindings
                      , String -> SDoc
    text String
    "for" SDoc -> SDoc -> SDoc
    <+> SDoc
    pp_bndrs ]
        TcRnOrphanInstance ClsInst
    inst
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "Orphan instance:"
                    , ClsInst -> SDoc
    pprInstanceHdr ClsInst
    inst
                    ]
        TcRnFunDepConflict UnitState
    unit_state NonEmpty ClsInst
    sorted
          -> let herald :: SDoc
    herald = String -> SDoc
    text String
    "Functional dependencies conflict between instance declarations:"
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                  UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    unit_state (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 ([ClsInst] -> SDoc
    pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ NonEmpty ClsInst -> [ClsInst]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty ClsInst
    sorted))
        TcRnDupInstanceDecls UnitState
    unit_state NonEmpty ClsInst
    sorted
          -> let herald :: SDoc
    herald = String -> SDoc
    text String
    "Duplicate instance declarations:"
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                  UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    unit_state (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 ([ClsInst] -> SDoc
    pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ NonEmpty ClsInst -> [ClsInst]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty ClsInst
    sorted))
        TcRnConflictingFamInstDecls NonEmpty FamInst
    sortedNE
          -> let sorted :: [FamInst]
    sorted = NonEmpty FamInst -> [FamInst]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty FamInst
    sortedNE
             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                  SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Conflicting family instance declarations:")
                     Int
    2 ([SDoc] -> SDoc
    vcat [ TyCon -> CoAxBranch -> SDoc
    pprCoAxBranchUser (CoAxiom Unbranched -> TyCon
    forall (br :: BranchFlag). CoAxiom br -> TyCon
    coAxiomTyCon CoAxiom Unbranched
    ax) (CoAxiom Unbranched -> CoAxBranch
    coAxiomSingleBranch CoAxiom Unbranched
    ax)
                             | FamInst
    fi <- [FamInst]
    sorted
                             , let ax :: CoAxiom Unbranched
    ax = FamInst -> CoAxiom Unbranched
    famInstAxiom FamInst
    fi ])
        TcRnFamInstNotInjective InjectivityErrReason
    rea TyCon
    fam_tc (CoAxBranch
    eqn1 NE.:| [CoAxBranch]
    rest_eqns)
          -> let (SDoc
    herald, Bool
    show_kinds) = case InjectivityErrReason
    rea of
                   InjErrRhsBareTyVar [Type]
    tys ->
                     (SDoc
    injectivityErrorHerald SDoc -> SDoc -> SDoc
    $$
                      String -> SDoc
    text String
    "RHS of injective type family equation is a bare" SDoc -> SDoc -> SDoc
    <+>
                      String -> SDoc
    text String
    "type variable" SDoc -> SDoc -> SDoc
    $$
                      String -> SDoc
    text String
    "but these LHS type and kind patterns are not bare" SDoc -> SDoc -> SDoc
    <+>
                      String -> SDoc
    text String
    "variables:" SDoc -> SDoc -> SDoc
    <+> [Type] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [Type]
    tys, Bool
    False)
                   InjectivityErrReason
    InjErrRhsCannotBeATypeFam ->
                     (SDoc
    injectivityErrorHerald SDoc -> SDoc -> SDoc
    $$
                       String -> SDoc
    text String
    "RHS of injective type family equation cannot" SDoc -> SDoc -> SDoc
    <+>
                       String -> SDoc
    text String
    "be a type family:", Bool
    False)
                   InjectivityErrReason
    InjErrRhsOverlap ->
                      (String -> SDoc
    text String
    "Type family equation right-hand sides overlap; this violates" SDoc -> SDoc -> SDoc
    $$
                       String -> SDoc
    text String
    "the family's injectivity annotation:", Bool
    False)
                   InjErrCannotInferFromRhs TyVarSet
    tvs HasKinds
    has_kinds SuggestUndecidableInstances
    _ ->
                     let show_kinds :: Bool
    show_kinds = HasKinds
    has_kinds HasKinds -> HasKinds -> Bool
    forall a. Eq a => a -> a -> Bool
    == HasKinds
    YesHasKinds
                         what :: SDoc
    what = if Bool
    show_kinds then String -> SDoc
    text String
    "Type/kind" else String -> SDoc
    text String
    "Type"
                         body :: SDoc
    body = [SDoc] -> SDoc
    sep [ SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable" SDoc -> SDoc -> SDoc
    <>
                                      TyVarSet -> SDoc
    pluralVarSet TyVarSet
    tvs SDoc -> SDoc -> SDoc
    <+> TyVarSet -> ([TcTyVar] -> SDoc) -> SDoc
    pprVarSet TyVarSet
    tvs ([TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList ([TcTyVar] -> SDoc)
    -> ([TcTyVar] -> [TcTyVar]) -> [TcTyVar] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TcTyVar] -> [TcTyVar]
    scopedSort)
                                    , String -> SDoc
    text String
    "cannot be inferred from the right-hand side." ]
                         in (SDoc
    injectivityErrorHerald SDoc -> SDoc -> SDoc
    $$ SDoc
    body SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "In the type family equation:", Bool
    show_kinds)

             in SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ Bool -> SDoc -> SDoc
    pprWithExplicitKindsWhen Bool
    show_kinds (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                  SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald
                    Int
    2 ([SDoc] -> SDoc
    vcat ((CoAxBranch -> SDoc) -> [CoAxBranch] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (TyCon -> CoAxBranch -> SDoc
    pprCoAxBranchUser TyCon
    fam_tc) (CoAxBranch
    eqn1 CoAxBranch -> [CoAxBranch] -> [CoAxBranch]
    forall a. a -> [a] -> [a]
    : [CoAxBranch]
    rest_eqns)))
        TcRnBangOnUnliftedType Type
    ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Strictness flag has no effect on unlifted type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)
        TcRnMultipleDefaultDeclarations [LDefaultDecl GhcRn]
    dup_things
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Multiple default declarations")
                  Int
    2 ([SDoc] -> SDoc
    vcat ((GenLocated SrcSpanAnnA (DefaultDecl GhcRn) -> SDoc)
    -> [GenLocated SrcSpanAnnA (DefaultDecl GhcRn)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map LDefaultDecl GhcRn -> SDoc
    GenLocated SrcSpanAnnA (DefaultDecl GhcRn) -> SDoc
    pp [LDefaultDecl GhcRn]
    [GenLocated SrcSpanAnnA (DefaultDecl GhcRn)]
    dup_things))
             where
               pp :: LDefaultDecl GhcRn -> SDoc
               pp :: LDefaultDecl GhcRn -> SDoc
    pp (L SrcSpanAnnA
    locn (DefaultDecl XCDefaultDecl GhcRn
    _ [LHsType GhcRn]
    _))
                 = String -> SDoc
    text String
    "here was another default declaration" SDoc -> SDoc -> SDoc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    locn)
        TcRnBadDefaultType Type
    ty [Class]
    deflt_clss
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The default type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not an instance of")
                  Int
    2 ((SDoc -> SDoc -> SDoc) -> [SDoc] -> SDoc
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\SDoc
    a SDoc
    b -> SDoc
    a SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "or" SDoc -> SDoc -> SDoc
    <+> SDoc
    b) ((Class -> SDoc) -> [Class] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SDoc -> SDoc
    quotes(SDoc -> SDoc) -> (Class -> SDoc) -> Class -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr) [Class]
    deflt_clss))
        TcRnMessage
    TcRnPatSynBundledWithNonDataCon
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Pattern synonyms can be bundled only with datatypes."
        TcRnPatSynBundledWithWrongType Type
    expected_res_ty Type
    res_ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Pattern synonyms can only be bundled with matching type constructors"
                   SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "Couldn't match expected type of"
                   SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    expected_res_ty)
                   SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with actual type of"
                   SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    res_ty)
        TcRnDupeModuleExport ModuleName
    mod
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "Duplicate"
                    , SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "Module" SDoc -> SDoc -> SDoc
    <+> ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModuleName
    mod)
                    , String -> SDoc
    text String
    "in export list" ]
        TcRnExportedModNotImported ModuleName
    mod
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated
           (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> String -> SDoc
    formatExportItemError
               (String -> SDoc
    text String
    "module" SDoc -> SDoc -> SDoc
    <+> ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModuleName
    mod)
               String
    "is not imported"
        TcRnNullExportedModule ModuleName
    mod
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated
           (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> String -> SDoc
    formatExportItemError
               (String -> SDoc
    text String
    "module" SDoc -> SDoc -> SDoc
    <+> ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModuleName
    mod)
               String
    "exports nothing"
        TcRnMissingExportList ModuleName
    mod
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated
           (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> String -> SDoc
    formatExportItemError
               (String -> SDoc
    text String
    "module" SDoc -> SDoc -> SDoc
    <+> ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModuleName
    mod)
               String
    "is missing an export list"
        TcRnExportHiddenComponents IE GhcPs
    export_item
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated
           (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> String -> SDoc
    formatExportItemError
               (IE GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr IE GhcPs
    export_item)
               String
    "attempts to export constructors or class methods that are not visible here"
        TcRnDuplicateExport GreName
    child IE GhcPs
    ie1 IE GhcPs
    ie2
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    hsep [ SDoc -> SDoc
    quotes (GreName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GreName
    child)
                    , String -> SDoc
    text String
    "is exported by", SDoc -> SDoc
    quotes (IE GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr IE GhcPs
    ie1)
                    , String -> SDoc
    text String
    "and",            SDoc -> SDoc
    quotes (IE GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr IE GhcPs
    ie2) ]
        TcRnExportedParentChildMismatch Name
    parent_name TyThing
    ty_thing GreName
    child [Name]
    parent_names
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "The type constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    parent_name)
                     SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not the parent of the" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    what_is
                     SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    thing SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '.'
                     SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text (String -> String
    capitalise String
    what_is)
                        SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "s can only be exported with their parent type constructor."
                     SDoc -> SDoc -> SDoc
    $$ (case [SDoc]
    parents of
                           [] -> SDoc
    empty
                           [SDoc
    _] -> String -> SDoc
    text String
    "Parent:"
                           [SDoc]
    _  -> String -> SDoc
    text String
    "Parents:") SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    fsep (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma [SDoc]
    parents)
          where
            pp_category :: TyThing -> String
            pp_category :: TyThing -> String
    pp_category (AnId TcTyVar
    i)
              | TcTyVar -> Bool
    isRecordSelector TcTyVar
    i = String
    "record selector"
            pp_category TyThing
    i = TyThing -> String
    tyThingCategory TyThing
    i
            what_is :: String
    what_is = TyThing -> String
    pp_category TyThing
    ty_thing
            thing :: SDoc
    thing = GreName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GreName
    child
            parents :: [SDoc]
    parents = (Name -> SDoc) -> [Name] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Name]
    parent_names
        TcRnConflictingExports OccName
    occ GreName
    child1 GlobalRdrElt
    gre1 IE GhcPs
    ie1 GreName
    child2 GlobalRdrElt
    gre2 IE GhcPs
    ie2
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Conflicting exports for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ) SDoc -> SDoc -> SDoc
    <> SDoc
    colon
                    , GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
    forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
    ppr_export GreName
    child1 GlobalRdrElt
    gre1 IE GhcPs
    ie1
                    , GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
    forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
    ppr_export GreName
    child2 GlobalRdrElt
    gre2 IE GhcPs
    ie2
                    ]
          where
            ppr_export :: GreName -> GlobalRdrElt -> a -> SDoc
    ppr_export GreName
    child GlobalRdrElt
    gre a
    ie = Int -> SDoc -> SDoc
    nest Int
    3 (SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    quotes (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    ie) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "exports" SDoc -> SDoc -> SDoc
    <+>
                                                    SDoc -> SDoc
    quotes (GreName -> SDoc
    ppr_name GreName
    child))
                                                Int
    2 (GlobalRdrElt -> SDoc
    pprNameProvenance GlobalRdrElt
    gre))

            -- DuplicateRecordFields means that nameOccName might be a
            -- mangled $sel-prefixed thing, in which case show the correct OccName
            -- alone (but otherwise show the Name so it will have a module
            -- qualifier)
            ppr_name :: GreName -> SDoc
    ppr_name (FieldGreName FieldLabel
    fl) | FieldLabel -> Bool
    flIsOverloaded FieldLabel
    fl = FieldLabel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FieldLabel
    fl
                                       | Bool
    otherwise         = Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (FieldLabel -> Name
    flSelector FieldLabel
    fl)
            ppr_name (NormalGreName Name
    name) = Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name
        TcRnAmbiguousField HsExpr GhcRn
    rupd TyCon
    parent_type
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
              [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "The record update" SDoc -> SDoc -> SDoc
    <+> HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rupd
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with type" SDoc -> SDoc -> SDoc
    <+> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    parent_type
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is ambiguous."
                   , String -> SDoc
    text String
    "This will not be supported by -XDuplicateRecordFields in future releases of GHC."
                   ]
        TcRnMissingFields ConLike
    con [(FieldLabelString, Type)]
    fields
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [SDoc
    header, Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    rest]
             where
               rest :: SDoc
    rest | [(FieldLabelString, Type)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, Type)]
    fields = SDoc
    empty
                    | Bool
    otherwise   = [SDoc] -> SDoc
    vcat (((FieldLabelString, Type) -> SDoc)
    -> [(FieldLabelString, Type)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FieldLabelString, Type) -> SDoc
    pprField [(FieldLabelString, Type)]
    fields)
               header :: SDoc
    header = String -> SDoc
    text String
    "Fields of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    con) SDoc -> SDoc -> SDoc
    <+>
                        String -> SDoc
    text String
    "not initialised" SDoc -> SDoc -> SDoc
    <>
                        if [(FieldLabelString, Type)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, Type)]
    fields then SDoc
    empty else SDoc
    colon
        TcRnFieldUpdateInvalidType [(FieldLabelString, Type)]
    prs
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Record update for insufficiently polymorphic field"
                       SDoc -> SDoc -> SDoc
    <> [(FieldLabelString, Type)] -> SDoc
    forall a. [a] -> SDoc
    plural [(FieldLabelString, Type)]
    prs SDoc -> SDoc -> SDoc
    <> SDoc
    colon)
                  Int
    2 ([SDoc] -> SDoc
    vcat [ FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FieldLabelString
    f SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty | (FieldLabelString
    f,Type
    ty) <- [(FieldLabelString, Type)]
    prs ])
        TcRnNoConstructorHasAllFields [FieldLabelString]
    conflictingFields
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "No constructor has all these fields:")
                  Int
    2 ([FieldLabelString] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [FieldLabelString]
    conflictingFields)
        TcRnMixedSelectors Name
    data_name [TcTyVar]
    data_sels Name
    pat_name [TcTyVar]
    pat_syn_sels
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Cannot use a mixture of pattern synonym and record selectors" SDoc -> SDoc -> SDoc
    $$
               String -> SDoc
    text String
    "Record selectors defined by"
                 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    data_name)
                 SDoc -> SDoc -> SDoc
    <> SDoc
    colon
                 SDoc -> SDoc -> SDoc
    <+> (TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TcTyVar]
    data_sels SDoc -> SDoc -> SDoc
    $$
               String -> SDoc
    text String
    "Pattern synonym selectors defined by"
                 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    pat_name)
                 SDoc -> SDoc -> SDoc
    <> SDoc
    colon
                 SDoc -> SDoc -> SDoc
    <+> (TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TcTyVar]
    pat_syn_sels
        TcRnMissingStrictFields ConLike
    con [(FieldLabelString, Type)]
    fields
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [SDoc
    header, Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    rest]
             where
               rest :: SDoc
    rest | [(FieldLabelString, Type)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, Type)]
    fields = SDoc
    empty  -- Happens for non-record constructors
                                           -- with strict fields
                    | Bool
    otherwise   = [SDoc] -> SDoc
    vcat (((FieldLabelString, Type) -> SDoc)
    -> [(FieldLabelString, Type)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FieldLabelString, Type) -> SDoc
    pprField [(FieldLabelString, Type)]
    fields)

               header :: SDoc
    header = String -> SDoc
    text String
    "Constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    con) SDoc -> SDoc -> SDoc
    <+>
                        String -> SDoc
    text String
    "does not have the required strict field(s)" SDoc -> SDoc -> SDoc
    <>
                        if [(FieldLabelString, Type)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, Type)]
    fields then SDoc
    empty else SDoc
    colon
        TcRnNoPossibleParentForFields [LHsRecUpdField GhcRn]
    rbinds
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "No type has all these fields:")
                  Int
    2 ([GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
    fields)
             where fields :: [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
    fields = (GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
          (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
    -> [GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
             (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
    forall a b. (a -> b) -> [a] -> [b]
    map (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
    forall lhs rhs. HsFieldBind lhs rhs -> lhs
    hfbLHS (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
       (GenLocated SrcSpanAnnA (HsExpr GhcRn))
     -> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
    -> (GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
             (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> HsFieldBind
             (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
             (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc) [LHsRecUpdField GhcRn]
    [GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
          (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    rbinds
        TcRnBadOverloadedRecordUpdate [LHsRecUpdField GhcRn]
    _rbinds
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Record update is ambiguous, and requires a type signature"
        TcRnStaticFormNotClosed Name
    name NotClosedReason
    reason
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name)
                 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is used in a static form but it is not closed"
                 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "because it"
                 SDoc -> SDoc -> SDoc
    $$ [SDoc] -> SDoc
    sep (NotClosedReason -> [SDoc]
    causes NotClosedReason
    reason)
             where
              causes :: NotClosedReason -> [SDoc]
              causes :: NotClosedReason -> [SDoc]
    causes NotClosedReason
    NotLetBoundReason = [String -> SDoc
    text String
    "is not let-bound."]
              causes (NotTypeClosed TyVarSet
    vs) =
                [ String -> SDoc
    text String
    "has a non-closed type because it contains the"
                , String -> SDoc
    text String
    "type variables:" SDoc -> SDoc -> SDoc
    <+>
                  TyVarSet -> ([TcTyVar] -> SDoc) -> SDoc
    pprVarSet TyVarSet
    vs ([SDoc] -> SDoc
    hsep ([SDoc] -> SDoc) -> ([TcTyVar] -> [SDoc]) -> [TcTyVar] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> [SDoc]) -> ([TcTyVar] -> [SDoc]) -> [TcTyVar] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TcTyVar -> SDoc) -> [TcTyVar] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> (TcTyVar -> SDoc) -> TcTyVar -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr))
                ]
              causes (NotClosed Name
    n NotClosedReason
    reason) =
                let msg :: SDoc
    msg = String -> SDoc
    text String
    "uses" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "which"
                 in case NotClosedReason
    reason of
                      NotClosed Name
    _ NotClosedReason
    _ -> SDoc
    msg SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : NotClosedReason -> [SDoc]
    causes NotClosedReason
    reason
                      NotClosedReason
    _   -> let ([SDoc]
    xs0, [SDoc]
    xs1) = Int -> [SDoc] -> ([SDoc], [SDoc])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    1 ([SDoc] -> ([SDoc], [SDoc])) -> [SDoc] -> ([SDoc], [SDoc])
    forall a b. (a -> b) -> a -> b
    $ NotClosedReason -> [SDoc]
    causes NotClosedReason
    reason
                              in (SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (SDoc
    msg SDoc -> SDoc -> SDoc
    <+>) [SDoc]
    xs0 [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    xs1
        TcRnMessage
    TcRnUselessTypeable
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Deriving" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    typeableClassName) SDoc -> SDoc -> SDoc
    <+>
               String -> SDoc
    text String
    "has no effect: all types now auto-derive Typeable"
        TcRnDerivingDefaults Class
    cls
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    sep
                         [ String -> SDoc
    text String
    "Both DeriveAnyClass and"
                           SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "GeneralizedNewtypeDeriving are enabled"
                         , String -> SDoc
    text String
    "Defaulting to the DeriveAnyClass strategy"
                           SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "for instantiating" SDoc -> SDoc -> SDoc
    <+> Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls
                         ]
        TcRnNonUnaryTypeclassConstraint LHsSigType GhcRn
    ct
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> SDoc
    quotes (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigType GhcRn
    GenLocated SrcSpanAnnA (HsSigType GhcRn)
    ct)
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not a unary constraint, as expected by a deriving clause"
        TcRnPartialTypeSignatures SuggestPartialTypeSignatures
    _ [Type]
    theta
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Found type wildcard" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Char -> SDoc
    char Char
    '_')
                           SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "standing for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes ([Type] -> SDoc
    pprTheta [Type]
    theta)
        TcRnCannotDeriveInstance Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving DeriveInstanceErrReason
    reason
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> DeriveInstanceErrReason
    -> SDoc
    derivErrDiagnosticMessage Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    True DeriveInstanceErrReason
    reason
        TcRnMessage
    TcRnLazyGADTPattern
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "An existential or GADT data constructor cannot be used")
                  Int
    2 (String -> SDoc
    text String
    "inside a lazy (~) pattern")
        TcRnMessage
    TcRnArrowProcGADTPattern
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Proc patterns cannot use existential or GADT data constructors"

        TcRnSpecialClassInst Class
    cls Bool
    because_safeHaskell
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                String -> SDoc
    text String
    "Class" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> SDoc) -> Name -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Class -> Name
    className Class
    cls)
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "does not support user-specified instances"
                       SDoc -> SDoc -> SDoc
    <> SDoc
    safeHaskell_msg
              where
                safeHaskell_msg :: SDoc
    safeHaskell_msg
                  | Bool
    because_safeHaskell
                  = String -> SDoc
    text String
    " when Safe Haskell is enabled."
                  | Bool
    otherwise
                  = SDoc
    dot
        TcRnForallIdentifier RdrName
    rdr_name
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                [SDoc] -> SDoc
    fsep [ String -> SDoc
    text String
    "The use of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name)
                                         SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "as an identifier",
                       String -> SDoc
    text String
    "will become an error in a future GHC release." ]
        TcRnMessage
    TcRnTypeEqualityOutOfScope
          -> [SDoc] -> DecoratedSDoc
    mkDecorated
               [ String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "~") SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "operator is out of scope." SDoc -> SDoc -> SDoc
    $$
                 String -> SDoc
    text String
    "Assuming it to stand for an equality constraint."
               , String -> SDoc
    text String
    "NB:" SDoc -> SDoc -> SDoc
    <+> (SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "~") SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "used to be built-in syntax but now is a regular type operator" SDoc -> SDoc -> SDoc
    $$
                                 String -> SDoc
    text String
    "exported from Data.Type.Equality and Prelude.") SDoc -> SDoc -> SDoc
    $$
                 String -> SDoc
    text String
    "If you are using a custom Prelude, consider re-exporting it."
               , String -> SDoc
    text String
    "This will become an error in a future GHC release." ]
        TcRnMessage
    TcRnTypeEqualityRequiresOperators
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                [SDoc] -> SDoc
    fsep [ String -> SDoc
    text String
    "The use of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "~")
                                         SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "without TypeOperators",
                       String -> SDoc
    text String
    "will become an error in a future GHC release." ]
        TcRnIllegalTypeOperator SDoc
    overall_ty RdrName
    op
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "Illegal operator" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    op) SDoc -> SDoc -> SDoc
    <+>
               String -> SDoc
    text String
    "in type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (SDoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SDoc
    overall_ty)
        TcRnMessage
    TcRnGADTMonoLocalBinds
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                [SDoc] -> SDoc
    fsep [ String -> SDoc
    text String
    "Pattern matching on GADTs without MonoLocalBinds"
                     , String -> SDoc
    text String
    "is fragile." ]
        TcRnIncorrectNameSpace Name
    name Bool
    _
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc
    msg
            where
              msg :: SDoc
    msg
                -- We are in a type-level namespace,
                -- and the name is incorrectly at the term-level.
                | NameSpace -> Bool
    isValNameSpace NameSpace
    ns
                = String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "does not live in the type-level namespace"

                -- We are in a term-level namespace,
                -- and the name is incorrectly at the type-level.
                | Bool
    otherwise
                = String -> SDoc
    text String
    "Illegal term-level use of the" SDoc -> SDoc -> SDoc
    <+> SDoc
    what
              ns :: NameSpace
    ns = Name -> NameSpace
    nameNameSpace Name
    name
              what :: SDoc
    what = NameSpace -> SDoc
    pprNameSpace NameSpace
    ns SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name)
        TcRnNotInScope NotInScopeError
    err RdrName
    name [ImportError]
    imp_errs [GhcHint]
    _
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               RdrName -> NotInScopeError -> SDoc
    pprScopeError RdrName
    name NotInScopeError
    err SDoc -> SDoc -> SDoc
    $$ [SDoc] -> SDoc
    vcat ((ImportError -> SDoc) -> [ImportError] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ImportError -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ImportError]
    imp_errs)
        TcRnUntickedPromotedThing UntickedPromotedThing
    thing
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
             String -> SDoc
    text String
    "Unticked promoted" SDoc -> SDoc -> SDoc
    <+> SDoc
    what
               where
                 what :: SDoc
                 what :: SDoc
    what = case UntickedPromotedThing
    thing of
                   UntickedPromotedThing
    UntickedExplicitList -> String -> SDoc
    text String
    "list" SDoc -> SDoc -> SDoc
    <> SDoc
    dot
                   UntickedConstructor LexicalFixity
    fixity Name
    nm ->
                     let con :: SDoc
    con      = LexicalFixity -> Name -> SDoc
    pprUntickedConstructor LexicalFixity
    fixity Name
    nm
                         bare_sym :: Bool
    bare_sym = LexicalFixity -> Name -> Bool
    isBareSymbol LexicalFixity
    fixity Name
    nm
                     in String -> SDoc
    text String
    "constructor:" SDoc -> SDoc -> SDoc
    <+> SDoc
    con SDoc -> SDoc -> SDoc
    <> if Bool
    bare_sym then SDoc
    empty else SDoc
    dot
        TcRnIllegalBuiltinSyntax SDoc
    what RdrName
    rdr_name
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    hsep [String -> SDoc
    text String
    "Illegal", SDoc
    what, String -> SDoc
    text String
    "of built-in syntax:", RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name]
        TcRnWarnDefaulting [Ct]
    tidy_wanteds Maybe TcTyVar
    tidy_tv Type
    default_ty
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> Int -> SDoc -> SDoc
    hang ([SDoc] -> SDoc
    hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [ String -> SDoc
    text String
    "Defaulting" ]
                         [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
                         (case Maybe TcTyVar
    tidy_tv of
                             Maybe TcTyVar
    Nothing -> []
                             Just TcTyVar
    tv -> [String -> SDoc
    text String
    "the type variable"
                                        , SDoc -> SDoc
    quotes (TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv)])
                         [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
                         [ String -> SDoc
    text String
    "to type"
                         , SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    default_ty)
                         , String -> SDoc
    text String
    "in the following constraint" SDoc -> SDoc -> SDoc
    <> [Ct] -> SDoc
    forall a. [a] -> SDoc
    plural [Ct]
    tidy_wanteds ])
                 Int
    2
                 ([Ct] -> SDoc
    pprWithArising [Ct]
    tidy_wanteds)

        TcRnForeignImportPrimExtNotSet ForeignImport
    _decl
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "`foreign import prim' requires GHCForeignImportPrim."

        TcRnForeignImportPrimSafeAnn ForeignImport
    _decl
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "The safe/unsafe annotation should not be used with `foreign import prim'."

        TcRnForeignFunctionImportAsValue ForeignImport
    _decl
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "`value' imports cannot have function types"

        TcRnFunPtrImportWithoutAmpersand ForeignImport
    _decl
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    "possible missing & in foreign import of FunPtr"

        TcRnIllegalForeignDeclBackend Either ForeignExport ForeignImport
    _decl Backend
    _backend ExpectedBackends
    expectedBknds
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Illegal foreign declaration:" SDoc -> SDoc -> SDoc
    <+>
               case ExpectedBackends
    expectedBknds of
                 ExpectedBackends
    COrAsmOrLlvm ->
                   String -> SDoc
    text String
    "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)"
                 ExpectedBackends
    COrAsmOrLlvmOrInterp ->
                   String -> SDoc
    text String
    "requires interpreted, unregisterised, llvm or native code generation"

        TcRnUnsupportedCallConv Either ForeignExport ForeignImport
    _decl UnsupportedCallConvention
    unsupportedCC
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               case UnsupportedCallConvention
    unsupportedCC of
                 UnsupportedCallConvention
    StdCallConvUnsupported ->
                   String -> SDoc
    text String
    "the 'stdcall' calling convention is unsupported on this platform,"
                   SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "treating as ccall"
                 UnsupportedCallConvention
    PrimCallConvUnsupported ->
                   String -> SDoc
    text String
    "The `prim' calling convention can only be used with `foreign import'"
                 UnsupportedCallConvention
    JavaScriptCallConvUnsupported ->
                   String -> SDoc
    text String
    "The `javascript' calling convention is unsupported on this platform"

        TcRnIllegalForeignType Maybe ArgOrResult
    mArgOrResult IllegalForeignTypeReason
    reason
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    msg Int
    2 SDoc
    extra
          where
            arg_or_res :: SDoc
    arg_or_res = case Maybe ArgOrResult
    mArgOrResult of
              Maybe ArgOrResult
    Nothing -> SDoc
    empty
              Just ArgOrResult
    Arg -> String -> SDoc
    text String
    "argument"
              Just ArgOrResult
    Result -> String -> SDoc
    text String
    "result"
            msg :: SDoc
    msg = [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "Unacceptable", SDoc
    arg_or_res
                       , String -> SDoc
    text String
    "type in foreign declaration:"]
            extra :: SDoc
    extra =
              case IllegalForeignTypeReason
    reason of
                TypeCannotBeMarshaled Type
    ty TypeCannotBeMarshaledReason
    why ->
                  let innerMsg :: SDoc
    innerMsg = SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "cannot be marshalled in a foreign call"
                   in case TypeCannotBeMarshaledReason
    why of
                    TypeCannotBeMarshaledReason
    NotADataType ->
                      SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not a data type"
                    NewtypeDataConNotInScope Maybe TyCon
    Nothing ->
                      SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    innerMsg Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "because its data constructor is not in scope"
                    NewtypeDataConNotInScope (Just TyCon
    tc) ->
                      SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    innerMsg Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                        String -> SDoc
    text String
    "because the data constructor for"
                        SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not in scope"
                    TypeCannotBeMarshaledReason
    UnliftedFFITypesNeeded ->
                      SDoc
    innerMsg SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "UnliftedFFITypes is required to marshal unlifted types"
                    TypeCannotBeMarshaledReason
    NotABoxedMarshalableTyCon -> SDoc
    innerMsg
                    TypeCannotBeMarshaledReason
    ForeignLabelNotAPtr ->
                      SDoc
    innerMsg SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)"
                    TypeCannotBeMarshaledReason
    NotSimpleUnliftedType ->
                      SDoc
    innerMsg SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "foreign import prim only accepts simple unlifted types"
                ForeignDynNotPtr Type
    expected Type
    ty ->
                  [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Expected: Ptr/FunPtr" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprParendType Type
    expected SDoc -> SDoc -> SDoc
    <> SDoc
    comma, String -> SDoc
    text String
    "  Actual:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty ]
                IllegalForeignTypeReason
    SafeHaskellMustBeInIO ->
                  String -> SDoc
    text String
    "Safe Haskell is on, all FFI imports must be in the IO monad"
                IllegalForeignTypeReason
    IOResultExpected ->
                  String -> SDoc
    text String
    "IO result type expected"
                IllegalForeignTypeReason
    UnexpectedNestedForall ->
                  String -> SDoc
    text String
    "Unexpected nested forall"
                IllegalForeignTypeReason
    LinearTypesNotAllowed ->
                  String -> SDoc
    text String
    "Linear types are not supported in FFI declarations, see #18472"
                IllegalForeignTypeReason
    OneArgExpected ->
                  String -> SDoc
    text String
    "One argument expected"
                IllegalForeignTypeReason
    AtLeastOneArgExpected ->
                  String -> SDoc
    text String
    "At least one argument expected"
        TcRnInvalidCIdentifier FieldLabelString
    target
          -> SDoc -> DecoratedSDoc
    mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    sep [SDoc -> SDoc
    quotes (FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FieldLabelString
    target) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not a valid C identifier"]

      diagnosticReason :: TcRnMessage -> DiagnosticReason
    diagnosticReason = \case
        TcRnUnknownMessage a
    m
          -> a -> DiagnosticReason
    forall a. Diagnostic a => a -> DiagnosticReason
    diagnosticReason a
    m
        TcRnMessageWithInfo UnitState
    _ TcRnMessageDetailed
    msg_with_info
          -> case TcRnMessageDetailed
    msg_with_info of
               TcRnMessageDetailed ErrInfo
    _ TcRnMessage
    m -> TcRnMessage -> DiagnosticReason
    forall a. Diagnostic a => a -> DiagnosticReason
    diagnosticReason TcRnMessage
    m
        TcRnSolverReport [SolverReportWithCtxt]
    _ DiagnosticReason
    reason [GhcHint]
    _
          -> DiagnosticReason
    reason -- Error, or a Warning if we are deferring type errors
        TcRnRedundantConstraints {}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnRedundantConstraints
        TcRnInaccessibleCode {}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnInaccessibleCode
        TcRnTypeDoesNotHaveFixedRuntimeRep{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnImplicitLift{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnImplicitLift
        TcRnUnusedPatternBinds{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnUnusedPatternBinds
        TcRnDodgyImports{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDodgyImports
        TcRnDodgyExports{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDodgyExports
        TcRnMissingImportList{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnMissingImportList
        TcRnUnsafeDueToPlugin{}
          -> DiagnosticReason
    WarningWithoutFlag
        TcRnModMissingRealSrcSpan{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIdNotExportedFromModuleSig{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIdNotExportedFromLocalSig{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnShadowedName{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnNameShadowing
        TcRnDuplicateWarningDecls{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnSimplifierTooManyIterations{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalPatSynDecl{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnLinearPatSyn{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMessage
    TcRnEmptyRecordUpdate
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalFieldPunning{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalWildcardsInRecord{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalWildcardInType{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnDuplicateFieldName{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalViewPattern{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnCharLiteralOutOfRange{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalWildcardsInConstructor{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIgnoringAnnotations{}
          -> DiagnosticReason
    WarningWithoutFlag
        TcRnMessage
    TcRnAnnotationInSafeHaskell
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnInvalidTypeApplication{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMessage
    TcRnTagToEnumMissingValArg
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnTagToEnumUnspecifiedResTy{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnTagToEnumResTyNotAnEnum{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMessage
    TcRnArrowIfThenElsePredDependsOnResultTy
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMessage
    TcRnIllegalHsBootFileDecl
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnRecursivePatternSynonym{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnPartialTypeSigTyVarMismatch{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnPartialTypeSigBadQuantifier{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMissingSignature MissingSignature
    what Exported
    exported Bool
    overridden
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag (WarningFlag -> DiagnosticReason)
    -> WarningFlag -> DiagnosticReason
    forall a b. (a -> b) -> a -> b
    $ MissingSignature -> Exported -> Bool -> WarningFlag
    missingSignatureWarningFlag MissingSignature
    what Exported
    exported Bool
    overridden
        TcRnPolymorphicBinderMissingSig{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnMissingLocalSignatures
        TcRnOverloadedSig{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnTupleConstraintInst{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnAbstractClassInst{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnNoClassInstHead{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnUserTypeError{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnConstraintInKind{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnUnboxedTupleOrSumTypeFuncArg{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnLinearFuncInKind{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnForAllEscapeError{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnVDQInTermType{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnBadQuantPredHead{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalTupleConstraint{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnNonTypeVarArgInConstraint{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalImplicitParam{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalConstraintSynonymOfKind{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalClassInst{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnOversaturatedVisibleKindArg{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnBadAssociatedType{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnForAllRankErr{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMonomorphicBindings{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnMonomorphism
        TcRnOrphanInstance{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnOrphans
        TcRnFunDepConflict{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnDupInstanceDecls{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnConflictingFamInstDecls{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnFamInstNotInjective{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnBangOnUnliftedType{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnRedundantStrictnessFlags
        TcRnMultipleDefaultDeclarations{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnBadDefaultType{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnPatSynBundledWithNonDataCon{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnPatSynBundledWithWrongType{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnDupeModuleExport{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDuplicateExports
        TcRnExportedModNotImported{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnNullExportedModule{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDodgyExports
        TcRnMissingExportList{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnMissingExportList
        TcRnExportHiddenComponents{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnDuplicateExport{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDuplicateExports
        TcRnExportedParentChildMismatch{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnConflictingExports{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnAmbiguousField{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnAmbiguousFields
        TcRnMissingFields{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnMissingFields
        TcRnFieldUpdateInvalidType{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnNoConstructorHasAllFields{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMixedSelectors{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMissingStrictFields{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnNoPossibleParentForFields{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnBadOverloadedRecordUpdate{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnStaticFormNotClosed{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMessage
    TcRnUselessTypeable
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDerivingTypeable
        TcRnDerivingDefaults{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDerivingDefaults
        TcRnNonUnaryTypeclassConstraint{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnPartialTypeSignatures{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnPartialTypeSignatures
        TcRnCannotDeriveInstance Class
    _ [Type]
    _ Maybe (DerivStrategy GhcTc)
    _ UsingGeneralizedNewtypeDeriving
    _ DeriveInstanceErrReason
    rea
          -> case DeriveInstanceErrReason
    rea of
               DerivErrNotWellKinded{}                 -> DiagnosticReason
    ErrorWithoutFlag
               DeriveInstanceErrReason
    DerivErrSafeHaskellGenericInst          -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrDerivingViaWrongKind{}          -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrNoEtaReduce{}                   -> DiagnosticReason
    ErrorWithoutFlag
               DeriveInstanceErrReason
    DerivErrBootFileFound                   -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrDataConsNotAllInScope{}         -> DiagnosticReason
    ErrorWithoutFlag
               DeriveInstanceErrReason
    DerivErrGNDUsedOnData                   -> DiagnosticReason
    ErrorWithoutFlag
               DeriveInstanceErrReason
    DerivErrNullaryClasses                  -> DiagnosticReason
    ErrorWithoutFlag
               DeriveInstanceErrReason
    DerivErrLastArgMustBeApp                -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrNoFamilyInstance{}              -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrNotStockDeriveable{}            -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrHasAssociatedDatatypes{}        -> DiagnosticReason
    ErrorWithoutFlag
               DeriveInstanceErrReason
    DerivErrNewtypeNonDeriveableClass       -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrCannotEtaReduceEnough{}         -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrOnlyAnyClassDeriveable{}        -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrNotDeriveable{}                 -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrNotAClass{}                     -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrNoConstructors{}                -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrLangExtRequired{}               -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrDunnoHowToDeriveForType{}       -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrMustBeEnumType{}                -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrMustHaveExactlyOneConstructor{} -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrMustHaveSomeParameters{}        -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrMustNotHaveClassContext{}       -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrBadConstructor{}                -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrGenerics{}                      -> DiagnosticReason
    ErrorWithoutFlag
               DerivErrEnumOrProduct{}                 -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMessage
    TcRnLazyGADTPattern
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnMessage
    TcRnArrowProcGADTPattern
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnSpecialClassInst {}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnForallIdentifier {}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnForallIdentifier
        TcRnMessage
    TcRnTypeEqualityOutOfScope
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnTypeEqualityOutOfScope
        TcRnMessage
    TcRnTypeEqualityRequiresOperators
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnTypeEqualityRequiresOperators
        TcRnIllegalTypeOperator {}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnGADTMonoLocalBinds {}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnGADTMonoLocalBinds
        TcRnIncorrectNameSpace {}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnNotInScope {}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnUntickedPromotedThing {}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnUntickedPromotedConstructors
        TcRnIllegalBuiltinSyntax {}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnWarnDefaulting {}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnTypeDefaults
        TcRnForeignImportPrimExtNotSet{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnForeignImportPrimSafeAnn{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnForeignFunctionImportAsValue{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnFunPtrImportWithoutAmpersand{}
          -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnDodgyForeignImports
        TcRnIllegalForeignDeclBackend{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnUnsupportedCallConv Either ForeignExport ForeignImport
    _ UnsupportedCallConvention
    unsupportedCC
          -> case UnsupportedCallConvention
    unsupportedCC of
               UnsupportedCallConvention
    StdCallConvUnsupported -> WarningFlag -> DiagnosticReason
    WarningWithFlag WarningFlag
    Opt_WarnUnsupportedCallingConventions
               UnsupportedCallConvention
    _ -> DiagnosticReason
    ErrorWithoutFlag
        TcRnIllegalForeignType{}
          -> DiagnosticReason
    ErrorWithoutFlag
        TcRnInvalidCIdentifier{}
          -> DiagnosticReason
    ErrorWithoutFlag

      diagnosticHints :: TcRnMessage -> [GhcHint]
    diagnosticHints = \case
        TcRnUnknownMessage a
    m
          -> a -> [GhcHint]
    forall a. Diagnostic a => a -> [GhcHint]
    diagnosticHints a
    m
        TcRnMessageWithInfo UnitState
    _ TcRnMessageDetailed
    msg_with_info
          -> case TcRnMessageDetailed
    msg_with_info of
               TcRnMessageDetailed ErrInfo
    _ TcRnMessage
    m -> TcRnMessage -> [GhcHint]
    forall a. Diagnostic a => a -> [GhcHint]
    diagnosticHints TcRnMessage
    m
        TcRnSolverReport [SolverReportWithCtxt]
    _ DiagnosticReason
    _ [GhcHint]
    hints
          -> [GhcHint]
    hints
        TcRnRedundantConstraints{}
          -> [GhcHint]
    noHints
        TcRnInaccessibleCode{}
          -> [GhcHint]
    noHints
        TcRnTypeDoesNotHaveFixedRuntimeRep{}
          -> [GhcHint]
    noHints
        TcRnImplicitLift{}
          -> [GhcHint]
    noHints
        TcRnUnusedPatternBinds{}
          -> [GhcHint]
    noHints
        TcRnDodgyImports{}
          -> [GhcHint]
    noHints
        TcRnDodgyExports{}
          -> [GhcHint]
    noHints
        TcRnMissingImportList{}
          -> [GhcHint]
    noHints
        TcRnUnsafeDueToPlugin{}
          -> [GhcHint]
    noHints
        TcRnModMissingRealSrcSpan{}
          -> [GhcHint]
    noHints
        TcRnIdNotExportedFromModuleSig Name
    name Module
    mod
          -> [Name -> Maybe Module -> GhcHint
    SuggestAddToHSigExportList Name
    name (Maybe Module -> GhcHint) -> Maybe Module -> GhcHint
    forall a b. (a -> b) -> a -> b
    $ Module -> Maybe Module
    forall a. a -> Maybe a
    Just Module
    mod]
        TcRnIdNotExportedFromLocalSig Name
    name
          -> [Name -> Maybe Module -> GhcHint
    SuggestAddToHSigExportList Name
    name Maybe Module
    forall a. Maybe a
    Nothing]
        TcRnShadowedName{}
          -> [GhcHint]
    noHints
        TcRnDuplicateWarningDecls{}
          -> [GhcHint]
    noHints
        TcRnSimplifierTooManyIterations{}
          -> [GhcHint
    SuggestIncreaseSimplifierIterations]
        TcRnIllegalPatSynDecl{}
          -> [GhcHint]
    noHints
        TcRnLinearPatSyn{}
          -> [GhcHint]
    noHints
        TcRnEmptyRecordUpdate{}
          -> [GhcHint]
    noHints
        TcRnIllegalFieldPunning{}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.NamedFieldPuns]
        TcRnIllegalWildcardsInRecord{}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.RecordWildCards]
        TcRnIllegalWildcardInType{}
          -> [GhcHint]
    noHints
        TcRnDuplicateFieldName{}
          -> [GhcHint]
    noHints
        TcRnIllegalViewPattern{}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.ViewPatterns]
        TcRnCharLiteralOutOfRange{}
          -> [GhcHint]
    noHints
        TcRnIllegalWildcardsInConstructor{}
          -> [GhcHint]
    noHints
        TcRnIgnoringAnnotations{}
          -> [GhcHint]
    noHints
        TcRnMessage
    TcRnAnnotationInSafeHaskell
          -> [GhcHint]
    noHints
        TcRnInvalidTypeApplication{}
          -> [GhcHint]
    noHints
        TcRnMessage
    TcRnTagToEnumMissingValArg
          -> [GhcHint]
    noHints
        TcRnTagToEnumUnspecifiedResTy{}
          -> [GhcHint]
    noHints
        TcRnTagToEnumResTyNotAnEnum{}
          -> [GhcHint]
    noHints
        TcRnMessage
    TcRnArrowIfThenElsePredDependsOnResultTy
          -> [GhcHint]
    noHints
        TcRnMessage
    TcRnIllegalHsBootFileDecl
          -> [GhcHint]
    noHints
        TcRnRecursivePatternSynonym{}
          -> [GhcHint]
    noHints
        TcRnPartialTypeSigTyVarMismatch{}
          -> [GhcHint]
    noHints
        TcRnPartialTypeSigBadQuantifier{}
          -> [GhcHint]
    noHints
        TcRnMissingSignature {}
          -> [GhcHint]
    noHints
        TcRnPolymorphicBinderMissingSig{}
          -> [GhcHint]
    noHints
        TcRnOverloadedSig{}
          -> [GhcHint]
    noHints
        TcRnTupleConstraintInst{}
          -> [GhcHint]
    noHints
        TcRnAbstractClassInst{}
          -> [GhcHint]
    noHints
        TcRnNoClassInstHead{}
          -> [GhcHint]
    noHints
        TcRnUserTypeError{}
          -> [GhcHint]
    noHints
        TcRnConstraintInKind{}
          -> [GhcHint]
    noHints
        TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
    tuple_or_sum Type
    _
          -> [Extension -> GhcHint
    suggestExtension (Extension -> GhcHint) -> Extension -> GhcHint
    forall a b. (a -> b) -> a -> b
    $ UnboxedTupleOrSum -> Extension
    unboxedTupleOrSumExtension UnboxedTupleOrSum
    tuple_or_sum]
        TcRnLinearFuncInKind{}
          -> [GhcHint]
    noHints
        TcRnForAllEscapeError{}
          -> [GhcHint]
    noHints
        TcRnVDQInTermType{}
          -> [GhcHint]
    noHints
        TcRnBadQuantPredHead{}
          -> [GhcHint]
    noHints
        TcRnIllegalTupleConstraint{}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.ConstraintKinds]
        TcRnNonTypeVarArgInConstraint{}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.FlexibleContexts]
        TcRnIllegalImplicitParam{}
          -> [GhcHint]
    noHints
        TcRnIllegalConstraintSynonymOfKind{}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.ConstraintKinds]
        TcRnIllegalClassInst{}
          -> [GhcHint]
    noHints
        TcRnOversaturatedVisibleKindArg{}
          -> [GhcHint]
    noHints
        TcRnBadAssociatedType{}
          -> [GhcHint]
    noHints
        TcRnForAllRankErr Rank
    rank Type
    _
          -> case Rank
    rank of
               LimitedRank{}      -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.RankNTypes]
               Rank
    MonoTypeRankZero   -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.RankNTypes]
               Rank
    MonoTypeTyConArg   -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.ImpredicativeTypes]
               Rank
    MonoTypeSynArg     -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.LiberalTypeSynonyms]
               Rank
    MonoTypeConstraint -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.QuantifiedConstraints]
               Rank
    _                  -> [GhcHint]
    noHints
        TcRnMonomorphicBindings [Name]
    bindings
          -> case [Name]
    bindings of
              []     -> [GhcHint]
    noHints
              (Name
    x:[Name]
    xs) -> [AvailableBindings -> GhcHint
    SuggestAddTypeSignatures (AvailableBindings -> GhcHint) -> AvailableBindings -> GhcHint
    forall a b. (a -> b) -> a -> b
    $ NonEmpty Name -> AvailableBindings
    NamedBindings (Name
    x Name -> [Name] -> NonEmpty Name
    forall a. a -> [a] -> NonEmpty a
    NE.:| [Name]
    xs)]
        TcRnOrphanInstance{}
          -> [GhcHint
    SuggestFixOrphanInstance]
        TcRnFunDepConflict{}
          -> [GhcHint]
    noHints
        TcRnDupInstanceDecls{}
          -> [GhcHint]
    noHints
        TcRnConflictingFamInstDecls{}
          -> [GhcHint]
    noHints
        TcRnFamInstNotInjective InjectivityErrReason
    rea TyCon
    _ NonEmpty CoAxBranch
    _
          -> case InjectivityErrReason
    rea of
               InjErrRhsBareTyVar{}      -> [GhcHint]
    noHints
               InjectivityErrReason
    InjErrRhsCannotBeATypeFam -> [GhcHint]
    noHints
               InjectivityErrReason
    InjErrRhsOverlap          -> [GhcHint]
    noHints
               InjErrCannotInferFromRhs TyVarSet
    _ HasKinds
    _ SuggestUndecidableInstances
    suggestUndInst
                 | SuggestUndecidableInstances
    YesSuggestUndecidableInstaces <- SuggestUndecidableInstances
    suggestUndInst
                 -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.UndecidableInstances]
                 | Bool
    otherwise
                 -> [GhcHint]
    noHints
        TcRnBangOnUnliftedType{}
          -> [GhcHint]
    noHints
        TcRnMultipleDefaultDeclarations{}
          -> [GhcHint]
    noHints
        TcRnBadDefaultType{}
          -> [GhcHint]
    noHints
        TcRnPatSynBundledWithNonDataCon{}
          -> [GhcHint]
    noHints
        TcRnPatSynBundledWithWrongType{}
          -> [GhcHint]
    noHints
        TcRnDupeModuleExport{}
          -> [GhcHint]
    noHints
        TcRnExportedModNotImported{}
          -> [GhcHint]
    noHints
        TcRnNullExportedModule{}
          -> [GhcHint]
    noHints
        TcRnMissingExportList{}
          -> [GhcHint]
    noHints
        TcRnExportHiddenComponents{}
          -> [GhcHint]
    noHints
        TcRnDuplicateExport{}
          -> [GhcHint]
    noHints
        TcRnExportedParentChildMismatch{}
          -> [GhcHint]
    noHints
        TcRnConflictingExports{}
          -> [GhcHint]
    noHints
        TcRnAmbiguousField{}
          -> [GhcHint]
    noHints
        TcRnMissingFields{}
          -> [GhcHint]
    noHints
        TcRnFieldUpdateInvalidType{}
          -> [GhcHint]
    noHints
        TcRnNoConstructorHasAllFields{}
          -> [GhcHint]
    noHints
        TcRnMixedSelectors{}
          -> [GhcHint]
    noHints
        TcRnMissingStrictFields{}
          -> [GhcHint]
    noHints
        TcRnNoPossibleParentForFields{}
          -> [GhcHint]
    noHints
        TcRnBadOverloadedRecordUpdate{}
          -> [GhcHint]
    noHints
        TcRnStaticFormNotClosed{}
          -> [GhcHint]
    noHints
        TcRnMessage
    TcRnUselessTypeable
          -> [GhcHint]
    noHints
        TcRnDerivingDefaults{}
          -> [GhcHint
    useDerivingStrategies]
        TcRnNonUnaryTypeclassConstraint{}
          -> [GhcHint]
    noHints
        TcRnPartialTypeSignatures SuggestPartialTypeSignatures
    suggestParSig [Type]
    _
          -> case SuggestPartialTypeSignatures
    suggestParSig of
               SuggestPartialTypeSignatures
    YesSuggestPartialTypeSignatures
                 -> let info :: SDoc
    info = String -> SDoc
    text String
    "to use the inferred type"
                    in [SDoc -> Extension -> GhcHint
    suggestExtensionWithInfo SDoc
    info Extension
    LangExt.PartialTypeSignatures]
               SuggestPartialTypeSignatures
    NoSuggestPartialTypeSignatures
                 -> [GhcHint]
    noHints
        TcRnCannotDeriveInstance Class
    cls [Type]
    _ Maybe (DerivStrategy GhcTc)
    _ UsingGeneralizedNewtypeDeriving
    newtype_deriving DeriveInstanceErrReason
    rea
          -> Class
    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason
    -> [GhcHint]
    deriveInstanceErrReasonHints Class
    cls UsingGeneralizedNewtypeDeriving
    newtype_deriving DeriveInstanceErrReason
    rea
        TcRnMessage
    TcRnLazyGADTPattern
          -> [GhcHint]
    noHints
        TcRnMessage
    TcRnArrowProcGADTPattern
          -> [GhcHint]
    noHints
        TcRnSpecialClassInst {}
          -> [GhcHint]
    noHints
        TcRnForallIdentifier {}
          -> [GhcHint
    SuggestRenameForall]
        TcRnMessage
    TcRnTypeEqualityOutOfScope
          -> [GhcHint]
    noHints
        TcRnMessage
    TcRnTypeEqualityRequiresOperators
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.TypeOperators]
        TcRnIllegalTypeOperator {}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.TypeOperators]
        TcRnGADTMonoLocalBinds {}
          -> [[Extension] -> GhcHint
    suggestAnyExtension [Extension
    LangExt.GADTs, Extension
    LangExt.TypeFamilies]]
        TcRnIncorrectNameSpace Name
    nm Bool
    is_th_use
          | Bool
    is_th_use
          -> [NameSpace -> GhcHint
    SuggestAppropriateTHTick (NameSpace -> GhcHint) -> NameSpace -> GhcHint
    forall a b. (a -> b) -> a -> b
    $ Name -> NameSpace
    nameNameSpace Name
    nm]
          | Bool
    otherwise
          -> [GhcHint]
    noHints
        TcRnNotInScope NotInScopeError
    err RdrName
    _ [ImportError]
    _ [GhcHint]
    hints
          -> NotInScopeError -> [GhcHint]
    scopeErrorHints NotInScopeError
    err [GhcHint] -> [GhcHint] -> [GhcHint]
    forall a. [a] -> [a] -> [a]
    ++ [GhcHint]
    hints
        TcRnUntickedPromotedThing UntickedPromotedThing
    thing
          -> [UntickedPromotedThing -> GhcHint
    SuggestAddTick UntickedPromotedThing
    thing]
        TcRnIllegalBuiltinSyntax {}
          -> [GhcHint]
    noHints
        TcRnWarnDefaulting {}
          -> [GhcHint]
    noHints
        TcRnForeignImportPrimExtNotSet{}
          -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.GHCForeignImportPrim]
        TcRnForeignImportPrimSafeAnn{}
          -> [GhcHint]
    noHints
        TcRnForeignFunctionImportAsValue{}
          -> [GhcHint]
    noHints
        TcRnFunPtrImportWithoutAmpersand{}
          -> [GhcHint]
    noHints
        TcRnIllegalForeignDeclBackend{}
          -> [GhcHint]
    noHints
        TcRnUnsupportedCallConv{}
          -> [GhcHint]
    noHints
        TcRnIllegalForeignType Maybe ArgOrResult
    _ IllegalForeignTypeReason
    reason
          -> case IllegalForeignTypeReason
    reason of
               TypeCannotBeMarshaled Type
    _ TypeCannotBeMarshaledReason
    why
                 | NewtypeDataConNotInScope{} <- TypeCannotBeMarshaledReason
    why -> [GhcHint
    SuggestImportingDataCon]
                 | TypeCannotBeMarshaledReason
    UnliftedFFITypesNeeded <- TypeCannotBeMarshaledReason
    why -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.UnliftedFFITypes]
               IllegalForeignTypeReason
    _ -> [GhcHint]
    noHints
        TcRnInvalidCIdentifier{}
          -> [GhcHint]
    noHints

    deriveInstanceErrReasonHints :: Class
                                 -> UsingGeneralizedNewtypeDeriving
                                 -> DeriveInstanceErrReason
                                 -> [GhcHint]
    deriveInstanceErrReasonHints :: Class
    -> UsingGeneralizedNewtypeDeriving
    -> DeriveInstanceErrReason
    -> [GhcHint]
    deriveInstanceErrReasonHints Class
    cls UsingGeneralizedNewtypeDeriving
    newtype_deriving = \case
      DerivErrNotWellKinded TyCon
    _ Type
    _ Int
    n_args_to_keep
        | Class
    cls Class -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    gen1ClassKey Bool -> Bool -> Bool
    && Int
    n_args_to_keep Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0
        -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.PolyKinds]
        | Bool
    otherwise
        -> [GhcHint]
    noHints
      DeriveInstanceErrReason
    DerivErrSafeHaskellGenericInst  -> [GhcHint]
    noHints
      DerivErrDerivingViaWrongKind{}  -> [GhcHint]
    noHints
      DerivErrNoEtaReduce{}           -> [GhcHint]
    noHints
      DeriveInstanceErrReason
    DerivErrBootFileFound           -> [GhcHint]
    noHints
      DerivErrDataConsNotAllInScope{} -> [GhcHint]
    noHints
      DeriveInstanceErrReason
    DerivErrGNDUsedOnData           -> [GhcHint]
    noHints
      DeriveInstanceErrReason
    DerivErrNullaryClasses          -> [GhcHint]
    noHints
      DeriveInstanceErrReason
    DerivErrLastArgMustBeApp        -> [GhcHint]
    noHints
      DerivErrNoFamilyInstance{}      -> [GhcHint]
    noHints
      DerivErrNotStockDeriveable DeriveAnyClassEnabled
    deriveAnyClassEnabled
        | DeriveAnyClassEnabled
    deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
    forall a. Eq a => a -> a -> Bool
    == DeriveAnyClassEnabled
    NoDeriveAnyClassEnabled
        -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.DeriveAnyClass]
        | Bool
    otherwise
        -> [GhcHint]
    noHints
      DerivErrHasAssociatedDatatypes{}
        -> [GhcHint]
    noHints
      DeriveInstanceErrReason
    DerivErrNewtypeNonDeriveableClass
        | UsingGeneralizedNewtypeDeriving
    newtype_deriving UsingGeneralizedNewtypeDeriving
    -> UsingGeneralizedNewtypeDeriving -> Bool
    forall a. Eq a => a -> a -> Bool
    == UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving
        -> [GhcHint
    useGND]
        | Bool
    otherwise
        -> [GhcHint]
    noHints
      DerivErrCannotEtaReduceEnough{}
        | UsingGeneralizedNewtypeDeriving
    newtype_deriving UsingGeneralizedNewtypeDeriving
    -> UsingGeneralizedNewtypeDeriving -> Bool
    forall a. Eq a => a -> a -> Bool
    == UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving
        -> [GhcHint
    useGND]
        | Bool
    otherwise
        -> [GhcHint]
    noHints
      DerivErrOnlyAnyClassDeriveable TyCon
    _ DeriveAnyClassEnabled
    deriveAnyClassEnabled
        | DeriveAnyClassEnabled
    deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
    forall a. Eq a => a -> a -> Bool
    == DeriveAnyClassEnabled
    NoDeriveAnyClassEnabled
        -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.DeriveAnyClass]
        | Bool
    otherwise
        -> [GhcHint]
    noHints
      DerivErrNotDeriveable DeriveAnyClassEnabled
    deriveAnyClassEnabled
        | DeriveAnyClassEnabled
    deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
    forall a. Eq a => a -> a -> Bool
    == DeriveAnyClassEnabled
    NoDeriveAnyClassEnabled
        -> [Extension -> GhcHint
    suggestExtension Extension
    LangExt.DeriveAnyClass]
        | Bool
    otherwise
        -> [GhcHint]
    noHints
      DerivErrNotAClass{}
        -> [GhcHint]
    noHints
      DerivErrNoConstructors{}
        -> let info :: SDoc
    info = String -> SDoc
    text String
    "to enable deriving for empty data types"
           in [SDoc -> Extension -> GhcHint
    useExtensionInOrderTo SDoc
    info Extension
    LangExt.EmptyDataDeriving]
      DerivErrLangExtRequired{}
        -- This is a slightly weird corner case of GHC: we are failing
        -- to derive a typeclass instance because a particular 'Extension'
        -- is not enabled (and so we report in the main error), but here
        -- we don't want to /repeat/ to enable the extension in the hint.
        -> [GhcHint]
    noHints
      DerivErrDunnoHowToDeriveForType{}
        -> [GhcHint]
    noHints
      DerivErrMustBeEnumType TyCon
    rep_tc
        -- We want to suggest GND only if this /is/ a newtype.
        | UsingGeneralizedNewtypeDeriving
    newtype_deriving UsingGeneralizedNewtypeDeriving
    -> UsingGeneralizedNewtypeDeriving -> Bool
    forall a. Eq a => a -> a -> Bool
    == UsingGeneralizedNewtypeDeriving
    NoGeneralizedNewtypeDeriving Bool -> Bool -> Bool
    && TyCon -> Bool
    isNewTyCon TyCon
    rep_tc
        -> [GhcHint
    useGND]
        | Bool
    otherwise
        -> [GhcHint]
    noHints
      DerivErrMustHaveExactlyOneConstructor{}
        -> [GhcHint]
    noHints
      DerivErrMustHaveSomeParameters{}
        -> [GhcHint]
    noHints
      DerivErrMustNotHaveClassContext{}
        -> [GhcHint]
    noHints
      DerivErrBadConstructor Maybe HasWildcard
    wcard [DeriveInstanceBadConstructor]
    _
        -> case Maybe HasWildcard
    wcard of
             Maybe HasWildcard
    Nothing        -> [GhcHint]
    noHints
             Just HasWildcard
    YesHasWildcard -> [GhcHint
    SuggestFillInWildcardConstraint]
             Just HasWildcard
    NoHasWildcard  -> [GhcHint
    SuggestAddStandaloneDerivation]
      DerivErrGenerics{}
        -> [GhcHint]
    noHints
      DerivErrEnumOrProduct{}
        -> [GhcHint]
    noHints

    messageWithInfoDiagnosticMessage :: UnitState
                                     -> ErrInfo
                                     -> DecoratedSDoc
                                     -> DecoratedSDoc
    messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo -> DecoratedSDoc -> DecoratedSDoc
    messageWithInfoDiagnosticMessage UnitState
    unit_state ErrInfo{SDoc
    errInfoContext :: ErrInfo -> SDoc
    errInfoSupplementary :: ErrInfo -> SDoc
    errInfoContext :: SDoc
    errInfoSupplementary :: SDoc
    ..} DecoratedSDoc
    important =
      let err_info' :: [SDoc]
    err_info' = (SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    unit_state) [SDoc
    errInfoContext, SDoc
    errInfoSupplementary]
          in ((SDoc -> SDoc) -> DecoratedSDoc -> DecoratedSDoc
    mapDecoratedSDoc (UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    unit_state) DecoratedSDoc
    important) DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
    `unionDecoratedSDoc`
             [SDoc] -> DecoratedSDoc
    mkDecorated [SDoc]
    err_info'

    dodgy_msg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
    dodgy_msg :: forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
    dodgy_msg SDoc
    kind a
    tc b
    ie
      = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    kind SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "item"
                         SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (b -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr b
    ie)
                    SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "suggests that",
              SDoc -> SDoc
    quotes (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has (in-scope) constructors or class methods,",
              String -> SDoc
    text String
    "but it has none" ]

    dodgy_msg_insert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
    dodgy_msg_insert :: forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
    dodgy_msg_insert IdP (GhcPass p)
    tc = XIEThingAll (GhcPass p)
    -> LIEWrappedName (IdP (GhcPass p)) -> IE (GhcPass p)
    forall pass.
    XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
    IEThingAll XIEThingAll (GhcPass p)
    EpAnn [AddEpAnn]
    forall a. EpAnn a
    noAnn LIEWrappedName (IdP (GhcPass p))
    ii
      where
        ii :: LIEWrappedName (IdP (GhcPass p))
        ii :: LIEWrappedName (IdP (GhcPass p))
    ii = IEWrappedName (IdGhcP p)
    -> LocatedAn AnnListItem (IEWrappedName (IdGhcP p))
    forall a an. a -> LocatedAn an a
    noLocA (LocatedN (IdGhcP p) -> IEWrappedName (IdGhcP p)
    forall name. LocatedN name -> IEWrappedName name
    IEName (LocatedN (IdGhcP p) -> IEWrappedName (IdGhcP p))
    -> LocatedN (IdGhcP p) -> IEWrappedName (IdGhcP p)
    forall a b. (a -> b) -> a -> b
    $ IdGhcP p -> LocatedN (IdGhcP p)
    forall a an. a -> LocatedAn an a
    noLocA IdP (GhcPass p)
    IdGhcP p
    tc)

    pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
    pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
    pprTypeDoesNotHaveFixedRuntimeRep Type
    ty FixedRuntimeRepProvenance
    prov =
      let what :: SDoc
    what = FixedRuntimeRepProvenance -> SDoc
    pprFixedRuntimeRepProvenance FixedRuntimeRepProvenance
    prov
      in String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "does not have a fixed runtime representation:"
      SDoc -> SDoc -> SDoc
    $$ Type -> SDoc
    format_frr_err Type
    ty

    format_frr_err :: Type  -- ^ the type which doesn't have a fixed runtime representation
                    -> SDoc
    format_frr_err :: Type -> SDoc
    format_frr_err Type
    ty
      = (SDoc
    bullet SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    tidy_ty SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    tidy_ki)
      where
        (TidyEnv
    tidy_env, Type
    tidy_ty) = TidyEnv -> Type -> (TidyEnv, Type)
    tidyOpenType TidyEnv
    emptyTidyEnv Type
    ty
        tidy_ki :: Type
    tidy_ki             = TidyEnv -> Type -> Type
    tidyType TidyEnv
    tidy_env ((() :: Constraint) => Type -> Type
    Type -> Type
    tcTypeKind Type
    ty)

    pprField :: (FieldLabelString, TcType) -> SDoc
    pprField :: (FieldLabelString, Type) -> SDoc
    pprField (FieldLabelString
    f,Type
    ty) = FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FieldLabelString
    f SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty

    pprRecordFieldPart :: RecordFieldPart -> SDoc
    pprRecordFieldPart :: RecordFieldPart -> SDoc
    pprRecordFieldPart = \case
      RecordFieldConstructor{} -> String -> SDoc
    text String
    "construction"
      RecordFieldPattern{}     -> String -> SDoc
    text String
    "pattern"
      RecordFieldPart
    RecordFieldUpdate        -> String -> SDoc
    text String
    "update"

    pprBindings :: [Name] -> SDoc
    pprBindings :: [Name] -> SDoc
    pprBindings = (Name -> SDoc) -> [Name] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> (Name -> SDoc) -> Name -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr)

    injectivityErrorHerald :: SDoc
    injectivityErrorHerald :: SDoc
    injectivityErrorHerald =
      String -> SDoc
    text String
    "Type family equation violates the family's injectivity annotation."

    formatExportItemError :: SDoc -> String -> SDoc
    formatExportItemError :: SDoc -> String -> SDoc
    formatExportItemError SDoc
    exportedThing String
    reason =
      [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "The export item"
           , SDoc -> SDoc
    quotes SDoc
    exportedThing
           , String -> SDoc
    text String
    reason ]

    -- | What warning flag is associated with the given missing signature?
    missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
    missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
    missingSignatureWarningFlag (MissingTopLevelBindingSig {}) Exported
    exported Bool
    overridden
      | Exported
    IsExported <- Exported
    exported
      , Bool -> Bool
    not Bool
    overridden
      = WarningFlag
    Opt_WarnMissingExportedSignatures
      | Bool
    otherwise
      = WarningFlag
    Opt_WarnMissingSignatures
    missingSignatureWarningFlag (MissingPatSynSig {}) Exported
    exported Bool
    overridden
      | Exported
    IsExported <- Exported
    exported
      , Bool -> Bool
    not Bool
    overridden
      = WarningFlag
    Opt_WarnMissingExportedPatternSynonymSignatures
      | Bool
    otherwise
      = WarningFlag
    Opt_WarnMissingPatternSynonymSignatures
    missingSignatureWarningFlag (MissingTyConKindSig {}) Exported
    _ Bool
    _
      = WarningFlag
    Opt_WarnMissingKindSignatures

    useDerivingStrategies :: GhcHint
    useDerivingStrategies :: GhcHint
    useDerivingStrategies =
      SDoc -> Extension -> GhcHint
    useExtensionInOrderTo (String -> SDoc
    text String
    "to pick a different strategy") Extension
    LangExt.DerivingStrategies

    useGND :: GhcHint
    useGND :: GhcHint
    useGND = let info :: SDoc
    info = String -> SDoc
    text String
    "for GHC's" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "newtype-deriving extension"
             in SDoc -> Extension -> GhcHint
    suggestExtensionWithInfo SDoc
    info Extension
    LangExt.GeneralizedNewtypeDeriving

    cannotMakeDerivedInstanceHerald :: Class
                                    -> [Type]
                                    -> Maybe (DerivStrategy GhcTc)
                                    -> UsingGeneralizedNewtypeDeriving
                                    -> Bool -- ^ If False, only prints the why.
                                    -> SDoc
                                    -> SDoc
    cannotMakeDerivedInstanceHerald :: Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_args Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald SDoc
    why =
      if Bool
    pprHerald
         then [SDoc] -> SDoc
    sep [(SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Can't make a derived instance of")
                       Int
    2 (SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    pred) SDoc -> SDoc -> SDoc
    <+> SDoc
    via_mechanism)
                    SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    extra) SDoc -> SDoc -> SDoc
    <> SDoc
    colon,
                   Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    why]
          else SDoc
    why
      where
        strat_used :: Bool
    strat_used = Maybe (DerivStrategy GhcTc) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (DerivStrategy GhcTc)
    mb_strat
        extra :: SDoc
    extra | Bool -> Bool
    not Bool
    strat_used, (UsingGeneralizedNewtypeDeriving
    newtype_deriving UsingGeneralizedNewtypeDeriving
    -> UsingGeneralizedNewtypeDeriving -> Bool
    forall a. Eq a => a -> a -> Bool
    == UsingGeneralizedNewtypeDeriving
    YesGeneralizedNewtypeDeriving)
              = String -> SDoc
    text String
    "(even with cunning GeneralizedNewtypeDeriving)"
              | Bool
    otherwise = SDoc
    empty
        pred :: Type
    pred = Class -> [Type] -> Type
    mkClassPred Class
    cls [Type]
    cls_args
        via_mechanism :: SDoc
    via_mechanism | Bool
    strat_used
                      , Just DerivStrategy GhcTc
    strat <- Maybe (DerivStrategy GhcTc)
    mb_strat
                      = String -> SDoc
    text String
    "with the" SDoc -> SDoc -> SDoc
    <+> (DerivStrategy GhcTc -> SDoc
    forall a. DerivStrategy a -> SDoc
    derivStrategyName DerivStrategy GhcTc
    strat) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "strategy"
                      | Bool
    otherwise
                      = SDoc
    empty

    badCon :: DataCon -> SDoc -> SDoc
    badCon :: DataCon -> SDoc -> SDoc
    badCon DataCon
    con SDoc
    msg = String -> SDoc
    text String
    "Constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    con) SDoc -> SDoc -> SDoc
    <+> SDoc
    msg

    derivErrDiagnosticMessage :: Class
                              -> [Type]
                              -> Maybe (DerivStrategy GhcTc)
                              -> UsingGeneralizedNewtypeDeriving
                              -> Bool -- If True, includes the herald \"can't make a derived..\"
                              -> DeriveInstanceErrReason
                              -> SDoc
    derivErrDiagnosticMessage :: Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> DeriveInstanceErrReason
    -> SDoc
    derivErrDiagnosticMessage Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald = \case
      DerivErrNotWellKinded TyCon
    tc Type
    cls_kind Int
    _
        -> [SDoc] -> SDoc
    sep [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Cannot derive well-kinded instance of form"
                             SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Class -> [Type] -> SDoc
    pprClassPred Class
    cls [Type]
    cls_tys
                                           SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "...")))
                      Int
    2 SDoc
    empty
               , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "Class" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls)
                             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "expects an argument of kind"
                             SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprKind Type
    cls_kind))
               ]
      DeriveInstanceErrReason
    DerivErrSafeHaskellGenericInst
        ->     String -> SDoc
    text String
    "Generic instances can only be derived in"
           SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "Safe Haskell using the stock strategy."
      DerivErrDerivingViaWrongKind Type
    cls_kind Type
    via_ty Type
    via_kind
        -> SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Cannot derive instance via" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprType Type
    via_ty))
              Int
    2 (String -> SDoc
    text String
    "Class" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls)
                      SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "expects an argument of kind"
                      SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprKind Type
    cls_kind) SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    ','
             SDoc -> SDoc -> SDoc
    $+$ String -> SDoc
    text String
    "but" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprType Type
    via_ty)
                      SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has kind" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprKind Type
    via_kind))
      DerivErrNoEtaReduce Type
    inst_ty
        -> [SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "Cannot eta-reduce to an instance of form",
                Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "instance (...) =>"
                       SDoc -> SDoc -> SDoc
    <+> Class -> [Type] -> SDoc
    pprClassPred Class
    cls ([Type]
    cls_tys [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type
    inst_ty]))]
      DeriveInstanceErrReason
    DerivErrBootFileFound
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (String -> SDoc
    text String
    "Cannot derive instances in hs-boot files"
              SDoc -> SDoc -> SDoc
    $+$ String -> SDoc
    text String
    "Write an instance declaration instead")
      DerivErrDataConsNotAllInScope TyCon
    tc
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The data constructors of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "are not all in scope")
                Int
    2 (String -> SDoc
    text String
    "so you cannot derive an instance for it"))
      DeriveInstanceErrReason
    DerivErrGNDUsedOnData
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (String -> SDoc
    text String
    "GeneralizedNewtypeDeriving cannot be used on non-newtypes")
      DeriveInstanceErrReason
    DerivErrNullaryClasses
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (String -> SDoc
    text String
    "Cannot derive instances for nullary classes")
      DeriveInstanceErrReason
    DerivErrLastArgMustBeApp
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             ( String -> SDoc
    text String
    "The last argument of the instance must be a"
             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "data or newtype application")
      DerivErrNoFamilyInstance TyCon
    tc [Type]
    tc_args
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (String -> SDoc
    text String
    "No family instance for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> [Type] -> SDoc
    pprTypeApp TyCon
    tc [Type]
    tc_args))
      DerivErrNotStockDeriveable DeriveAnyClassEnabled
    _
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (SDoc -> SDoc
    quotes (Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not a stock derivable class (Eq, Show, etc.)")
      DerivErrHasAssociatedDatatypes HasAssociatedDataFamInsts
    hasAdfs AssociatedTyLastVarInKind
    at_last_cls_tv_in_kinds AssociatedTyNotParamOverLastTyVar
    at_without_last_cls_tv
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [ Bool -> SDoc -> SDoc
    ppWhen (HasAssociatedDataFamInsts
    hasAdfs HasAssociatedDataFamInsts -> HasAssociatedDataFamInsts -> Bool
    forall a. Eq a => a -> a -> Bool
    == HasAssociatedDataFamInsts
    YesHasAdfs) SDoc
    adfs_msg
                   , case AssociatedTyNotParamOverLastTyVar
    at_without_last_cls_tv of
                        YesAssociatedTyNotParamOverLastTyVar TyCon
    tc -> TyCon -> SDoc
    at_without_last_cls_tv_msg TyCon
    tc
                        AssociatedTyNotParamOverLastTyVar
    NoAssociatedTyNotParamOverLastTyVar     -> SDoc
    empty
                   , case AssociatedTyLastVarInKind
    at_last_cls_tv_in_kinds of
                       YesAssocTyLastVarInKind TyCon
    tc -> TyCon -> SDoc
    at_last_cls_tv_in_kinds_msg TyCon
    tc
                       AssociatedTyLastVarInKind
    NoAssocTyLastVarInKind     -> SDoc
    empty
                   ]
           where

             adfs_msg :: SDoc
    adfs_msg  = String -> SDoc
    text String
    "the class has associated data types"

             at_without_last_cls_tv_msg :: TyCon -> SDoc
    at_without_last_cls_tv_msg TyCon
    at_tc = SDoc -> Int -> SDoc -> SDoc
    hang
               (String -> SDoc
    text String
    "the associated type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    at_tc)
                SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not parameterized over the last type variable")
               Int
    2 (String -> SDoc
    text String
    "of the class" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls))

             at_last_cls_tv_in_kinds_msg :: TyCon -> SDoc
    at_last_cls_tv_in_kinds_msg TyCon
    at_tc = SDoc -> Int -> SDoc -> SDoc
    hang
               (String -> SDoc
    text String
    "the associated type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    at_tc)
                SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "contains the last type variable")
              Int
    2 (String -> SDoc
    text String
    "of the class" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls)
                SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in a kind, which is not (yet) allowed")
      DeriveInstanceErrReason
    DerivErrNewtypeNonDeriveableClass
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> DeriveInstanceErrReason
    -> SDoc
    derivErrDiagnosticMessage Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald (DeriveAnyClassEnabled -> DeriveInstanceErrReason
    DerivErrNotStockDeriveable DeriveAnyClassEnabled
    NoDeriveAnyClassEnabled)
      DerivErrCannotEtaReduceEnough Bool
    eta_ok
        -> let cant_derive_err :: SDoc
    cant_derive_err = Bool -> SDoc -> SDoc
    ppUnless Bool
    eta_ok SDoc
    eta_msg
               eta_msg :: SDoc
    eta_msg = String -> SDoc
    text String
    "cannot eta-reduce the representation type enough"
           in Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
              SDoc
    cant_derive_err
      DerivErrOnlyAnyClassDeriveable TyCon
    tc DeriveAnyClassEnabled
    _
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is a type class,"
                              SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "and can only have a derived instance"
                              SDoc -> SDoc -> SDoc
    $+$ String -> SDoc
    text String
    "if DeriveAnyClass is enabled")
      DerivErrNotDeriveable DeriveAnyClassEnabled
    _
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald SDoc
    empty
      DerivErrNotAClass Type
    predType
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    predType) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not a class")
      DerivErrNoConstructors TyCon
    rep_tc
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (SDoc -> SDoc
    quotes (TyCon -> SDoc
    pprSourceTyCon TyCon
    rep_tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must have at least one data constructor")
      DerivErrLangExtRequired Extension
    ext
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (String -> SDoc
    text String
    "You need " SDoc -> SDoc -> SDoc
    <> Extension -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Extension
    ext
                SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "to derive an instance for this class")
      DerivErrDunnoHowToDeriveForType Type
    ty
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
            (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Don't know how to derive" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    cls))
                  Int
    2 (String -> SDoc
    text String
    "for type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)))
      DerivErrMustBeEnumType TyCon
    rep_tc
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             ([SDoc] -> SDoc
    sep [ SDoc -> SDoc
    quotes (TyCon -> SDoc
    pprSourceTyCon TyCon
    rep_tc) SDoc -> SDoc -> SDoc
    <+>
                    String -> SDoc
    text String
    "must be an enumeration type"
                  , String -> SDoc
    text String
    "(an enumeration consists of one or more nullary, non-GADT constructors)" ])

      DerivErrMustHaveExactlyOneConstructor TyCon
    rep_tc
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (SDoc -> SDoc
    quotes (TyCon -> SDoc
    pprSourceTyCon TyCon
    rep_tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must have precisely one constructor")
      DerivErrMustHaveSomeParameters TyCon
    rep_tc
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (String -> SDoc
    text String
    "Data type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    rep_tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must have some type parameters")
      DerivErrMustNotHaveClassContext TyCon
    rep_tc [Type]
    bad_stupid_theta
        -> Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
             (String -> SDoc
    text String
    "Data type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    rep_tc)
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must not have a class context:" SDoc -> SDoc -> SDoc
    <+> [Type] -> SDoc
    pprTheta [Type]
    bad_stupid_theta)
      DerivErrBadConstructor Maybe HasWildcard
    _ [DeriveInstanceBadConstructor]
    reasons
        -> let why :: SDoc
    why = [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (DeriveInstanceBadConstructor -> SDoc)
    -> [DeriveInstanceBadConstructor] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map DeriveInstanceBadConstructor -> SDoc
    renderReason [DeriveInstanceBadConstructor]
    reasons
           in Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald SDoc
    why
             where
               renderReason :: DeriveInstanceBadConstructor -> SDoc
    renderReason = \case
                     DerivErrBadConExistential DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "must be truly polymorphic in the last argument of the data type"
                     DerivErrBadConCovariant DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "must not use the type variable in a function argument"
                     DerivErrBadConFunTypes DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "must not contain function types"
                     DerivErrBadConWrongArg DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "must use the type variable only as the last argument of a data type"
                     DerivErrBadConIsGADT DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "is a GADT"
                     DerivErrBadConHasExistentials DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "has existential type variables in its type"
                     DerivErrBadConHasConstraints DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "has constraints in its type"
                     DerivErrBadConHasHigherRankType DataCon
    con
                       -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "has a higher-rank type"
      DerivErrGenerics [DeriveGenericsErrReason]
    reasons
        -> let why :: SDoc
    why = [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (DeriveGenericsErrReason -> SDoc)
    -> [DeriveGenericsErrReason] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map DeriveGenericsErrReason -> SDoc
    renderReason [DeriveGenericsErrReason]
    reasons
           in Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald SDoc
    why
             where
               renderReason :: DeriveGenericsErrReason -> SDoc
    renderReason = \case
                 DerivErrGenericsMustNotHaveDatatypeContext TyCon
    tc_name
                    -> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc_name SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must not have a datatype context"
                 DerivErrGenericsMustNotHaveExoticArgs DataCon
    dc
                    -> DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must not have exotic unlifted or polymorphic arguments"
                 DerivErrGenericsMustBeVanillaDataCon DataCon
    dc
                    -> DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must be a vanilla data constructor"
                 DerivErrGenericsMustHaveSomeTypeParams TyCon
    rep_tc
                    ->     String -> SDoc
    text String
    "Data type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    rep_tc)
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must have some type parameters"
                 DerivErrGenericsMustNotHaveExistentials DataCon
    con
                   -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "must not have existential arguments"
                 DerivErrGenericsWrongArgKind DataCon
    con
                   -> DataCon -> SDoc -> SDoc
    badCon DataCon
    con (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                        String -> SDoc
    text String
    "applies a type to an argument involving the last parameter"
                     SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "but the applied type is not of kind * -> *"
      DerivErrEnumOrProduct DeriveInstanceErrReason
    this DeriveInstanceErrReason
    that
        -> let ppr1 :: SDoc
    ppr1 = Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> DeriveInstanceErrReason
    -> SDoc
    derivErrDiagnosticMessage Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    False DeriveInstanceErrReason
    this
               ppr2 :: SDoc
    ppr2 = Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> DeriveInstanceErrReason
    -> SDoc
    derivErrDiagnosticMessage Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    False DeriveInstanceErrReason
    that
           in Class
    -> [Type]
    -> Maybe (DerivStrategy GhcTc)
    -> UsingGeneralizedNewtypeDeriving
    -> Bool
    -> SDoc
    -> SDoc
    cannotMakeDerivedInstanceHerald Class
    cls [Type]
    cls_tys Maybe (DerivStrategy GhcTc)
    mb_strat UsingGeneralizedNewtypeDeriving
    newtype_deriving Bool
    pprHerald
              (SDoc
    ppr1 SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "  or" SDoc -> SDoc -> SDoc
    $$ SDoc
    ppr2)

    {- *********************************************************************
    *                                                                      *
                  Outputable SolverReportErrCtxt (for debugging)
    *                                                                      *
    **********************************************************************-}

    instance Outputable SolverReportErrCtxt where
      ppr :: SolverReportErrCtxt -> SDoc
    ppr (CEC { cec_binds :: SolverReportErrCtxt -> EvBindsVar
    cec_binds              = EvBindsVar
    bvar
               , cec_defer_type_errors :: SolverReportErrCtxt -> DiagnosticReason
    cec_defer_type_errors  = DiagnosticReason
    dte
               , cec_expr_holes :: SolverReportErrCtxt -> DiagnosticReason
    cec_expr_holes         = DiagnosticReason
    eh
               , cec_type_holes :: SolverReportErrCtxt -> DiagnosticReason
    cec_type_holes         = DiagnosticReason
    th
               , cec_out_of_scope_holes :: SolverReportErrCtxt -> DiagnosticReason
    cec_out_of_scope_holes = DiagnosticReason
    osh
               , cec_warn_redundant :: SolverReportErrCtxt -> Bool
    cec_warn_redundant     = Bool
    wr
               , cec_expand_syns :: SolverReportErrCtxt -> Bool
    cec_expand_syns        = Bool
    es
               , cec_suppress :: SolverReportErrCtxt -> Bool
    cec_suppress           = Bool
    sup })
        = String -> SDoc
    text String
    "CEC" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    braces ([SDoc] -> SDoc
    vcat
             [ String -> SDoc
    text String
    "cec_binds"              SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> EvBindsVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindsVar
    bvar
             , String -> SDoc
    text String
    "cec_defer_type_errors"  SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> DiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DiagnosticReason
    dte
             , String -> SDoc
    text String
    "cec_expr_holes"         SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> DiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DiagnosticReason
    eh
             , String -> SDoc
    text String
    "cec_type_holes"         SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> DiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DiagnosticReason
    th
             , String -> SDoc
    text String
    "cec_out_of_scope_holes" SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> DiagnosticReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DiagnosticReason
    osh
             , String -> SDoc
    text String
    "cec_warn_redundant"     SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    wr
             , String -> SDoc
    text String
    "cec_expand_syns"        SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    es
             , String -> SDoc
    text String
    "cec_suppress"           SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    sup ])

    {- *********************************************************************
    *                                                                      *
                        Outputting TcSolverReportMsg errors
    *                                                                      *
    **********************************************************************-}

    -- | Pretty-print a 'SolverReportWithCtxt', containing a 'TcSolverReportMsg'
    -- with its enclosing 'SolverReportErrCtxt'.
    pprSolverReportWithCtxt :: SolverReportWithCtxt -> SDoc
    pprSolverReportWithCtxt :: SolverReportWithCtxt -> SDoc
    pprSolverReportWithCtxt (SolverReportWithCtxt { reportContext :: SolverReportWithCtxt -> SolverReportErrCtxt
    reportContext = SolverReportErrCtxt
    ctxt, reportContent :: SolverReportWithCtxt -> TcSolverReportMsg
    reportContent = TcSolverReportMsg
    msg })
       = SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt TcSolverReportMsg
    msg

    -- | Pretty-print a 'TcSolverReportMsg', with its enclosing 'SolverReportErrCtxt'.
    pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt (TcReportWithInfo TcSolverReportMsg
    msg (TcSolverReportInfo
    info :| [TcSolverReportInfo]
    infos)) =
      [SDoc] -> SDoc
    vcat
        ( SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt TcSolverReportMsg
    msg
        SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt TcSolverReportInfo
    info
        SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (TcSolverReportInfo -> SDoc) -> [TcSolverReportInfo] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt) [TcSolverReportInfo]
    infos )
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (BadTelescope TyVarBndrs
    telescope [TcTyVar]
    skols) =
      SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "These kind and type variables:" SDoc -> SDoc -> SDoc
    <+> TyVarBndrs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyVarBndrs
    telescope SDoc -> SDoc -> SDoc
    $$
           String -> SDoc
    text String
    "are out of dependency order. Perhaps try this ordering:")
        Int
    2 ([TcTyVar] -> SDoc
    pprTyVars [TcTyVar]
    sorted_tvs)
      where
        sorted_tvs :: [TcTyVar]
    sorted_tvs = [TcTyVar] -> [TcTyVar]
    scopedSort [TcTyVar]
    skols
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (UserTypeError Type
    ty) =
      Type -> SDoc
    pprUserTypeErrorTy Type
    ty
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt (ReportHoleError Hole
    hole HoleError
    err) =
      SolverReportErrCtxt -> Hole -> HoleError -> SDoc
    pprHoleError SolverReportErrCtxt
    ctxt Hole
    hole HoleError
    err
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (CannotUnifyWithPolytype ErrorItem
    item TcTyVar
    tv1 Type
    ty2) =
      [SDoc] -> SDoc
    vcat [ (if TcTyVar -> Bool
    isSkolemTyVar TcTyVar
    tv1
              then String -> SDoc
    text String
    "Cannot equate type variable"
              else String -> SDoc
    text String
    "Cannot instantiate unification variable")
             SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv1)
           , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "with a" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "involving polytypes:") Int
    2 (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty2) ]
      where
        what :: SDoc
    what = String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ TypeOrKind -> String
    levelString (TypeOrKind -> String) -> TypeOrKind -> String
    forall a b. (a -> b) -> a -> b
    $
               CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
    errorItemCtLoc ErrorItem
    item) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel
    pprTcSolverReportMsg SolverReportErrCtxt
    _
      (Mismatch { mismatch_ea :: TcSolverReportMsg -> Bool
    mismatch_ea   = Bool
    add_ea
                , mismatch_item :: TcSolverReportMsg -> ErrorItem
    mismatch_item = ErrorItem
    item
                , mismatch_ty1 :: TcSolverReportMsg -> Type
    mismatch_ty1  = Type
    ty1
                , mismatch_ty2 :: TcSolverReportMsg -> Type
    mismatch_ty2  = Type
    ty2 })
      = CtOrigin -> SDoc -> SDoc
    addArising (ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item) SDoc
    msg
      where
        msg :: SDoc
    msg
          | (Type -> Bool
    isLiftedRuntimeRep Type
    ty1 Bool -> Bool -> Bool
    && Type -> Bool
    isUnliftedRuntimeRep Type
    ty2) Bool -> Bool -> Bool
    ||
            (Type -> Bool
    isLiftedRuntimeRep Type
    ty2 Bool -> Bool -> Bool
    && Type -> Bool
    isUnliftedRuntimeRep Type
    ty1) Bool -> Bool -> Bool
    ||
            (Type -> Bool
    isLiftedLevity Type
    ty1 Bool -> Bool -> Bool
    && Type -> Bool
    isUnliftedLevity Type
    ty2) Bool -> Bool -> Bool
    ||
            (Type -> Bool
    isLiftedLevity Type
    ty2 Bool -> Bool -> Bool
    && Type -> Bool
    isUnliftedLevity Type
    ty1)
          = String -> SDoc
    text String
    "Couldn't match a lifted type with an unlifted type"

          | Type -> Bool
    isAtomicTy Type
    ty1 Bool -> Bool -> Bool
    || Type -> Bool
    isAtomicTy Type
    ty2
          = -- Print with quotes
            [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    herald1 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty1)
                , Int -> SDoc -> SDoc
    nest Int
    padding (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                  String -> SDoc
    text String
    herald2 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty2) ]

          | Bool
    otherwise
          = -- Print with vertical layout
            [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    herald1 SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty1
                 , Int -> SDoc -> SDoc
    nest Int
    padding (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                   String -> SDoc
    text String
    herald2 SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty2 ]

        herald1 :: String
    herald1 = [String] -> String
    conc [ String
    "Couldn't match"
                       , if Bool
    is_repr then String
    "representation of" else String
    ""
                       , if Bool
    add_ea then String
    "expected"          else String
    ""
                       , String
    what ]
        herald2 :: String
    herald2 = [String] -> String
    conc [ String
    "with"
                       , if Bool
    is_repr then String
    "that of"          else String
    ""
                       , if Bool
    add_ea then (String
    "actual " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    what) else String
    "" ]

        padding :: Int
    padding = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    herald1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    herald2

        is_repr :: Bool
    is_repr = case ErrorItem -> EqRel
    errorItemEqRel ErrorItem
    item of { EqRel
    ReprEq -> Bool
    True; EqRel
    NomEq -> Bool
    False }

        what :: String
    what = TypeOrKind -> String
    levelString (CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
    errorItemCtLoc ErrorItem
    item) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel)

        conc :: [String] -> String
        conc :: [String] -> String
    conc = (String -> String -> String) -> [String] -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 String -> String -> String
    add_space

        add_space :: String -> String -> String
        add_space :: String -> String -> String
    add_space String
    s1 String
    s2 | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s1   = String
    s2
                        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s2   = String
    s1
                        | Bool
    otherwise = String
    s1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    s2)
    pprTcSolverReportMsg SolverReportErrCtxt
    _
      (KindMismatch { kmismatch_what :: TcSolverReportMsg -> TypedThing
    kmismatch_what     = TypedThing
    thing
                    , kmismatch_expected :: TcSolverReportMsg -> Type
    kmismatch_expected = Type
    exp
                    , kmismatch_actual :: TcSolverReportMsg -> Type
    kmismatch_actual   = Type
    act })
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Expected" SDoc -> SDoc -> SDoc
    <+> SDoc
    kind_desc SDoc -> SDoc -> SDoc
    <> SDoc
    comma)
          Int
    2 (String -> SDoc
    text String
    "but" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TypedThing -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TypedThing
    thing) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has kind" SDoc -> SDoc -> SDoc
    <+>
            SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    act))
      where
        kind_desc :: SDoc
    kind_desc | Type -> Bool
    tcIsConstraintKind Type
    exp = String -> SDoc
    text String
    "a constraint"
                  | Just Type
    arg <- (() :: Constraint) => Type -> Maybe Type
    Type -> Maybe Type
    kindRep_maybe Type
    exp  -- TYPE t0
                  , Type -> Bool
    tcIsTyVarTy Type
    arg = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \case
                                       Bool
    True  -> String -> SDoc
    text String
    "kind" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    exp)
                                       Bool
    False -> String -> SDoc
    text String
    "a type"
                  | Bool
    otherwise       = String -> SDoc
    text String
    "kind" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    exp)

    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt
      (TypeEqMismatch { teq_mismatch_ppr_explicit_kinds :: TcSolverReportMsg -> Bool
    teq_mismatch_ppr_explicit_kinds = Bool
    ppr_explicit_kinds
                      , teq_mismatch_item :: TcSolverReportMsg -> ErrorItem
    teq_mismatch_item     = ErrorItem
    item
                      , teq_mismatch_ty1 :: TcSolverReportMsg -> Type
    teq_mismatch_ty1      = Type
    ty1
                      , teq_mismatch_ty2 :: TcSolverReportMsg -> Type
    teq_mismatch_ty2      = Type
    ty2
                      , teq_mismatch_expected :: TcSolverReportMsg -> Type
    teq_mismatch_expected = Type
    exp
                      , teq_mismatch_actual :: TcSolverReportMsg -> Type
    teq_mismatch_actual   = Type
    act
                      , teq_mismatch_what :: TcSolverReportMsg -> Maybe TypedThing
    teq_mismatch_what     = Maybe TypedThing
    mb_thing })
      = CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Bool -> SDoc -> SDoc
    pprWithExplicitKindsWhen Bool
    ppr_explicit_kinds SDoc
    msg
      where
        msg :: SDoc
    msg
          | Type -> Bool
    isUnliftedTypeKind Type
    act, Type -> Bool
    isLiftedTypeKind Type
    exp
          = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Expecting a lifted type, but"
                , Maybe TypedThing -> SDoc -> SDoc -> SDoc
    forall {a}. Outputable a => Maybe a -> SDoc -> SDoc -> SDoc
    thing_msg Maybe TypedThing
    mb_thing (String -> SDoc
    text String
    "an") (String -> SDoc
    text String
    "unlifted") ]
          | Type -> Bool
    isLiftedTypeKind Type
    act, Type -> Bool
    isUnliftedTypeKind Type
    exp
          = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Expecting an unlifted type, but"
                , Maybe TypedThing -> SDoc -> SDoc -> SDoc
    forall {a}. Outputable a => Maybe a -> SDoc -> SDoc -> SDoc
    thing_msg Maybe TypedThing
    mb_thing (String -> SDoc
    text String
    "a") (String -> SDoc
    text String
    "lifted") ]
          | Type -> Bool
    tcIsLiftedTypeKind Type
    exp
          = SDoc
    maybe_num_args_msg SDoc -> SDoc -> SDoc
    $$
            [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Expected a type, but"
                , case Maybe TypedThing
    mb_thing of
                    Maybe TypedThing
    Nothing    -> String -> SDoc
    text String
    "found something with kind"
                    Just TypedThing
    thing -> SDoc -> SDoc
    quotes (TypedThing -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TypedThing
    thing) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has kind"
                , SDoc -> SDoc
    quotes (Type -> SDoc
    pprWithTYPE Type
    act) ]
          | Just SDoc
    nargs_msg <- Maybe SDoc
    num_args_msg
          , Right TcSolverReportMsg
    ea_msg <- SolverReportErrCtxt
    -> Maybe ErrorItem
    -> TypeOrKind
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_ea_msg SolverReportErrCtxt
    ctxt (ErrorItem -> Maybe ErrorItem
    forall a. a -> Maybe a
    Just ErrorItem
    item) TypeOrKind
    level CtOrigin
    orig
          = SDoc
    nargs_msg SDoc -> SDoc -> SDoc
    $$ SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt TcSolverReportMsg
    ea_msg
          | -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $
            Type -> Type -> Type -> Type -> Bool
    ea_looks_same Type
    ty1 Type
    ty2 Type
    exp Type
    act
          , Right TcSolverReportMsg
    ea_msg <- SolverReportErrCtxt
    -> Maybe ErrorItem
    -> TypeOrKind
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_ea_msg SolverReportErrCtxt
    ctxt (ErrorItem -> Maybe ErrorItem
    forall a. a -> Maybe a
    Just ErrorItem
    item) TypeOrKind
    level CtOrigin
    orig
          = SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt TcSolverReportMsg
    ea_msg
          -- The mismatched types are /inside/ exp and act
          | let mismatch_err :: TcSolverReportMsg
    mismatch_err = Bool -> ErrorItem -> Type -> Type -> TcSolverReportMsg
    Mismatch Bool
    False ErrorItem
    item Type
    ty1 Type
    ty2
                errs :: [TcSolverReportMsg]
    errs = case SolverReportErrCtxt
    -> Maybe ErrorItem
    -> TypeOrKind
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_ea_msg SolverReportErrCtxt
    ctxt Maybe ErrorItem
    forall a. Maybe a
    Nothing TypeOrKind
    level CtOrigin
    orig of
                  Left [TcSolverReportInfo]
    ea_info -> [ TcSolverReportMsg -> [TcSolverReportInfo] -> TcSolverReportMsg
    mkTcReportWithInfo TcSolverReportMsg
    mismatch_err [TcSolverReportInfo]
    ea_info ]
                  Right TcSolverReportMsg
    ea_err -> [ TcSolverReportMsg
    mismatch_err, TcSolverReportMsg
    ea_err ]
          = [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (TcSolverReportMsg -> SDoc) -> [TcSolverReportMsg] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt) [TcSolverReportMsg]
    errs

        ct_loc :: CtLoc
    ct_loc = ErrorItem -> CtLoc
    errorItemCtLoc ErrorItem
    item
        orig :: CtOrigin
    orig   = ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item
        level :: TypeOrKind
    level  = CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe CtLoc
    ct_loc Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel

        thing_msg :: Maybe a -> SDoc -> SDoc -> SDoc
    thing_msg (Just a
    thing) SDoc
    _  SDoc
    levity = SDoc -> SDoc
    quotes (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    thing) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is" SDoc -> SDoc -> SDoc
    <+> SDoc
    levity
        thing_msg Maybe a
    Nothing      SDoc
    an SDoc
    levity = String -> SDoc
    text String
    "got" SDoc -> SDoc -> SDoc
    <+> SDoc
    an SDoc -> SDoc -> SDoc
    <+> SDoc
    levity SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "type"

        num_args_msg :: Maybe SDoc
    num_args_msg = case TypeOrKind
    level of
          TypeOrKind
    KindLevel
            | Bool -> Bool
    not (Type -> Bool
    isMetaTyVarTy Type
    exp) Bool -> Bool -> Bool
    && Bool -> Bool
    not (Type -> Bool
    isMetaTyVarTy Type
    act)
               -- if one is a meta-tyvar, then it's possible that the user
               -- has asked for something impredicative, and we couldn't unify.
               -- Don't bother with counting arguments.
            -> let n_act :: Int
    n_act = Type -> Int
    count_args Type
    act
                   n_exp :: Int
    n_exp = Type -> Int
    count_args Type
    exp in
               case Int
    n_act Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n_exp of
                 Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0   -- we don't know how many args there are, so don't
                             -- recommend removing args that aren't
                   , Just TypedThing
    thing <- Maybe TypedThing
    mb_thing
                   -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt (Int -> TypedThing -> TcSolverReportMsg
    ExpectingMoreArguments Int
    n TypedThing
    thing)
                 Int
    _ -> Maybe SDoc
    forall a. Maybe a
    Nothing

          TypeOrKind
    _ -> Maybe SDoc
    forall a. Maybe a
    Nothing

        maybe_num_args_msg :: SDoc
    maybe_num_args_msg = Maybe SDoc
    num_args_msg Maybe SDoc -> SDoc -> SDoc
    forall a. Maybe a -> a -> a
    `orElse` SDoc
    empty

        count_args :: Type -> Int
    count_args Type
    ty = (TyCoBinder -> Bool) -> [TyCoBinder] -> Int
    forall a. (a -> Bool) -> [a] -> Int
    count TyCoBinder -> Bool
    isVisibleBinder ([TyCoBinder] -> Int) -> [TyCoBinder] -> Int
    forall a b. (a -> b) -> a -> b
    $ ([TyCoBinder], Type) -> [TyCoBinder]
    forall a b. (a, b) -> a
    fst (([TyCoBinder], Type) -> [TyCoBinder])
    -> ([TyCoBinder], Type) -> [TyCoBinder]
    forall a b. (a -> b) -> a -> b
    $ Type -> ([TyCoBinder], Type)
    splitPiTys Type
    ty
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (FixedRuntimeRepError [FixedRuntimeRepErrorInfo]
    frr_origs) =
      [SDoc] -> SDoc
    vcat ((FixedRuntimeRepErrorInfo -> SDoc)
    -> [FixedRuntimeRepErrorInfo] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map FixedRuntimeRepErrorInfo -> SDoc
    make_msg [FixedRuntimeRepErrorInfo]
    frr_origs)
      where
        -- Assemble the error message: pair up each origin with the corresponding type, e.g.
        --   • FixedRuntimeRep origin msg 1 ...
        --       a :: TYPE r1
        --   • FixedRuntimeRep origin msg 2 ...
        --       b :: TYPE r2
        make_msg :: FixedRuntimeRepErrorInfo -> SDoc
        make_msg :: FixedRuntimeRepErrorInfo -> SDoc
    make_msg (FRR_Info { frr_info_origin :: FixedRuntimeRepErrorInfo -> FixedRuntimeRepOrigin
    frr_info_origin =
                               FixedRuntimeRepOrigin
                                 { frr_type :: FixedRuntimeRepOrigin -> Type
    frr_type    = Type
    ty
                                 , frr_context :: FixedRuntimeRepOrigin -> FixedRuntimeRepContext
    frr_context = FixedRuntimeRepContext
    frr_ctxt }
                           , frr_info_not_concrete :: FixedRuntimeRepErrorInfo -> Maybe (TcTyVar, Type)
    frr_info_not_concrete =
                             Maybe (TcTyVar, Type)
    mb_not_conc }) =
          -- Add bullet points if there is more than one error.
          (if [FixedRuntimeRepErrorInfo] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [FixedRuntimeRepErrorInfo]
    frr_origs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 then (SDoc
    bullet SDoc -> SDoc -> SDoc
    <+>) else SDoc -> SDoc
    forall a. a -> a
    id) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            [SDoc] -> SDoc
    vcat [ [SDoc] -> SDoc
    sep [ FixedRuntimeRepContext -> SDoc
    pprFixedRuntimeRepContext FixedRuntimeRepContext
    frr_ctxt
                       , String -> SDoc
    text String
    "does not have a fixed runtime representation." ]
                 , Type -> SDoc
    type_printout Type
    ty
                 , case Maybe (TcTyVar, Type)
    mb_not_conc of
                    Maybe (TcTyVar, Type)
    Nothing -> SDoc
    empty
                    Just (TcTyVar
    conc_tv, Type
    not_conc) ->
                      TcTyVar -> Type -> SDoc
    unsolved_concrete_eq_explanation TcTyVar
    conc_tv Type
    not_conc ]

        -- Don't print out the type (only the kind), if the type includes
        -- a confusing cast, unless the user passed -fprint-explicit-coercions.
        --
        -- Example:
        --
        --   In T20363, we have a representation-polymorphism error with a type
        --   of the form
        --
        --     ( (# #) |> co ) :: TYPE NilRep
        --
        --   where NilRep is a nullary type family application which reduces to TupleRep '[].
        --   We prefer avoiding showing the cast to the user, but we also don't want to
        --   print the confusing:
        --
        --     (# #) :: TYPE NilRep
        --
        --  So in this case we simply don't print the type, only the kind.
        confusing_cast :: Type -> Bool
        confusing_cast :: Type -> Bool
    confusing_cast Type
    ty =
          case Type
    ty of
            CastTy Type
    inner_ty KindCoercion
    _
              -- A confusing cast is one that is responsible
              -- for a representation-polymorphism error.
              -> Type -> Bool
    isConcrete ((() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    inner_ty)
            Type
    _ -> Bool
    False

        type_printout :: Type -> SDoc
        type_printout :: Type -> SDoc
    type_printout Type
    ty =
          (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \ Bool
    show_coercions ->
            if  Type -> Bool
    confusing_cast Type
    ty Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    show_coercions
            then [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Its kind is:"
                      , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Type -> SDoc
    pprWithTYPE ((() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    ty)
                      , String -> SDoc
    text String
    "(Use -fprint-explicit-coercions to see the full type.)" ]
            else [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Its type is:"
                      , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprWithTYPE ((() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    ty) ]

        unsolved_concrete_eq_explanation :: TcTyVar -> Type -> SDoc
        unsolved_concrete_eq_explanation :: TcTyVar -> Type -> SDoc
    unsolved_concrete_eq_explanation TcTyVar
    tv Type
    not_conc =
              String -> SDoc
    text String
    "Cannot unify" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    not_conc)
          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with the type variable" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv)
          SDoc -> SDoc -> SDoc
    $$  String -> SDoc
    text String
    "because it is not a concrete" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <> SDoc
    dot
          where
            ki :: Type
    ki = TcTyVar -> Type
    tyVarKind TcTyVar
    tv
            what :: SDoc
            what :: SDoc
    what
              | Type -> Bool
    isRuntimeRepTy Type
    ki
              = SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "RuntimeRep")
              | Type -> Bool
    isLevityTy Type
    ki
              = SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "Levity")
              | Bool
    otherwise
              = String -> SDoc
    text String
    "type"

    pprTcSolverReportMsg SolverReportErrCtxt
    _ (SkolemEscape ErrorItem
    item Implication
    implic [TcTyVar]
    esc_skols) =
      let
        esc_doc :: SDoc
    esc_doc = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "because" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable" SDoc -> SDoc -> SDoc
    <> [TcTyVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TcTyVar]
    esc_skols
                    SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    esc_skols
                  , String -> SDoc
    text String
    "would escape" SDoc -> SDoc -> SDoc
    <+>
                    if [TcTyVar] -> Bool
    forall a. [a] -> Bool
    isSingleton [TcTyVar]
    esc_skols then String -> SDoc
    text String
    "its scope"
                                             else String -> SDoc
    text String
    "their scope" ]
      in
      [SDoc] -> SDoc
    vcat [ Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc
    esc_doc
           , [SDoc] -> SDoc
    sep [ (if [TcTyVar] -> Bool
    forall a. [a] -> Bool
    isSingleton [TcTyVar]
    esc_skols
                    then String -> SDoc
    text String
    "This (rigid, skolem)" SDoc -> SDoc -> SDoc
    <+>
                         SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable is"
                    else String -> SDoc
    text String
    "These (rigid, skolem)" SDoc -> SDoc -> SDoc
    <+>
                         SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variables are")
             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "bound by"
           , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SkolemInfoAnon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Implication -> SkolemInfoAnon
    ic_info Implication
    implic)
           , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+>
             RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    getLclEnvLoc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ] ]
      where
        what :: SDoc
    what = String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ TypeOrKind -> String
    levelString (TypeOrKind -> String) -> TypeOrKind -> String
    forall a b. (a -> b) -> a -> b
    $
               CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
    errorItemCtLoc ErrorItem
    item) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (UntouchableVariable TcTyVar
    tv Implication
    implic)
      | Implic { ic_given :: Implication -> [TcTyVar]
    ic_given = [TcTyVar]
    given, ic_info :: Implication -> SkolemInfoAnon
    ic_info = SkolemInfoAnon
    skol_info } <- Implication
    implic
      = [SDoc] -> SDoc
    sep [ SDoc -> SDoc
    quotes (TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is untouchable"
            , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "inside the constraints:" SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    pprEvVarTheta [TcTyVar]
    given
            , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "bound by" SDoc -> SDoc -> SDoc
    <+> SkolemInfoAnon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfoAnon
    skol_info
            , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+>
              RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    getLclEnvLoc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ]
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (BlockedEquality ErrorItem
    item) =
      [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Cannot use equality for substitution:")
               Int
    2 (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ErrorItem -> Type
    errorItemPred ErrorItem
    item))
           , String -> SDoc
    text String
    "Doing so would be ill-kinded." ]
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (ExpectingMoreArguments Int
    n TypedThing
    thing) =
      String -> SDoc
    text String
    "Expecting" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    speakN (Int -> Int
    forall a. Num a => a -> a
    abs Int
    n) SDoc -> SDoc -> SDoc
    <+>
        SDoc
    more SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TypedThing -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TypedThing
    thing)
      where
        more :: SDoc
    more
         | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1    = String -> SDoc
    text String
    "more argument to"
         | Bool
    otherwise = String -> SDoc
    text String
    "more arguments to" -- n > 1
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt (UnboundImplicitParams (ErrorItem
    item :| [ErrorItem]
    items)) =
      let givens :: [Implication]
    givens = SolverReportErrCtxt -> [Implication]
    getUserGivens SolverReportErrCtxt
    ctxt
      in if [Implication] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    givens
         then CtOrigin -> SDoc -> SDoc
    addArising (ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Unbound implicit parameter" SDoc -> SDoc -> SDoc
    <> [Type] -> SDoc
    forall a. [a] -> SDoc
    plural [Type]
    preds
                    , Int -> SDoc -> SDoc
    nest Int
    2 ([Type] -> SDoc
    pprParendTheta [Type]
    preds) ]
         else SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt ([Implication]
    -> NonEmpty ErrorItem -> Maybe CND_Extra -> TcSolverReportMsg
    CouldNotDeduce [Implication]
    givens (ErrorItem
    item ErrorItem -> [ErrorItem] -> NonEmpty ErrorItem
    forall a. a -> [a] -> NonEmpty a
    :| [ErrorItem]
    items) Maybe CND_Extra
    forall a. Maybe a
    Nothing)
      where
        preds :: [Type]
    preds = (ErrorItem -> Type) -> [ErrorItem] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map ErrorItem -> Type
    errorItemPred (ErrorItem
    item ErrorItem -> [ErrorItem] -> [ErrorItem]
    forall a. a -> [a] -> [a]
    : [ErrorItem]
    items)
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt (CouldNotDeduce [Implication]
    useful_givens (ErrorItem
    item :| [ErrorItem]
    others) Maybe CND_Extra
    mb_extra)
      = SDoc
    main_msg SDoc -> SDoc -> SDoc
    $$
         case Either [TcSolverReportInfo] TcSolverReportMsg
    supplementary of
          Left [TcSolverReportInfo]
    infos
            -> [SDoc] -> SDoc
    vcat ((TcSolverReportInfo -> SDoc) -> [TcSolverReportInfo] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt) [TcSolverReportInfo]
    infos)
          Right TcSolverReportMsg
    other_msg
            -> SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt TcSolverReportMsg
    other_msg
      where
        main_msg :: SDoc
    main_msg
          | [Implication] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    useful_givens
          = CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc
    no_instance_msg SDoc -> SDoc -> SDoc
    <+> SDoc
    missing)
          | Bool
    otherwise
          = [SDoc] -> SDoc
    vcat (CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc
    no_deduce_msg SDoc -> SDoc -> SDoc
    <+> SDoc
    missing)
                  SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : [Implication] -> [SDoc]
    pp_givens [Implication]
    useful_givens)

        supplementary :: Either [TcSolverReportInfo] TcSolverReportMsg
    supplementary = case Maybe CND_Extra
    mb_extra of
          Maybe CND_Extra
    Nothing
            -> [TcSolverReportInfo]
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. a -> Either a b
    Left []
          Just (CND_Extra TypeOrKind
    level Type
    ty1 Type
    ty2)
            -> SolverReportErrCtxt
    -> TypeOrKind
    -> Type
    -> Type
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_supplementary_ea_msg SolverReportErrCtxt
    ctxt TypeOrKind
    level Type
    ty1 Type
    ty2 CtOrigin
    orig
        orig :: CtOrigin
    orig = ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item
        wanteds :: [Type]
    wanteds = (ErrorItem -> Type) -> [ErrorItem] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map ErrorItem -> Type
    errorItemPred (ErrorItem
    itemErrorItem -> [ErrorItem] -> [ErrorItem]
    forall a. a -> [a] -> [a]
    :[ErrorItem]
    others)

        no_instance_msg :: SDoc
    no_instance_msg =
          case [Type]
    wanteds of
            [Type
    wanted] | Just (TyCon
    tc, [Type]
    _) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    wanted
                     -- Don't say "no instance" for a constraint such as "c" for a type variable c.
                     , TyCon -> Bool
    isClassTyCon TyCon
    tc -> String -> SDoc
    text String
    "No instance for"
            [Type]
    _ -> String -> SDoc
    text String
    "Could not solve:"

        no_deduce_msg :: SDoc
    no_deduce_msg =
          case [Type]
    wanteds of
            [Type
    _wanted] -> String -> SDoc
    text String
    "Could not deduce"
            [Type]
    _         -> String -> SDoc
    text String
    "Could not deduce:"

        missing :: SDoc
    missing =
          case [Type]
    wanteds of
            [Type
    wanted] -> Type -> SDoc
    pprParendType Type
    wanted
            [Type]
    _        -> [Type] -> SDoc
    pprTheta [Type]
    wanteds

    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt (AmbiguityPreventsSolvingCt ErrorItem
    item ([TcTyVar], [TcTyVar])
    ambigs) =
      SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt (Bool -> ([TcTyVar], [TcTyVar]) -> TcSolverReportInfo
    Ambiguity Bool
    True ([TcTyVar], [TcTyVar])
    ambigs) SDoc -> SDoc -> SDoc
    <+>
      CtOrigin -> SDoc
    pprArising (ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item) SDoc -> SDoc -> SDoc
    $$
      String -> SDoc
    text String
    "prevents the constraint" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprParendType (Type -> SDoc) -> Type -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ErrorItem -> Type
    errorItemPred ErrorItem
    item)
      SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "from being solved."
    pprTcSolverReportMsg ctxt :: SolverReportErrCtxt
    ctxt@(CEC {cec_encl :: SolverReportErrCtxt -> [Implication]
    cec_encl = [Implication]
    implics})
      (CannotResolveInstance ErrorItem
    item [ClsInst]
    unifiers [ClsInst]
    candidates [ImportError]
    imp_errs [GhcHint]
    suggs RelevantBindings
    binds)
      =
        [SDoc] -> SDoc
    vcat
          [ SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt TcSolverReportMsg
    no_inst_msg
          , Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    extra_note
          , Maybe SDoc
    mb_patsyn_prov Maybe SDoc -> SDoc -> SDoc
    forall a. Maybe a -> a -> a
    `orElse` SDoc
    empty
          , Bool -> SDoc -> SDoc
    ppWhen (Bool
    has_ambigs Bool -> Bool -> Bool
    && Bool -> Bool
    not ([ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers Bool -> Bool -> Bool
    && [Implication] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    useful_givens))
            ([SDoc] -> SDoc
    vcat [ Bool -> SDoc -> SDoc
    ppUnless Bool
    lead_with_ambig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                      SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt (Bool -> ([TcTyVar], [TcTyVar]) -> TcSolverReportInfo
    Ambiguity Bool
    False ([TcTyVar]
    ambig_kvs, [TcTyVar]
    ambig_tvs))
                  , RelevantBindings -> SDoc
    pprRelevantBindings RelevantBindings
    binds
                  , SDoc
    potential_msg ])
          , Bool -> SDoc -> SDoc
    ppWhen (Maybe SDoc -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe SDoc
    mb_patsyn_prov) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                -- Don't suggest fixes for the provided context of a pattern
                -- synonym; the right fix is to bind more in the pattern
            [SDoc] -> SDoc
    show_fixes (Bool -> Type -> [Implication] -> [SDoc]
    ctxtFixes Bool
    has_ambigs Type
    pred [Implication]
    implics
                        [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    drv_fixes)
          , Bool -> SDoc -> SDoc
    ppWhen (Bool -> Bool
    not ([ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    candidates))
            (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "There are instances for similar types:")
                Int
    2 ([SDoc] -> SDoc
    vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ClsInst]
    candidates)))
                -- See Note [Report candidate instances]
          , [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (ImportError -> SDoc) -> [ImportError] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ImportError -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ImportError]
    imp_errs
          , [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (GhcHint -> SDoc) -> [GhcHint] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GhcHint -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [GhcHint]
    suggs ]
      where
        orig :: CtOrigin
    orig          = ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item
        pred :: Type
    pred          = ErrorItem -> Type
    errorItemPred ErrorItem
    item
        (Class
    clas, [Type]
    tys)   = (() :: Constraint) => Type -> (Class, [Type])
    Type -> (Class, [Type])
    getClassPredTys Type
    pred
        -- See Note [Highlighting ambiguous type variables]
        ([TcTyVar]
    ambig_kvs, [TcTyVar]
    ambig_tvs) = Type -> ([TcTyVar], [TcTyVar])
    ambigTkvsOfTy Type
    pred
        ambigs :: [TcTyVar]
    ambigs = [TcTyVar]
    ambig_kvs [TcTyVar] -> [TcTyVar] -> [TcTyVar]
    forall a. [a] -> [a] -> [a]
    ++ [TcTyVar]
    ambig_tvs
        has_ambigs :: Bool
    has_ambigs = Bool -> Bool
    not ([TcTyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    ambigs)
        useful_givens :: [Implication]
    useful_givens = CtOrigin -> [Implication] -> [Implication]
    discardProvCtxtGivens CtOrigin
    orig ([Implication] -> [Implication]
    getUserGivensFromImplics [Implication]
    implics)
             -- useful_givens are the enclosing implications with non-empty givens,
             -- modulo the horrid discardProvCtxtGivens
        lead_with_ambig :: Bool
    lead_with_ambig = Bool -> Bool
    not ([TcTyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    ambigs)
                       Bool -> Bool -> Bool
    && Bool -> Bool
    not ((TcTyVar -> Bool) -> [TcTyVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcTyVar -> Bool
    isRuntimeUnkSkol [TcTyVar]
    ambigs)
                       Bool -> Bool -> Bool
    && Bool -> Bool
    not ([ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers)
                       Bool -> Bool -> Bool
    && [Implication] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    useful_givens

        no_inst_msg :: TcSolverReportMsg
        no_inst_msg :: TcSolverReportMsg
    no_inst_msg
          | Bool
    lead_with_ambig
          = ErrorItem -> ([TcTyVar], [TcTyVar]) -> TcSolverReportMsg
    AmbiguityPreventsSolvingCt ErrorItem
    item ([TcTyVar]
    ambig_kvs, [TcTyVar]
    ambig_tvs)
          | Bool
    otherwise
          = [Implication]
    -> NonEmpty ErrorItem -> Maybe CND_Extra -> TcSolverReportMsg
    CouldNotDeduce [Implication]
    useful_givens (ErrorItem
    item ErrorItem -> [ErrorItem] -> NonEmpty ErrorItem
    forall a. a -> [a] -> NonEmpty a
    :| []) Maybe CND_Extra
    forall a. Maybe a
    Nothing

        -- Report "potential instances" only when the constraint arises
        -- directly from the user's use of an overloaded function
        want_potential :: CtOrigin -> Bool
    want_potential (TypeEqOrigin {}) = Bool
    False
        want_potential CtOrigin
    _                 = Bool
    True

        potential_msg :: SDoc
    potential_msg
          = Bool -> SDoc -> SDoc
    ppWhen (Bool -> Bool
    not ([ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers) Bool -> Bool -> Bool
    && CtOrigin -> Bool
    want_potential CtOrigin
    orig) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
              SDoc
    potential_hdr SDoc -> SDoc -> SDoc
    $$
              PotentialInstances -> SDoc
    potentialInstancesErrMsg (PotentialInstances { matches :: [ClsInst]
    matches = [], [ClsInst]
    unifiers :: [ClsInst]
    unifiers :: [ClsInst]
    unifiers })

        potential_hdr :: SDoc
    potential_hdr
          = Bool -> SDoc -> SDoc
    ppWhen Bool
    lead_with_ambig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            String -> SDoc
    text String
    "Probable fix: use a type annotation to specify what"
            SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    ambig_tvs SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "should be."

        mb_patsyn_prov :: Maybe SDoc
        mb_patsyn_prov :: Maybe SDoc
    mb_patsyn_prov
          | Bool -> Bool
    not Bool
    lead_with_ambig
          , ProvCtxtOrigin PSB{ psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
    psb_def = L SrcSpanAnnA
    _ Pat GhcRn
    pat } <- CtOrigin
    orig
          = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "In other words, a successful match on the pattern"
                       , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Pat GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcRn
    pat
                       , String -> SDoc
    text String
    "does not provide the constraint" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprParendType Type
    pred ])
          | Bool
    otherwise = Maybe SDoc
    forall a. Maybe a
    Nothing

        extra_note :: SDoc
    extra_note | (Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Type -> Bool
    isFunTy (TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes (Class -> TyCon
    classTyCon Class
    clas) [Type]
    tys)
                   = String -> SDoc
    text String
    "(maybe you haven't applied a function to enough arguments?)"
                   | Class -> Name
    className Class
    clas Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    typeableClassName  -- Avoid mysterious "No instance for (Typeable T)
                   , [Type
    _,Type
    ty] <- [Type]
    tys                        -- Look for (Typeable (k->*) (T k))
                   , Just (TyCon
    tc,[Type]
    _) <- HasCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    tcSplitTyConApp_maybe Type
    ty
                   , Bool -> Bool
    not (TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc)
                   = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "GHC can't yet do polykinded")
                        Int
    2 (String -> SDoc
    text String
    "Typeable" SDoc -> SDoc -> SDoc
    <+>
                           SDoc -> SDoc
    parens (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((() :: Constraint) => Type -> Type
    Type -> Type
    tcTypeKind Type
    ty)))
                   | Bool
    otherwise
                   = SDoc
    empty

        drv_fixes :: [SDoc]
    drv_fixes = case CtOrigin
    orig of
                       CtOrigin
    DerivClauseOrigin                  -> [Bool -> SDoc
    drv_fix Bool
    False]
                       CtOrigin
    StandAloneDerivOrigin              -> [Bool -> SDoc
    drv_fix Bool
    True]
                       DerivOriginDC DataCon
    _ Int
    _       Bool
    standalone -> [Bool -> SDoc
    drv_fix Bool
    standalone]
                       DerivOriginCoerce TcTyVar
    _ Type
    _ Type
    _ Bool
    standalone -> [Bool -> SDoc
    drv_fix Bool
    standalone]
                       CtOrigin
    _                -> []

        drv_fix :: Bool -> SDoc
    drv_fix Bool
    standalone_wildcard
          | Bool
    standalone_wildcard
          = String -> SDoc
    text String
    "fill in the wildcard constraint yourself"
          | Bool
    otherwise
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "use a standalone 'deriving instance' declaration,")
               Int
    2 (String -> SDoc
    text String
    "so you can specify the instance context yourself")

    pprTcSolverReportMsg (CEC {cec_encl :: SolverReportErrCtxt -> [Implication]
    cec_encl = [Implication]
    implics}) (OverlappingInstances ErrorItem
    item [ClsInst]
    matches [ClsInst]
    unifiers) =
      [SDoc] -> SDoc
    vcat
        [ CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            (String -> SDoc
    text String
    "Overlapping instances for"
            SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType (Class -> [Type] -> Type
    mkClassPred Class
    clas [Type]
    tys))
        , Bool -> SDoc -> SDoc
    ppUnless ([SDoc] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SDoc]
    matching_givens) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                      [SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "Matching givens (or their superclasses):"
                          , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat [SDoc]
    matching_givens)]
        ,  PotentialInstances -> SDoc
    potentialInstancesErrMsg
            (PotentialInstances { [ClsInst]
    matches :: [ClsInst]
    matches :: [ClsInst]
    matches, [ClsInst]
    unifiers :: [ClsInst]
    unifiers :: [ClsInst]
    unifiers })
        ,  Bool -> SDoc -> SDoc
    ppWhen ([SDoc] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SDoc]
    matching_givens Bool -> Bool -> Bool
    && [ClsInst] -> Bool
    forall a. [a] -> Bool
    isSingleton [ClsInst]
    matches Bool -> Bool -> Bool
    && [ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
           -- Intuitively, some given matched the wanted in their
           -- flattened or rewritten (from given equalities) form
           -- but the matcher can't figure that out because the
           -- constraints are non-flat and non-rewritten so we
           -- simply report back the whole given
           -- context. Accelerate Smart.hs showed this problem.
             [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "There exists a (perhaps superclass) match:"
                 , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat ([Implication] -> [SDoc]
    pp_givens [Implication]
    useful_givens))]

        ,  Bool -> SDoc -> SDoc
    ppWhen ([ClsInst] -> Bool
    forall a. [a] -> Bool
    isSingleton [ClsInst]
    matches) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
           SDoc -> SDoc
    parens ([SDoc] -> SDoc
    vcat [ Bool -> SDoc -> SDoc
    ppUnless ([TcTyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    tyCoVars) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                            String -> SDoc
    text String
    "The choice depends on the instantiation of" SDoc -> SDoc -> SDoc
    <+>
                              SDoc -> SDoc
    quotes ((TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TcTyVar]
    tyCoVars)
                        , Bool -> SDoc -> SDoc
    ppUnless ([TyCon] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCon]
    famTyCons) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                            if ([TcTyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    tyCoVars)
                              then
                                String -> SDoc
    text String
    "The choice depends on the result of evaluating" SDoc -> SDoc -> SDoc
    <+>
                                  SDoc -> SDoc
    quotes ((TyCon -> SDoc) -> [TyCon] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyCon]
    famTyCons)
                              else
                                String -> SDoc
    text String
    "and the result of evaluating" SDoc -> SDoc -> SDoc
    <+>
                                  SDoc -> SDoc
    quotes ((TyCon -> SDoc) -> [TyCon] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyCon]
    famTyCons)
                        , Bool -> SDoc -> SDoc
    ppWhen ([SDoc] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([SDoc]
    matching_givens)) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                          [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "To pick the first instance above, use IncoherentInstances"
                               , String -> SDoc
    text String
    "when compiling the other instance declarations"]
                   ])]
      where
        orig :: CtOrigin
    orig            = ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item
        pred :: Type
    pred            = ErrorItem -> Type
    errorItemPred ErrorItem
    item
        (Class
    clas, [Type]
    tys)     = (() :: Constraint) => Type -> (Class, [Type])
    Type -> (Class, [Type])
    getClassPredTys Type
    pred
        tyCoVars :: [TcTyVar]
    tyCoVars        = [Type] -> [TcTyVar]
    tyCoVarsOfTypesList [Type]
    tys
        famTyCons :: [TyCon]
    famTyCons       = (TyCon -> Bool) -> [TyCon] -> [TyCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filter TyCon -> Bool
    isFamilyTyCon ([TyCon] -> [TyCon]) -> [TyCon] -> [TyCon]
    forall a b. (a -> b) -> a -> b
    $ (Type -> [TyCon]) -> [Type] -> [TyCon]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (UniqSet TyCon -> [TyCon]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet (UniqSet TyCon -> [TyCon])
    -> (Type -> UniqSet TyCon) -> Type -> [TyCon]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> UniqSet TyCon
    tyConsOfType) [Type]
    tys
        useful_givens :: [Implication]
    useful_givens   = CtOrigin -> [Implication] -> [Implication]
    discardProvCtxtGivens CtOrigin
    orig ([Implication] -> [Implication]
    getUserGivensFromImplics [Implication]
    implics)
        matching_givens :: [SDoc]
    matching_givens = (Implication -> Maybe SDoc) -> [Implication] -> [SDoc]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Implication -> Maybe SDoc
    matchable [Implication]
    useful_givens
        matchable :: Implication -> Maybe SDoc
    matchable implic :: Implication
    implic@(Implic { ic_given :: Implication -> [TcTyVar]
    ic_given = [TcTyVar]
    evvars, ic_info :: Implication -> SkolemInfoAnon
    ic_info = SkolemInfoAnon
    skol_info })
          = case [Type]
    ev_vars_matching of
                 [] -> Maybe SDoc
    forall a. Maybe a
    Nothing
                 [Type]
    _  -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Int -> SDoc -> SDoc
    hang ([Type] -> SDoc
    pprTheta [Type]
    ev_vars_matching)
                                Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "bound by" SDoc -> SDoc -> SDoc
    <+> SkolemInfoAnon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfoAnon
    skol_info
                                       , String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+>
                                         RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    getLclEnvLoc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ])
            where ev_vars_matching :: [Type]
    ev_vars_matching = [ Type
    pred
                                     | TcTyVar
    ev_var <- [TcTyVar]
    evvars
                                     , let pred :: Type
    pred = TcTyVar -> Type
    evVarPred TcTyVar
    ev_var
                                     , (Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Type -> Bool
    can_match (Type
    pred Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : Type -> [Type]
    transSuperClasses Type
    pred) ]
                  can_match :: Type -> Bool
    can_match Type
    pred
                     = case Type -> Maybe (Class, [Type])
    getClassPredTys_maybe Type
    pred of
                         Just (Class
    clas', [Type]
    tys') -> Class
    clas' Class -> Class -> Bool
    forall a. Eq a => a -> a -> Bool
    == Class
    clas
                                              Bool -> Bool -> Bool
    && Maybe TCvSubst -> Bool
    forall a. Maybe a -> Bool
    isJust ([Type] -> [Type] -> Maybe TCvSubst
    tcMatchTys [Type]
    tys [Type]
    tys')
                         Maybe (Class, [Type])
    Nothing -> Bool
    False
    pprTcSolverReportMsg SolverReportErrCtxt
    _ (UnsafeOverlap ErrorItem
    item [ClsInst]
    matches [ClsInst]
    unsafe_overlapped) =
      [SDoc] -> SDoc
    vcat [ CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (String -> SDoc
    text String
    "Unsafe overlapping instances for"
                      SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType (Class -> [Type] -> Type
    mkClassPred Class
    clas [Type]
    tys))
           , [SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "The matching instance is:",
                  Int -> SDoc -> SDoc
    nest Int
    2 (ClsInst -> SDoc
    pprInstance (ClsInst -> SDoc) -> ClsInst -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [ClsInst] -> ClsInst
    forall a. HasCallStack => [a] -> a
    head [ClsInst]
    matches)]
           , [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "It is compiled in a Safe module and as such can only"
                  , String -> SDoc
    text String
    "overlap instances from the same module, however it"
                  , String -> SDoc
    text String
    "overlaps the following instances from different" SDoc -> SDoc -> SDoc
    <+>
                    String -> SDoc
    text String
    "modules:"
                  , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat [[ClsInst] -> SDoc
    pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [ClsInst]
    unsafe_overlapped])
                  ]
           ]
      where
        orig :: CtOrigin
    orig        = ErrorItem -> CtOrigin
    errorItemOrigin ErrorItem
    item
        pred :: Type
    pred        = ErrorItem -> Type
    errorItemPred ErrorItem
    item
        (Class
    clas, [Type]
    tys) = (() :: Constraint) => Type -> (Class, [Type])
    Type -> (Class, [Type])
    getClassPredTys Type
    pred

    {- *********************************************************************
    *                                                                      *
                     Displaying potential instances
    *                                                                      *
    **********************************************************************-}

    -- | Directly display the given matching and unifying instances,
    -- with a header for each: `Matching instances`/`Potentially matching instances`.
    pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc
    pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc
    pprPotentialInstances ClsInst -> SDoc
    ppr_inst (PotentialInstances { [ClsInst]
    matches :: PotentialInstances -> [ClsInst]
    matches :: [ClsInst]
    matches, [ClsInst]
    unifiers :: PotentialInstances -> [ClsInst]
    unifiers :: [ClsInst]
    unifiers }) =
      [SDoc] -> SDoc
    vcat
        [ Bool -> SDoc -> SDoc
    ppWhen (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    matches) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
           String -> SDoc
    text String
    "Matching instance" SDoc -> SDoc -> SDoc
    <> [ClsInst] -> SDoc
    forall a. [a] -> SDoc
    plural [ClsInst]
    matches SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    $$
             Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> SDoc
    ppr_inst [ClsInst]
    matches))
        , Bool -> SDoc -> SDoc
    ppWhen (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            (String -> SDoc
    text String
    "Potentially matching instance" SDoc -> SDoc -> SDoc
    <> [ClsInst] -> SDoc
    forall a. [a] -> SDoc
    plural [ClsInst]
    unifiers SDoc -> SDoc -> SDoc
    <> SDoc
    colon) SDoc -> SDoc -> SDoc
    $$
             Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> SDoc
    ppr_inst [ClsInst]
    unifiers))
        ]

    -- | Display a summary of available instances, omitting those involving
    -- out-of-scope types, in order to explain why we couldn't solve a particular
    -- constraint, e.g. due to instance overlap or out-of-scope types.
    --
    -- To directly display a collection of matching/unifying instances,
    -- use 'pprPotentialInstances'.
    potentialInstancesErrMsg :: PotentialInstances -> SDoc
    -- See Note [Displaying potential instances]
    potentialInstancesErrMsg :: PotentialInstances -> SDoc
    potentialInstancesErrMsg PotentialInstances
    potentials =
      (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintPotentialInstances ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Bool
    print_insts ->
      (PprStyle -> SDoc) -> SDoc
    getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \PprStyle
    sty ->
        PotentialInstances -> Bool -> PprStyle -> SDoc
    potentials_msg_with_options PotentialInstances
    potentials Bool
    print_insts PprStyle
    sty

    -- | Display a summary of available instances, omitting out-of-scope ones.
    --
    -- Use 'potentialInstancesErrMsg' to automatically set the pretty-printing
    -- options.
    potentials_msg_with_options :: PotentialInstances
                                -> Bool -- ^ Whether to print /all/ potential instances
                                -> PprStyle
                                -> SDoc
    potentials_msg_with_options :: PotentialInstances -> Bool -> PprStyle -> SDoc
    potentials_msg_with_options
      (PotentialInstances { [ClsInst]
    matches :: PotentialInstances -> [ClsInst]
    matches :: [ClsInst]
    matches, [ClsInst]
    unifiers :: PotentialInstances -> [ClsInst]
    unifiers :: [ClsInst]
    unifiers })
      Bool
    show_all_potentials PprStyle
    sty
      | [ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    matches Bool -> Bool -> Bool
    && [ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers
      = SDoc
    empty

      | [ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    show_these_matches Bool -> Bool -> Bool
    && [ClsInst] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    show_these_unifiers
      = [SDoc] -> SDoc
    vcat [ SDoc -> SDoc
    not_in_scope_msg SDoc
    empty
             , SDoc
    flag_hint ]

      | Bool
    otherwise
      = [SDoc] -> SDoc
    vcat [ (ClsInst -> SDoc) -> PotentialInstances -> SDoc
    pprPotentialInstances
                ClsInst -> SDoc
    pprInstance -- print instance + location info
                (PotentialInstances
                  { matches :: [ClsInst]
    matches  = [ClsInst]
    show_these_matches
                  , unifiers :: [ClsInst]
    unifiers = [ClsInst]
    show_these_unifiers })
             , [ClsInst] -> SDoc
    overlapping_but_not_more_specific_msg [ClsInst]
    sorted_matches
             , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
               [ Bool -> SDoc -> SDoc
    ppWhen (Int
    n_in_scope_hidden Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                 String -> SDoc
    text String
    "...plus"
                   SDoc -> SDoc -> SDoc
    <+> Int -> SDoc -> SDoc
    speakNOf Int
    n_in_scope_hidden (String -> SDoc
    text String
    "other")
               , Bool -> SDoc -> SDoc
    ppWhen (Int
    not_in_scopes Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                  SDoc -> SDoc
    not_in_scope_msg (String -> SDoc
    text String
    "...plus")
               , SDoc
    flag_hint ] ]
      where
        n_show_matches, n_show_unifiers :: Int
        n_show_matches :: Int
    n_show_matches  = Int
    3
        n_show_unifiers :: Int
    n_show_unifiers = Int
    2

        ([ClsInst]
    in_scope_matches, [ClsInst]
    not_in_scope_matches) = (ClsInst -> Bool) -> [ClsInst] -> ([ClsInst], [ClsInst])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ClsInst -> Bool
    inst_in_scope [ClsInst]
    matches
        ([ClsInst]
    in_scope_unifiers, [ClsInst]
    not_in_scope_unifiers) = (ClsInst -> Bool) -> [ClsInst] -> ([ClsInst], [ClsInst])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ClsInst -> Bool
    inst_in_scope [ClsInst]
    unifiers
        sorted_matches :: [ClsInst]
    sorted_matches = (ClsInst -> ClsInst -> Ordering) -> [ClsInst] -> [ClsInst]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ClsInst -> ClsInst -> Ordering
    fuzzyClsInstCmp [ClsInst]
    in_scope_matches
        sorted_unifiers :: [ClsInst]
    sorted_unifiers = (ClsInst -> ClsInst -> Ordering) -> [ClsInst] -> [ClsInst]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ClsInst -> ClsInst -> Ordering
    fuzzyClsInstCmp [ClsInst]
    in_scope_unifiers
        ([ClsInst]
    show_these_matches, [ClsInst]
    show_these_unifiers)
           | Bool
    show_all_potentials = ([ClsInst]
    sorted_matches, [ClsInst]
    sorted_unifiers)
           | Bool
    otherwise           = (Int -> [ClsInst] -> [ClsInst]
    forall a. Int -> [a] -> [a]
    take Int
    n_show_matches  [ClsInst]
    sorted_matches
                                   ,Int -> [ClsInst] -> [ClsInst]
    forall a. Int -> [a] -> [a]
    take Int
    n_show_unifiers [ClsInst]
    sorted_unifiers)
        n_in_scope_hidden :: Int
    n_in_scope_hidden
          = [ClsInst] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    sorted_matches Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [ClsInst] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    sorted_unifiers
          Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [ClsInst] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    show_these_matches Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [ClsInst] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    show_these_unifiers

           -- "in scope" means that all the type constructors
           -- are lexically in scope; these instances are likely
           -- to be more useful
        inst_in_scope :: ClsInst -> Bool
        inst_in_scope :: ClsInst -> Bool
    inst_in_scope ClsInst
    cls_inst = (Name -> Bool) -> NameSet -> Bool
    nameSetAll Name -> Bool
    name_in_scope (NameSet -> Bool) -> NameSet -> Bool
    forall a b. (a -> b) -> a -> b
    $
                                 [Type] -> NameSet
    orphNamesOfTypes (ClsInst -> [Type]
    is_tys ClsInst
    cls_inst)

        name_in_scope :: Name -> Bool
    name_in_scope Name
    name
          | Name -> Bool
    pretendNameIsInScope Name
    name
          = Bool
    True -- E.g. (->); see Note [pretendNameIsInScope] in GHC.Builtin.Names
          | Just Module
    mod <- Name -> Maybe Module
    nameModule_maybe Name
    name
          = QualifyName -> Bool
    qual_in_scope (PprStyle -> QueryQualifyName
    qualName PprStyle
    sty Module
    mod (Name -> OccName
    nameOccName Name
    name))
          | Bool
    otherwise
          = Bool
    True

        qual_in_scope :: QualifyName -> Bool
        qual_in_scope :: QualifyName -> Bool
    qual_in_scope QualifyName
    NameUnqual    = Bool
    True
        qual_in_scope (NameQual {}) = Bool
    True
        qual_in_scope QualifyName
    _             = Bool
    False

        not_in_scopes :: Int
        not_in_scopes :: Int
    not_in_scopes = [ClsInst] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    not_in_scope_matches Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [ClsInst] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    not_in_scope_unifiers

        not_in_scope_msg :: SDoc -> SDoc
    not_in_scope_msg SDoc
    herald =
          SDoc -> Int -> SDoc -> SDoc
    hang (SDoc
    herald SDoc -> SDoc -> SDoc
    <+> Int -> SDoc -> SDoc
    speakNOf Int
    not_in_scopes (String -> SDoc
    text String
    "instance")
                         SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "involving out-of-scope types")
               Int
    2 (Bool -> SDoc -> SDoc
    ppWhen Bool
    show_all_potentials (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                   (ClsInst -> SDoc) -> PotentialInstances -> SDoc
    pprPotentialInstances
                   ClsInst -> SDoc
    pprInstanceHdr -- only print the header, not the instance location info
                     (PotentialInstances
                       { matches :: [ClsInst]
    matches = [ClsInst]
    not_in_scope_matches
                       , unifiers :: [ClsInst]
    unifiers = [ClsInst]
    not_in_scope_unifiers
                       }))

        flag_hint :: SDoc
    flag_hint = Bool -> SDoc -> SDoc
    ppUnless (Bool
    show_all_potentials
                             Bool -> Bool -> Bool
    || ([ClsInst] -> [ClsInst] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [ClsInst]
    show_these_matches [ClsInst]
    matches
                                 Bool -> Bool -> Bool
    && [ClsInst] -> [ClsInst] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [ClsInst]
    show_these_unifiers [ClsInst]
    unifiers)) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    String -> SDoc
    text String
    "(use -fprint-potential-instances to see them all)"

    -- | Compute a message informing the user of any instances that are overlapped
    -- but were not discarded because the instance overlapping them wasn't
    -- strictly more specific.
    overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc
    overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc
    overlapping_but_not_more_specific_msg [ClsInst]
    insts
      -- Only print one example of "overlapping but not strictly more specific",
      -- to avoid information overload.
      | (ClsInst, ClsInst)
    overlap : [(ClsInst, ClsInst)]
    _ <- [(ClsInst, ClsInst)]
    overlapping_but_not_more_specific
      = SDoc
    overlap_header SDoc -> SDoc -> SDoc
    $$ (ClsInst, ClsInst) -> SDoc
    ppr_overlapping (ClsInst, ClsInst)
    overlap
      | Bool
    otherwise
      = SDoc
    empty
        where
          overlap_header :: SDoc
          overlap_header :: SDoc
    overlap_header
            | [(ClsInst, ClsInst)
    _] <- [(ClsInst, ClsInst)]
    overlapping_but_not_more_specific
            = String -> SDoc
    text String
    "An overlapping instance can only be chosen when it is strictly more specific."
            | Bool
    otherwise
            = String -> SDoc
    text String
    "Overlapping instances can only be chosen when they are strictly more specific."
          overlapping_but_not_more_specific :: [(ClsInst, ClsInst)]
          overlapping_but_not_more_specific :: [(ClsInst, ClsInst)]
    overlapping_but_not_more_specific
            = ((ClsInst, ClsInst) -> (ClsInst, ClsInst) -> Ordering)
    -> [(ClsInst, ClsInst)] -> [(ClsInst, ClsInst)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    nubOrdBy (((ClsInst, ClsInst) -> TcTyVar)
    -> (ClsInst, ClsInst) -> (ClsInst, ClsInst) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (ClsInst -> TcTyVar
    is_dfun (ClsInst -> TcTyVar)
    -> ((ClsInst, ClsInst) -> ClsInst) -> (ClsInst, ClsInst) -> TcTyVar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClsInst, ClsInst) -> ClsInst
    forall a b. (a, b) -> a
    fst))
              [ (ClsInst
    overlapper, ClsInst
    overlappee)
              | [ClsInst]
    these <- (ClsInst -> ClsInst -> Bool) -> [ClsInst] -> [[ClsInst]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Name -> Name -> Bool)
    -> (ClsInst -> Name) -> ClsInst -> ClsInst -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` ClsInst -> Name
    is_cls_nm) [ClsInst]
    insts
              -- Take all pairs of distinct instances...
              , ClsInst
    one:[ClsInst]
    others <- [ClsInst] -> [[ClsInst]]
    forall a. [a] -> [[a]]
    tails [ClsInst]
    these -- if `these = [inst_1, inst_2, ...]`
              , ClsInst
    other <- [ClsInst]
    others           -- then we get pairs `(one, other) = (inst_i, inst_j)` with `i < j`
              -- ... such that one instance in the pair overlaps the other...
              , let mb_overlapping :: [(ClsInst, ClsInst)]
    mb_overlapping
                      | OverlapMode -> Bool
    hasOverlappingFlag (OverlapFlag -> OverlapMode
    overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
    forall a b. (a -> b) -> a -> b
    $ ClsInst -> OverlapFlag
    is_flag ClsInst
    one)
                      Bool -> Bool -> Bool
    || OverlapMode -> Bool
    hasOverlappableFlag (OverlapFlag -> OverlapMode
    overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
    forall a b. (a -> b) -> a -> b
    $ ClsInst -> OverlapFlag
    is_flag ClsInst
    other)
                      = [(ClsInst
    one, ClsInst
    other)]
                      | OverlapMode -> Bool
    hasOverlappingFlag (OverlapFlag -> OverlapMode
    overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
    forall a b. (a -> b) -> a -> b
    $ ClsInst -> OverlapFlag
    is_flag ClsInst
    other)
                      Bool -> Bool -> Bool
    || OverlapMode -> Bool
    hasOverlappableFlag (OverlapFlag -> OverlapMode
    overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
    forall a b. (a -> b) -> a -> b
    $ ClsInst -> OverlapFlag
    is_flag ClsInst
    one)
                      = [(ClsInst
    other, ClsInst
    one)]
                      | Bool
    otherwise
                      = []
              , (ClsInst
    overlapper, ClsInst
    overlappee) <- [(ClsInst, ClsInst)]
    mb_overlapping
              -- ... but the overlapper is not more specific than the overlappee.
              , Bool -> Bool
    not (ClsInst
    overlapper ClsInst -> ClsInst -> Bool
    `more_specific_than` ClsInst
    overlappee)
              ]
          more_specific_than :: ClsInst -> ClsInst -> Bool
          ClsInst
    is1 more_specific_than :: ClsInst -> ClsInst -> Bool
    `more_specific_than` ClsInst
    is2
            = Maybe TCvSubst -> Bool
    forall a. Maybe a -> Bool
    isJust ([Type] -> [Type] -> Maybe TCvSubst
    tcMatchTys (ClsInst -> [Type]
    is_tys ClsInst
    is1) (ClsInst -> [Type]
    is_tys ClsInst
    is2))
          ppr_overlapping :: (ClsInst, ClsInst) -> SDoc
          ppr_overlapping :: (ClsInst, ClsInst) -> SDoc
    ppr_overlapping (ClsInst
    overlapper, ClsInst
    overlappee)
            = String -> SDoc
    text String
    "The first instance that follows overlaps the second, but is not more specific than it:"
            SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> SDoc
    pprInstanceHdr [ClsInst
    overlapper, ClsInst
    overlappee])

    {- Note [Displaying potential instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When showing a list of instances for
      - overlapping instances (show ones that match)
      - no such instance (show ones that could match)
    we want to give it a bit of structure.  Here's the plan

    * Say that an instance is "in scope" if all of the
      type constructors it mentions are lexically in scope.
      These are the ones most likely to be useful to the programmer.

    * Show at most n_show in-scope instances,
      and summarise the rest ("plus N others")

    * Summarise the not-in-scope instances ("plus 4 not in scope")

    * Add the flag -fshow-potential-instances which replaces the
      summary with the full list
    -}

    {- *********************************************************************
    *                                                                      *
                        Outputting TcSolverReportInfo
    *                                                                      *
    **********************************************************************-}

    -- | Pretty-print an informational message, to accompany a 'TcSolverReportMsg'.
    pprTcSolverReportInfo :: SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo :: SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo SolverReportErrCtxt
    _ (Ambiguity Bool
    prepend_msg ([TcTyVar]
    ambig_kvs, [TcTyVar]
    ambig_tvs)) = SDoc
    msg
      where

        msg :: SDoc
    msg |  (TcTyVar -> Bool) -> [TcTyVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcTyVar -> Bool
    isRuntimeUnkSkol [TcTyVar]
    ambig_kvs  -- See Note [Runtime skolems]
            Bool -> Bool -> Bool
    || (TcTyVar -> Bool) -> [TcTyVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcTyVar -> Bool
    isRuntimeUnkSkol [TcTyVar]
    ambig_tvs
            = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Cannot resolve unknown runtime type"
                     SDoc -> SDoc -> SDoc
    <> [TcTyVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TcTyVar]
    ambig_tvs SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    ambig_tvs
                   , String -> SDoc
    text String
    "Use :print or :force to determine these types"]

            | Bool -> Bool
    not ([TcTyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    ambig_tvs)
            = SDoc -> [TcTyVar] -> SDoc
    pp_ambig (String -> SDoc
    text String
    "type") [TcTyVar]
    ambig_tvs

            | Bool
    otherwise
            = SDoc -> [TcTyVar] -> SDoc
    pp_ambig (String -> SDoc
    text String
    "kind") [TcTyVar]
    ambig_kvs

        pp_ambig :: SDoc -> [TcTyVar] -> SDoc
    pp_ambig SDoc
    what [TcTyVar]
    tkvs
          | Bool
    prepend_msg -- "Ambiguous type variable 't0'"
          = String -> SDoc
    text String
    "Ambiguous" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable"
            SDoc -> SDoc -> SDoc
    <> [TcTyVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TcTyVar]
    tkvs SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    tkvs

          | Bool
    otherwise -- "The type variable 't0' is ambiguous"
          = String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable" SDoc -> SDoc -> SDoc
    <> [TcTyVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TcTyVar]
    tkvs
            SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    tkvs SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    forall a. [a] -> SDoc
    isOrAre [TcTyVar]
    tkvs SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "ambiguous"
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt (TyVarInfo TcTyVar
    tv ) =
      case TcTyVar -> TcTyVarDetails
    tcTyVarDetails TcTyVar
    tv of
        SkolemTv SkolemInfo
    sk_info TcLevel
    _ Bool
    _   -> SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
    pprSkols SolverReportErrCtxt
    ctxt [(SkolemInfo -> SkolemInfoAnon
    getSkolemInfo SkolemInfo
    sk_info, [TcTyVar
    tv])]
        RuntimeUnk {} -> SDoc -> SDoc
    quotes (TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is an interactive-debugger skolem"
        MetaTv {}     -> SDoc
    empty
    pprTcSolverReportInfo SolverReportErrCtxt
    _ (NonInjectiveTyFam TyCon
    tc) =
      String -> SDoc
    text String
    "NB:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc)
      SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is a non-injective type family"
    pprTcSolverReportInfo SolverReportErrCtxt
    _ (ReportCoercibleMsg CoercibleMsg
    msg) =
      CoercibleMsg -> SDoc
    pprCoercibleMsg CoercibleMsg
    msg
    pprTcSolverReportInfo SolverReportErrCtxt
    _ (ExpectedActual { ea_expected :: TcSolverReportInfo -> Type
    ea_expected = Type
    exp, ea_actual :: TcSolverReportInfo -> Type
    ea_actual = Type
    act }) =
      [SDoc] -> SDoc
    vcat
        [ String -> SDoc
    text String
    "Expected:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    exp
        , String -> SDoc
    text String
    "  Actual:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    act ]
    pprTcSolverReportInfo SolverReportErrCtxt
    _
      (ExpectedActualAfterTySynExpansion
        { ea_expanded_expected :: TcSolverReportInfo -> Type
    ea_expanded_expected = Type
    exp
        , ea_expanded_actual :: TcSolverReportInfo -> Type
    ea_expanded_actual   = Type
    act } )
      = [SDoc] -> SDoc
    vcat
          [ String -> SDoc
    text String
    "Type synonyms expanded:"
          , String -> SDoc
    text String
    "Expected type:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    exp
          , String -> SDoc
    text String
    "  Actual type:" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    act ]
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt (WhenMatching Type
    cty1 Type
    cty2 CtOrigin
    sub_o Maybe TypeOrKind
    mb_sub_t_or_k) =
      (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Bool
    printExplicitCoercions ->
        if Bool
    printExplicitCoercions
           Bool -> Bool -> Bool
    || Bool -> Bool
    not (Type
    cty1 Type -> Type -> Bool
    `pickyEqType` Type
    cty2)
          then [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "When matching" SDoc -> SDoc -> SDoc
    <+> SDoc
    sub_whats)
                          Int
    2 ([SDoc] -> SDoc
    vcat [ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    cty1 SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+>
                                   Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((() :: Constraint) => Type -> Type
    Type -> Type
    tcTypeKind Type
    cty1)
                                 , Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    cty2 SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+>
                                   Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((() :: Constraint) => Type -> Type
    Type -> Type
    tcTypeKind Type
    cty2) ])
                    , SDoc
    supplementary ]
          else String -> SDoc
    text String
    "When matching the kind of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    cty1)
      where
        sub_t_or_k :: TypeOrKind
    sub_t_or_k = Maybe TypeOrKind
    mb_sub_t_or_k Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel
        sub_whats :: SDoc
    sub_whats  = String -> SDoc
    text (TypeOrKind -> String
    levelString TypeOrKind
    sub_t_or_k) SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    's'
        supplementary :: SDoc
    supplementary =
          case SolverReportErrCtxt
    -> TypeOrKind
    -> Type
    -> Type
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_supplementary_ea_msg SolverReportErrCtxt
    ctxt TypeOrKind
    sub_t_or_k Type
    cty1 Type
    cty2 CtOrigin
    sub_o of
            Left [TcSolverReportInfo]
    infos -> [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (TcSolverReportInfo -> SDoc) -> [TcSolverReportInfo] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt) [TcSolverReportInfo]
    infos
            Right TcSolverReportMsg
    msg  -> SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
    pprTcSolverReportMsg SolverReportErrCtxt
    ctxt TcSolverReportMsg
    msg
    pprTcSolverReportInfo SolverReportErrCtxt
    _ (SameOcc Bool
    same_pkg Name
    n1 Name
    n2) =
      String -> SDoc
    text String
    "NB:" SDoc -> SDoc -> SDoc
    <+> (Bool -> Name -> SDoc
    ppr_from Bool
    same_pkg Name
    n1 SDoc -> SDoc -> SDoc
    $$ Bool -> Name -> SDoc
    ppr_from Bool
    same_pkg Name
    n2)
      where
        ppr_from :: Bool -> Name -> SDoc
    ppr_from Bool
    same_pkg Name
    nm
          | SrcSpan -> Bool
    isGoodSrcSpan SrcSpan
    loc
          = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    nm) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is defined at")
               Int
    2 (SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    loc)
          | Bool
    otherwise  -- Imported things have an UnhelpfulSrcSpan
          = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    nm))
               Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "is defined in" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod))
                      , Bool -> SDoc -> SDoc
    ppUnless (Bool
    same_pkg Bool -> Bool -> Bool
    || Unit
    pkg Unit -> Unit -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unit
    mainUnit) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                        Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "in package" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Unit -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unit
    pkg) ])
          where
            pkg :: Unit
    pkg = Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod
            mod :: Module
    mod = (() :: Constraint) => Name -> Module
    Name -> Module
    nameModule Name
    nm
            loc :: SrcSpan
    loc = Name -> SrcSpan
    nameSrcSpan Name
    nm
    pprTcSolverReportInfo SolverReportErrCtxt
    ctxt (OccursCheckInterestingTyVars (TcTyVar
    tv :| [TcTyVar]
    tvs)) =
      SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Type variable kinds:") Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
        [SDoc] -> SDoc
    vcat ((TcTyVar -> SDoc) -> [TcTyVar] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (TcTyVar -> SDoc
    tyvar_binding (TcTyVar -> SDoc) -> (TcTyVar -> TcTyVar) -> TcTyVar -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TidyEnv -> TcTyVar -> TcTyVar
    tidyTyCoVarOcc (SolverReportErrCtxt -> TidyEnv
    cec_tidy SolverReportErrCtxt
    ctxt))
                  (TcTyVar
    tvTcTyVar -> [TcTyVar] -> [TcTyVar]
    forall a. a -> [a] -> [a]
    :[TcTyVar]
    tvs))
      where
        tyvar_binding :: TcTyVar -> SDoc
    tyvar_binding TcTyVar
    tyvar = TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tyvar SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcTyVar -> Type
    tyVarKind TcTyVar
    tyvar)

    pprCoercibleMsg :: CoercibleMsg -> SDoc
    pprCoercibleMsg :: CoercibleMsg -> SDoc
    pprCoercibleMsg (UnknownRoles Type
    ty) =
      SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "NB: We cannot know what roles the parameters to" SDoc -> SDoc -> SDoc
    <+>
              SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "have;")
           Int
    2 (String -> SDoc
    text String
    "we must assume that the role is nominal")
    pprCoercibleMsg (TyConIsAbstract TyCon
    tc) =
      [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "NB: The type constructor"
           , SDoc -> SDoc
    quotes (TyCon -> SDoc
    pprSourceTyCon TyCon
    tc)
           , String -> SDoc
    text String
    "is abstract" ]
    pprCoercibleMsg (OutOfScopeNewtypeConstructor TyCon
    tc DataCon
    dc) =
      SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The data constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> SDoc) -> Name -> SDoc
    forall a b. (a -> b) -> a -> b
    $ DataCon -> Name
    dataConName DataCon
    dc))
        Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "of newtype" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    pprSourceTyCon TyCon
    tc)
               , String -> SDoc
    text String
    "is not in scope" ])

    {- *********************************************************************
    *                                                                      *
                      Outputting HoleError messages
    *                                                                      *
    **********************************************************************-}

    pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
    pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
    pprHoleError SolverReportErrCtxt
    _ (Hole { Type
    hole_ty :: Type
    hole_ty :: Hole -> Type
    hole_ty, hole_occ :: Hole -> OccName
    hole_occ = OccName
    occ }) (OutOfScopeHole [ImportError]
    imp_errs)
      = SDoc
    out_of_scope_msg SDoc -> SDoc -> SDoc
    $$ [SDoc] -> SDoc
    vcat ((ImportError -> SDoc) -> [ImportError] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ImportError -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ImportError]
    imp_errs)
      where
        herald :: SDoc
    herald | OccName -> Bool
    isDataOcc OccName
    occ = String -> SDoc
    text String
    "Data constructor not in scope:"
               | Bool
    otherwise     = String -> SDoc
    text String
    "Variable not in scope:"
        out_of_scope_msg :: SDoc
    out_of_scope_msg -- Print v :: ty only if the type has structure
          | Bool
    boring_type = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ)
          | Bool
    otherwise   = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 (OccName -> Type -> SDoc
    pp_occ_with_type OccName
    occ Type
    hole_ty)
        boring_type :: Bool
    boring_type = Type -> Bool
    isTyVarTy Type
    hole_ty
    pprHoleError SolverReportErrCtxt
    ctxt (Hole { Type
    hole_ty :: Hole -> Type
    hole_ty :: Type
    hole_ty, OccName
    hole_occ :: Hole -> OccName
    hole_occ :: OccName
    hole_occ}) (HoleError HoleSort
    sort [TcTyVar]
    other_tvs [(SkolemInfoAnon, [TcTyVar])]
    hole_skol_info) =
      [SDoc] -> SDoc
    vcat [ SDoc
    hole_msg
           , SDoc
    tyvars_msg
           , case HoleSort
    sort of { ExprHole {} -> SDoc
    expr_hole_hint; HoleSort
    _ -> SDoc
    type_hole_hint } ]

      where

        hole_msg :: SDoc
    hole_msg = case HoleSort
    sort of
          ExprHole {} ->
            SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Found hole:")
              Int
    2 (OccName -> Type -> SDoc
    pp_occ_with_type OccName
    hole_occ Type
    hole_ty)
          HoleSort
    TypeHole ->
            SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Found type wildcard" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    hole_occ))
              Int
    2 (String -> SDoc
    text String
    "standing for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    pp_hole_type_with_kind)
          HoleSort
    ConstraintHole ->
            SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Found extra-constraints wildcard standing for")
              Int
    2 (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Type -> SDoc
    pprType Type
    hole_ty)  -- always kind constraint

        hole_kind :: Type
    hole_kind = (() :: Constraint) => Type -> Type
    Type -> Type
    tcTypeKind Type
    hole_ty

        pp_hole_type_with_kind :: SDoc
    pp_hole_type_with_kind
          | Type -> Bool
    isLiftedTypeKind Type
    hole_kind
            Bool -> Bool -> Bool
    || Type -> Bool
    isCoVarType Type
    hole_ty -- Don't print the kind of unlifted
                                   -- equalities (#15039)
          = Type -> SDoc
    pprType Type
    hole_ty
          | Bool
    otherwise
          = Type -> SDoc
    pprType Type
    hole_ty SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprKind Type
    hole_kind

        tyvars :: [TcTyVar]
    tyvars = Type -> [TcTyVar]
    tyCoVarsOfTypeList Type
    hole_ty
        tyvars_msg :: SDoc
    tyvars_msg = Bool -> SDoc -> SDoc
    ppUnless ([TcTyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcTyVar]
    tyvars) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                     String -> SDoc
    text String
    "Where:" SDoc -> SDoc -> SDoc
    <+> ([SDoc] -> SDoc
    vcat ((TcTyVar -> SDoc) -> [TcTyVar] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map TcTyVar -> SDoc
    loc_msg [TcTyVar]
    other_tvs)
                                        SDoc -> SDoc -> SDoc
    $$ SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
    pprSkols SolverReportErrCtxt
    ctxt [(SkolemInfoAnon, [TcTyVar])]
    hole_skol_info)
                          -- Coercion variables can be free in the
                          -- hole, via kind casts
        expr_hole_hint :: SDoc
    expr_hole_hint                       -- Give hint for, say,   f x = _x
             | FieldLabelString -> Int
    lengthFS (OccName -> FieldLabelString
    occNameFS OccName
    hole_occ) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1  -- Don't give this hint for plain "_"
             = String -> SDoc
    text String
    "Or perhaps" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    hole_occ)
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is mis-spelled, or not in scope"
             | Bool
    otherwise
             = SDoc
    empty

        type_hole_hint :: SDoc
    type_hole_hint
             | DiagnosticReason
    ErrorWithoutFlag <- SolverReportErrCtxt -> DiagnosticReason
    cec_type_holes SolverReportErrCtxt
    ctxt
             = String -> SDoc
    text String
    "To use the inferred type, enable PartialTypeSignatures"
             | Bool
    otherwise
             = SDoc
    empty

        loc_msg :: TcTyVar -> SDoc
    loc_msg TcTyVar
    tv
           | TcTyVar -> Bool
    isTyVar TcTyVar
    tv
           = case TcTyVar -> TcTyVarDetails
    tcTyVarDetails TcTyVar
    tv of
               MetaTv {} -> SDoc -> SDoc
    quotes (TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is an ambiguous type variable"
               TcTyVarDetails
    _         -> SDoc
    empty  -- Skolems dealt with already
           | Bool
    otherwise  -- A coercion variable can be free in the hole type
           = (SDocContext -> Bool) -> SDoc -> SDoc
    ppWhenOption SDocContext -> Bool
    sdocPrintExplicitCoercions (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> SDoc
    quotes (TcTyVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyVar
    tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is a coercion variable"

    pp_occ_with_type :: OccName -> Type -> SDoc
    pp_occ_with_type :: OccName -> Type -> SDoc
    pp_occ_with_type OccName
    occ Type
    hole_ty = SDoc -> Int -> SDoc -> SDoc
    hang (OccName -> SDoc
    forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc OccName
    occ) Int
    2 (SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType Type
    hole_ty)

    {- *********************************************************************
    *                                                                      *
                      Outputting ScopeError messages
    *                                                                      *
    **********************************************************************-}

    pprScopeError :: RdrName -> NotInScopeError -> SDoc
    pprScopeError :: RdrName -> NotInScopeError -> SDoc
    pprScopeError RdrName
    rdr_name NotInScopeError
    scope_err =
      case NotInScopeError
    scope_err of
        NotInScope {} ->
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Not in scope:")
            Int
    2 (SDoc
    what SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name))
        NoExactName Name
    name ->
          String -> SDoc
    text String
    "The Name" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not in scope."
        SameName [GlobalRdrElt]
    gres ->
          Bool -> SDoc -> SDoc -> SDoc
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr ([GlobalRdrElt] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [GlobalRdrElt]
    gres Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2) (String -> SDoc
    text String
    "pprScopeError SameName: fewer than 2 elements" SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    2 ([GlobalRdrElt] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [GlobalRdrElt]
    gres))
          (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Same Name in multiple name-spaces:")
               Int
    2 ([SDoc] -> SDoc
    vcat ((Name -> SDoc) -> [Name] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> SDoc
    pp_one [Name]
    sorted_names))
          where
            sorted_names :: [Name]
    sorted_names = (Name -> Name -> Ordering) -> [Name] -> [Name]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (SrcSpan -> SrcSpan -> Ordering
    leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
    -> (Name -> SrcSpan) -> Name -> Name -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Name -> SrcSpan
    nameSrcSpan) ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map GlobalRdrElt -> Name
    greMangledName [GlobalRdrElt]
    gres)
            pp_one :: Name -> SDoc
    pp_one Name
    name
              = SDoc -> Int -> SDoc -> SDoc
    hang (NameSpace -> SDoc
    pprNameSpace (OccName -> NameSpace
    occNameSpace (Name -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName Name
    name))
                      SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name) SDoc -> SDoc -> SDoc
    <> SDoc
    comma)
                   Int
    2 (String -> SDoc
    text String
    "declared at:" SDoc -> SDoc -> SDoc
    <+> SrcLoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> SrcLoc
    nameSrcLoc Name
    name))
        MissingBinding SDoc
    thing [GhcHint]
    _ ->
          [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    thing
                   SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name)
              , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "lacks an accompanying binding" ]
        NotInScopeError
    NoTopLevelBinding ->
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "No top-level binding for")
            Int
    2 (SDoc
    what SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in this module")
        UnknownSubordinate SDoc
    doc ->
          SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not a (visible)" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc
      where
        what :: SDoc
    what = NameSpace -> SDoc
    pprNonVarNameSpace (OccName -> NameSpace
    occNameSpace (RdrName -> OccName
    rdrNameOcc RdrName
    rdr_name))

    scopeErrorHints :: NotInScopeError -> [GhcHint]
    scopeErrorHints :: NotInScopeError -> [GhcHint]
    scopeErrorHints NotInScopeError
    scope_err =
      case NotInScopeError
    scope_err of
        NotInScopeError
    NotInScope             -> [GhcHint]
    noHints
        NoExactName {}         -> [GhcHint
    SuggestDumpSlices]
        SameName {}            -> [GhcHint
    SuggestDumpSlices]
        MissingBinding SDoc
    _ [GhcHint]
    hints -> [GhcHint]
    hints
        NotInScopeError
    NoTopLevelBinding      -> [GhcHint]
    noHints
        UnknownSubordinate {}  -> [GhcHint]
    noHints

    {- *********************************************************************
    *                                                                      *
                      Outputting ImportError messages
    *                                                                      *
    **********************************************************************-}

    instance Outputable ImportError where
      ppr :: ImportError -> SDoc
    ppr (MissingModule ModuleName
    mod_name) =
        [SDoc] -> SDoc
    hsep
          [ String -> SDoc
    text String
    "NB: no module named"
          , SDoc -> SDoc
    quotes (ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModuleName
    mod_name)
          , String -> SDoc
    text String
    "is imported."
          ]
      ppr  (ModulesDoNotExport NonEmpty Module
    mods OccName
    occ_name)
        | Module
    mod NE.:| [] <- NonEmpty Module
    mods
        = [SDoc] -> SDoc
    hsep
            [ String -> SDoc
    text String
    "NB: the module"
            , SDoc -> SDoc
    quotes (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod)
            , String -> SDoc
    text String
    "does not export"
            , SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ_name) SDoc -> SDoc -> SDoc
    <> SDoc
    dot ]
        | Bool
    otherwise
        = [SDoc] -> SDoc
    hsep
            [ String -> SDoc
    text String
    "NB: neither"
            , [SDoc] -> SDoc
    quotedListWithNor ((Module -> SDoc) -> [Module] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([Module] -> [SDoc]) -> [Module] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty Module -> [Module]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty Module
    mods)
            , String -> SDoc
    text String
    "export"
            , SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ_name) SDoc -> SDoc -> SDoc
    <> SDoc
    dot ]

    {- *********************************************************************
    *                                                                      *
                 Suggested fixes for implication constraints
    *                                                                      *
    **********************************************************************-}

    -- TODO: these functions should use GhcHint instead.

    show_fixes :: [SDoc] -> SDoc
    show_fixes :: [SDoc] -> SDoc
    show_fixes []     = SDoc
    empty
    show_fixes (SDoc
    f:[SDoc]
    fs) = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Possible fix:"
                            , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat (SDoc
    f SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> SDoc
    text String
    "or" SDoc -> SDoc -> SDoc
    <+>) [SDoc]
    fs))]

    ctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc]
    ctxtFixes :: Bool -> Type -> [Implication] -> [SDoc]
    ctxtFixes Bool
    has_ambig_tvs Type
    pred [Implication]
    implics
      | Bool -> Bool
    not Bool
    has_ambig_tvs
      , Type -> Bool
    isTyVarClassPred Type
    pred
      , (SkolemInfoAnon
    skol:[SkolemInfoAnon]
    skols) <- [Implication] -> Type -> [SkolemInfoAnon]
    usefulContext [Implication]
    implics Type
    pred
      , let what :: SDoc
    what | [SkolemInfoAnon] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SkolemInfoAnon]
    skols
                 , SigSkol (PatSynCtxt {}) Type
    _ [(Name, TcTyVar)]
    _ <- SkolemInfoAnon
    skol
                 = String -> SDoc
    text String
    "\"required\""
                 | Bool
    otherwise
                 = SDoc
    empty
      = [[SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "add" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprParendType Type
    pred
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "to the" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "context of"
             , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SkolemInfoAnon -> SDoc
    ppr_skol SkolemInfoAnon
    skol SDoc -> SDoc -> SDoc
    $$
                        [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "or" SDoc -> SDoc -> SDoc
    <+> SkolemInfoAnon -> SDoc
    ppr_skol SkolemInfoAnon
    skol
                             | SkolemInfoAnon
    skol <- [SkolemInfoAnon]
    skols ] ] ]
      | Bool
    otherwise = []
      where
        ppr_skol :: SkolemInfoAnon -> SDoc
    ppr_skol (PatSkol (RealDataCon DataCon
    dc) HsMatchContext GhcTc
    _) = String -> SDoc
    text String
    "the data constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc)
        ppr_skol (PatSkol (PatSynCon PatSyn
    ps)   HsMatchContext GhcTc
    _) = String -> SDoc
    text String
    "the pattern synonym"  SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (PatSyn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatSyn
    ps)
        ppr_skol SkolemInfoAnon
    skol_info = SkolemInfoAnon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfoAnon
    skol_info

    usefulContext :: [Implication] -> PredType -> [SkolemInfoAnon]
    -- usefulContext picks out the implications whose context
    -- the programmer might plausibly augment to solve 'pred'
    usefulContext :: [Implication] -> Type -> [SkolemInfoAnon]
    usefulContext [Implication]
    implics Type
    pred
      = [Implication] -> [SkolemInfoAnon]
    go [Implication]
    implics
      where
        pred_tvs :: TyVarSet
    pred_tvs = Type -> TyVarSet
    tyCoVarsOfType Type
    pred
        go :: [Implication] -> [SkolemInfoAnon]
    go [] = []
        go (Implication
    ic : [Implication]
    ics)
           | Implication -> Bool
    implausible Implication
    ic = [SkolemInfoAnon]
    rest
           | Bool
    otherwise      = Implication -> SkolemInfoAnon
    ic_info Implication
    ic SkolemInfoAnon -> [SkolemInfoAnon] -> [SkolemInfoAnon]
    forall a. a -> [a] -> [a]
    : [SkolemInfoAnon]
    rest
           where
              -- Stop when the context binds a variable free in the predicate
              rest :: [SkolemInfoAnon]
    rest | (TcTyVar -> Bool) -> [TcTyVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (TcTyVar -> TyVarSet -> Bool
    `elemVarSet` TyVarSet
    pred_tvs) (Implication -> [TcTyVar]
    ic_skols Implication
    ic) = []
                   | Bool
    otherwise                                 = [Implication] -> [SkolemInfoAnon]
    go [Implication]
    ics

        implausible :: Implication -> Bool
    implausible Implication
    ic
          | [TcTyVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Implication -> [TcTyVar]
    ic_skols Implication
    ic)            = Bool
    True
          | SkolemInfoAnon -> Bool
    implausible_info (Implication -> SkolemInfoAnon
    ic_info Implication
    ic) = Bool
    True
          | Bool
    otherwise                     = Bool
    False

        implausible_info :: SkolemInfoAnon -> Bool
    implausible_info (SigSkol (InfSigCtxt {}) Type
    _ [(Name, TcTyVar)]
    _) = Bool
    True
        implausible_info SkolemInfoAnon
    _                             = Bool
    False
        -- Do not suggest adding constraints to an *inferred* type signature

    pp_givens :: [Implication] -> [SDoc]
    pp_givens :: [Implication] -> [SDoc]
    pp_givens [Implication]
    givens
       = case [Implication]
    givens of
             []     -> []
             (Implication
    g:[Implication]
    gs) ->      SDoc -> Implication -> SDoc
    ppr_given (String -> SDoc
    text String
    "from the context:") Implication
    g
                     SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (Implication -> SDoc) -> [Implication] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SDoc -> Implication -> SDoc
    ppr_given (String -> SDoc
    text String
    "or from:")) [Implication]
    gs
        where
           ppr_given :: SDoc -> Implication -> SDoc
    ppr_given SDoc
    herald implic :: Implication
    implic@(Implic { ic_given :: Implication -> [TcTyVar]
    ic_given = [TcTyVar]
    gs, ic_info :: Implication -> SkolemInfoAnon
    ic_info = SkolemInfoAnon
    skol_info })
               = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc
    herald SDoc -> SDoc -> SDoc
    <+> [TcTyVar] -> SDoc
    pprEvVarTheta ((TcTyVar -> Type) -> [TcTyVar] -> [TcTyVar]
    forall a. (a -> Type) -> [a] -> [a]
    mkMinimalBySCs TcTyVar -> Type
    evVarPred [TcTyVar]
    gs))
                 -- See Note [Suppress redundant givens during error reporting]
                 -- for why we use mkMinimalBySCs above.
                    Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "bound by" SDoc -> SDoc -> SDoc
    <+> SkolemInfoAnon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfoAnon
    skol_info
                           , String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+> RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    getLclEnvLoc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ])

    {- *********************************************************************
    *                                                                      *
                           CtOrigin information
    *                                                                      *
    **********************************************************************-}

    levelString :: TypeOrKind -> String
    levelString :: TypeOrKind -> String
    levelString TypeOrKind
    TypeLevel = String
    "type"
    levelString TypeOrKind
    KindLevel = String
    "kind"

    pprArising :: CtOrigin -> SDoc
    -- Used for the main, top-level error message
    -- We've done special processing for TypeEq, KindEq, givens
    pprArising :: CtOrigin -> SDoc
    pprArising (TypeEqOrigin {})         = SDoc
    empty
    pprArising (KindEqOrigin {})         = SDoc
    empty
    pprArising (AmbiguityCheckOrigin {}) = SDoc
    empty  -- the "In the ambiguity check" context
                                                  -- is sufficient; this would just be
                                                  -- repetitive
    pprArising CtOrigin
    orig | CtOrigin -> Bool
    isGivenOrigin CtOrigin
    orig = SDoc
    empty
                    | Bool
    otherwise          = CtOrigin -> SDoc
    pprCtOrigin CtOrigin
    orig

    -- Add the "arising from..." part to a message
    addArising :: CtOrigin -> SDoc -> SDoc
    addArising :: CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig SDoc
    msg = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    msg Int
    2 (CtOrigin -> SDoc
    pprArising CtOrigin
    orig)

    pprWithArising :: [Ct] -> SDoc
    -- Print something like
    --    (Eq a) arising from a use of x at y
    --    (Show a) arising from a use of p at q
    -- Also return a location for the error message
    -- Works for Wanted/Derived only
    pprWithArising :: [Ct] -> SDoc
    pprWithArising []
      = String -> SDoc
    forall a. String -> a
    panic String
    "pprWithArising"
    pprWithArising (Ct
    ct:[Ct]
    cts)
      | [Ct] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Ct]
    cts
      = CtOrigin -> SDoc -> SDoc
    addArising (CtLoc -> CtOrigin
    ctLocOrigin CtLoc
    loc) ([Type] -> SDoc
    pprTheta [Ct -> Type
    ctPred Ct
    ct])
      | Bool
    otherwise
      = [SDoc] -> SDoc
    vcat ((Ct -> SDoc) -> [Ct] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Ct -> SDoc
    ppr_one (Ct
    ctCt -> [Ct] -> [Ct]
    forall a. a -> [a] -> [a]
    :[Ct]
    cts))
      where
        loc :: CtLoc
    loc = Ct -> CtLoc
    ctLoc Ct
    ct
        ppr_one :: Ct -> SDoc
    ppr_one Ct
    ct' = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    parens (Type -> SDoc
    pprType (Ct -> Type
    ctPred Ct
    ct')))
                         Int
    2 (CtLoc -> SDoc
    pprCtLoc (Ct -> CtLoc
    ctLoc Ct
    ct'))

    {- *********************************************************************
    *                                                                      *
                               SkolemInfo
    *                                                                      *
    **********************************************************************-}

    tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
    tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
    tidySkolemInfo TidyEnv
    env (SkolemInfo Unique
    u SkolemInfoAnon
    sk_anon) = Unique -> SkolemInfoAnon -> SkolemInfo
    SkolemInfo Unique
    u (TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
    tidySkolemInfoAnon TidyEnv
    env SkolemInfoAnon
    sk_anon)

    ----------------
    tidySkolemInfoAnon :: TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
    tidySkolemInfoAnon :: TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
    tidySkolemInfoAnon TidyEnv
    env (DerivSkol Type
    ty)         = Type -> SkolemInfoAnon
    DerivSkol (TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    ty)
    tidySkolemInfoAnon TidyEnv
    env (SigSkol UserTypeCtxt
    cx Type
    ty [(Name, TcTyVar)]
    tv_prs) = TidyEnv
    -> UserTypeCtxt -> Type -> [(Name, TcTyVar)] -> SkolemInfoAnon
    tidySigSkol TidyEnv
    env UserTypeCtxt
    cx Type
    ty [(Name, TcTyVar)]
    tv_prs
    tidySkolemInfoAnon TidyEnv
    env (InferSkol [(Name, Type)]
    ids)        = [(Name, Type)] -> SkolemInfoAnon
    InferSkol ((Type -> Type) -> [(Name, Type)] -> [(Name, Type)]
    forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
    mapSnd (TidyEnv -> Type -> Type
    tidyType TidyEnv
    env) [(Name, Type)]
    ids)
    tidySkolemInfoAnon TidyEnv
    env (UnifyForAllSkol Type
    ty)   = Type -> SkolemInfoAnon
    UnifyForAllSkol (TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    ty)
    tidySkolemInfoAnon TidyEnv
    _   SkolemInfoAnon
    info                   = SkolemInfoAnon
    info

    tidySigSkol :: TidyEnv -> UserTypeCtxt
                -> TcType -> [(Name,TcTyVar)] -> SkolemInfoAnon
    -- We need to take special care when tidying SigSkol
    -- See Note [SigSkol SkolemInfo] in "GHC.Tc.Types.Origin"
    tidySigSkol :: TidyEnv
    -> UserTypeCtxt -> Type -> [(Name, TcTyVar)] -> SkolemInfoAnon
    tidySigSkol TidyEnv
    env UserTypeCtxt
    cx Type
    ty [(Name, TcTyVar)]
    tv_prs
      = UserTypeCtxt -> Type -> [(Name, TcTyVar)] -> SkolemInfoAnon
    SigSkol UserTypeCtxt
    cx (TidyEnv -> Type -> Type
    tidy_ty TidyEnv
    env Type
    ty) [(Name, TcTyVar)]
    tv_prs'
      where
        tv_prs' :: [(Name, TcTyVar)]
    tv_prs' = (TcTyVar -> TcTyVar) -> [(Name, TcTyVar)] -> [(Name, TcTyVar)]
    forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
    mapSnd (TidyEnv -> TcTyVar -> TcTyVar
    tidyTyCoVarOcc TidyEnv
    env) [(Name, TcTyVar)]
    tv_prs
        inst_env :: NameEnv TcTyVar
    inst_env = [(Name, TcTyVar)] -> NameEnv TcTyVar
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(Name, TcTyVar)]
    tv_prs'

        tidy_ty :: TidyEnv -> Type -> Type
    tidy_ty TidyEnv
    env (ForAllTy (Bndr TcTyVar
    tv ArgFlag
    vis) Type
    ty)
          = VarBndr TcTyVar ArgFlag -> Type -> Type
    ForAllTy (TcTyVar -> ArgFlag -> VarBndr TcTyVar ArgFlag
    forall var argf. var -> argf -> VarBndr var argf
    Bndr TcTyVar
    tv' ArgFlag
    vis) (TidyEnv -> Type -> Type
    tidy_ty TidyEnv
    env' Type
    ty)
          where
            (TidyEnv
    env', TcTyVar
    tv') = TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
    tidy_tv_bndr TidyEnv
    env TcTyVar
    tv

        tidy_ty TidyEnv
    env ty :: Type
    ty@(FunTy AnonArgFlag
    InvisArg Type
    w Type
    arg Type
    res) -- Look under  c => t
          = Type
    ty { ft_mult :: Type
    ft_mult = TidyEnv -> Type -> Type
    tidy_ty TidyEnv
    env Type
    w,
                 ft_arg :: Type
    ft_arg = TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    arg,
                 ft_res :: Type
    ft_res = TidyEnv -> Type -> Type
    tidy_ty TidyEnv
    env Type
    res }

        tidy_ty TidyEnv
    env Type
    ty = TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    ty

        tidy_tv_bndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
        tidy_tv_bndr :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
    tidy_tv_bndr env :: TidyEnv
    env@(TidyOccEnv
    occ_env, VarEnv TcTyVar
    subst) TcTyVar
    tv
          | Just TcTyVar
    tv' <- NameEnv TcTyVar -> Name -> Maybe TcTyVar
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv TcTyVar
    inst_env (TcTyVar -> Name
    tyVarName TcTyVar
    tv)
          = ((TidyOccEnv
    occ_env, VarEnv TcTyVar -> TcTyVar -> TcTyVar -> VarEnv TcTyVar
    forall a. VarEnv a -> TcTyVar -> a -> VarEnv a
    extendVarEnv VarEnv TcTyVar
    subst TcTyVar
    tv TcTyVar
    tv'), TcTyVar
    tv')

          | Bool
    otherwise
          = TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
    tidyVarBndr TidyEnv
    env TcTyVar
    tv

    pprSkols :: SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
    pprSkols :: SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
    pprSkols SolverReportErrCtxt
    ctxt [(SkolemInfoAnon, [TcTyVar])]
    zonked_ty_vars
      =
          let tidy_ty_vars :: [(SkolemInfoAnon, [TcTyVar])]
    tidy_ty_vars = ((SkolemInfoAnon, [TcTyVar]) -> (SkolemInfoAnon, [TcTyVar]))
    -> [(SkolemInfoAnon, [TcTyVar])] -> [(SkolemInfoAnon, [TcTyVar])]
    forall a b. (a -> b) -> [a] -> [b]
    map ((SkolemInfoAnon -> SkolemInfoAnon)
    -> ([TcTyVar] -> [TcTyVar])
    -> (SkolemInfoAnon, [TcTyVar])
    -> (SkolemInfoAnon, [TcTyVar])
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap (TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
    tidySkolemInfoAnon (SolverReportErrCtxt -> TidyEnv
    cec_tidy SolverReportErrCtxt
    ctxt)) [TcTyVar] -> [TcTyVar]
    forall a. a -> a
    id) [(SkolemInfoAnon, [TcTyVar])]
    zonked_ty_vars
          in [SDoc] -> SDoc
    vcat (((SkolemInfoAnon, [TcTyVar]) -> SDoc)
    -> [(SkolemInfoAnon, [TcTyVar])] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SkolemInfoAnon, [TcTyVar]) -> SDoc
    pp_one [(SkolemInfoAnon, [TcTyVar])]
    tidy_ty_vars)
      where

        no_msg :: SDoc
    no_msg = String -> SDoc
    text String
    "No skolem info - we could not find the origin of the following variables" SDoc -> SDoc -> SDoc
    <+> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [(SkolemInfoAnon, [TcTyVar])]
    zonked_ty_vars
           SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "This should not happen, please report it as a bug following the instructions at:"
           SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug"

        pp_one :: (SkolemInfoAnon, [TcTyVar]) -> SDoc
    pp_one (UnkSkol CallStack
    cs, [TcTyVar]
    tvs)
          = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang ([TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    tvs)
                     Int
    2 ([TcTyVar] -> String -> String -> SDoc
    forall {a}. [a] -> String -> String -> SDoc
    is_or_are [TcTyVar]
    tvs String
    "a" String
    "(rigid, skolem)")
                 , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "of unknown origin")
                 , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "bound at" SDoc -> SDoc -> SDoc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([TcTyVar] -> SrcSpan
    skolsSpan [TcTyVar]
    tvs))
                 , SDoc
    no_msg
                 , CallStack -> SDoc
    prettyCallStackDoc CallStack
    cs
                 ]
        pp_one (SkolemInfoAnon
    RuntimeUnkSkol, [TcTyVar]
    tvs)
          = SDoc -> Int -> SDoc -> SDoc
    hang ([TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    tvs)
               Int
    2 ([TcTyVar] -> String -> String -> SDoc
    forall {a}. [a] -> String -> String -> SDoc
    is_or_are [TcTyVar]
    tvs String
    "an" String
    "unknown runtime")
        pp_one (SkolemInfoAnon
    skol_info, [TcTyVar]
    tvs)
          = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang ([TcTyVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcTyVar]
    tvs)
                      Int
    2 ([TcTyVar] -> String -> String -> SDoc
    forall {a}. [a] -> String -> String -> SDoc
    is_or_are [TcTyVar]
    tvs String
    "a"  String
    "rigid" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "bound by")
                 , Int -> SDoc -> SDoc
    nest Int
    2 (SkolemInfoAnon -> SDoc
    pprSkolInfo SkolemInfoAnon
    skol_info)
                 , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([TcTyVar] -> SrcSpan
    skolsSpan [TcTyVar]
    tvs)) ]

        is_or_are :: [a] -> String -> String -> SDoc
    is_or_are [a
    _] String
    article String
    adjective = String -> SDoc
    text String
    "is" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    article SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    adjective
                                          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "type variable"
        is_or_are [a]
    _   String
    _       String
    adjective = String -> SDoc
    text String
    "are" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    adjective
                                          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "type variables"

    skolsSpan :: [TcTyVar] -> SrcSpan
    skolsSpan :: [TcTyVar] -> SrcSpan
    skolsSpan [TcTyVar]
    skol_tvs = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 SrcSpan -> SrcSpan -> SrcSpan
    combineSrcSpans ((TcTyVar -> SrcSpan) -> [TcTyVar] -> [SrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map TcTyVar -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan [TcTyVar]
    skol_tvs)

    {- *********************************************************************
    *                                                                      *
                    Utilities for expected/actual messages
    *                                                                      *
    **********************************************************************-}

    mk_supplementary_ea_msg :: SolverReportErrCtxt -> TypeOrKind
                            -> Type -> Type -> CtOrigin -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_supplementary_ea_msg :: SolverReportErrCtxt
    -> TypeOrKind
    -> Type
    -> Type
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_supplementary_ea_msg SolverReportErrCtxt
    ctxt TypeOrKind
    level Type
    ty1 Type
    ty2 CtOrigin
    orig
      | TypeEqOrigin { uo_expected :: CtOrigin -> Type
    uo_expected = Type
    exp, uo_actual :: CtOrigin -> Type
    uo_actual = Type
    act } <- CtOrigin
    orig
      , Bool -> Bool
    not (Type -> Type -> Type -> Type -> Bool
    ea_looks_same Type
    ty1 Type
    ty2 Type
    exp Type
    act)
      = SolverReportErrCtxt
    -> Maybe ErrorItem
    -> TypeOrKind
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_ea_msg SolverReportErrCtxt
    ctxt Maybe ErrorItem
    forall a. Maybe a
    Nothing TypeOrKind
    level CtOrigin
    orig
      | Bool
    otherwise
      = [TcSolverReportInfo]
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. a -> Either a b
    Left []

    ea_looks_same :: Type -> Type -> Type -> Type -> Bool
    -- True if the faulting types (ty1, ty2) look the same as
    -- the expected/actual types (exp, act).
    -- If so, we don't want to redundantly report the latter
    ea_looks_same :: Type -> Type -> Type -> Type -> Bool
    ea_looks_same Type
    ty1 Type
    ty2 Type
    exp Type
    act
      = (Type
    act Type -> Type -> Bool
    `looks_same` Type
    ty1 Bool -> Bool -> Bool
    && Type
    exp Type -> Type -> Bool
    `looks_same` Type
    ty2) Bool -> Bool -> Bool
    ||
        (Type
    exp Type -> Type -> Bool
    `looks_same` Type
    ty1 Bool -> Bool -> Bool
    && Type
    act Type -> Type -> Bool
    `looks_same` Type
    ty2)
      where
        looks_same :: Type -> Type -> Bool
    looks_same Type
    t1 Type
    t2 = Type
    t1 Type -> Type -> Bool
    `pickyEqType` Type
    t2
                        Bool -> Bool -> Bool
    || Type
    t1 Type -> Type -> Bool
    `eqType` Type
    liftedTypeKind Bool -> Bool -> Bool
    && Type
    t2 Type -> Type -> Bool
    `eqType` Type
    liftedTypeKind
          -- pickyEqType is sensitive to synonyms, so only replies True
          -- when the types really look the same.  However,
          -- (TYPE 'LiftedRep) and Type both print the same way.

    mk_ea_msg :: SolverReportErrCtxt -> Maybe ErrorItem -> TypeOrKind
              -> CtOrigin -> Either [TcSolverReportInfo] TcSolverReportMsg
    -- Constructs a "Couldn't match" message
    -- The (Maybe ErrorItem) says whether this is the main top-level message (Just)
    --     or a supplementary message (Nothing)
    mk_ea_msg :: SolverReportErrCtxt
    -> Maybe ErrorItem
    -> TypeOrKind
    -> CtOrigin
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    mk_ea_msg SolverReportErrCtxt
    ctxt Maybe ErrorItem
    at_top TypeOrKind
    level
      (TypeEqOrigin { uo_actual :: CtOrigin -> Type
    uo_actual = Type
    act, uo_expected :: CtOrigin -> Type
    uo_expected = Type
    exp, uo_thing :: CtOrigin -> Maybe TypedThing
    uo_thing = Maybe TypedThing
    mb_thing })
      | Just TypedThing
    thing <- Maybe TypedThing
    mb_thing
      , TypeOrKind
    KindLevel <- TypeOrKind
    level
      = TcSolverReportMsg -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. b -> Either a b
    Right (TcSolverReportMsg
     -> Either [TcSolverReportInfo] TcSolverReportMsg)
    -> TcSolverReportMsg
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. (a -> b) -> a -> b
    $ KindMismatch { kmismatch_what :: TypedThing
    kmismatch_what     = TypedThing
    thing
                             , kmismatch_expected :: Type
    kmismatch_expected = Type
    exp
                             , kmismatch_actual :: Type
    kmismatch_actual   = Type
    act }
      | Just ErrorItem
    item <- Maybe ErrorItem
    at_top
      , let mismatch :: TcSolverReportMsg
    mismatch =
              Mismatch
                { mismatch_ea :: Bool
    mismatch_ea   = Bool
    True
                , mismatch_item :: ErrorItem
    mismatch_item = ErrorItem
    item
                , mismatch_ty1 :: Type
    mismatch_ty1  = Type
    exp
                , mismatch_ty2 :: Type
    mismatch_ty2  = Type
    act }
      = TcSolverReportMsg -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. b -> Either a b
    Right (TcSolverReportMsg
     -> Either [TcSolverReportInfo] TcSolverReportMsg)
    -> TcSolverReportMsg
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. (a -> b) -> a -> b
    $
        if Bool
    expanded_syns
        then TcSolverReportMsg -> [TcSolverReportInfo] -> TcSolverReportMsg
    mkTcReportWithInfo TcSolverReportMsg
    mismatch [TcSolverReportInfo
    ea_expanded]
        else TcSolverReportMsg
    mismatch
      | Bool
    otherwise
      = [TcSolverReportInfo]
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. a -> Either a b
    Left ([TcSolverReportInfo]
     -> Either [TcSolverReportInfo] TcSolverReportMsg)
    -> [TcSolverReportInfo]
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. (a -> b) -> a -> b
    $
        if Bool
    expanded_syns
        then [TcSolverReportInfo
    ea,TcSolverReportInfo
    ea_expanded]
        else [TcSolverReportInfo
    ea]

      where
        ea :: TcSolverReportInfo
    ea = ExpectedActual { ea_expected :: Type
    ea_expected = Type
    exp, ea_actual :: Type
    ea_actual = Type
    act }
        ea_expanded :: TcSolverReportInfo
    ea_expanded =
          ExpectedActualAfterTySynExpansion
            { ea_expanded_expected :: Type
    ea_expanded_expected = Type
    expTy1
            , ea_expanded_actual :: Type
    ea_expanded_actual   = Type
    expTy2 }

        expanded_syns :: Bool
    expanded_syns = SolverReportErrCtxt -> Bool
    cec_expand_syns SolverReportErrCtxt
    ctxt
                     Bool -> Bool -> Bool
    && Bool -> Bool
    not (Type
    expTy1 Type -> Type -> Bool
    `pickyEqType` Type
    exp Bool -> Bool -> Bool
    && Type
    expTy2 Type -> Type -> Bool
    `pickyEqType` Type
    act)
        (Type
    expTy1, Type
    expTy2) = Type -> Type -> (Type, Type)
    expandSynonymsToMatch Type
    exp Type
    act
    mk_ea_msg SolverReportErrCtxt
    _ Maybe ErrorItem
    _ TypeOrKind
    _ CtOrigin
    _ = [TcSolverReportInfo]
    -> Either [TcSolverReportInfo] TcSolverReportMsg
    forall a b. a -> Either a b
    Left []

    {- Note [Expanding type synonyms to make types similar]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    In type error messages, if -fprint-expanded-types is used, we want to expand
    type synonyms to make expected and found types as similar as possible, but we
    shouldn't expand types too much to make type messages even more verbose and
    harder to understand. The whole point here is to make the difference in expected
    and found types clearer.

    `expandSynonymsToMatch` does this, it takes two types, and expands type synonyms
    only as much as necessary. Given two types t1 and t2:

      * If they're already same, it just returns the types.

      * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are
        type constructors), it expands C1 and C2 if they're different type synonyms.
        Then it recursively does the same thing on expanded types. If C1 and C2 are
        same, then it applies the same procedure to arguments of C1 and arguments of
        C2 to make them as similar as possible.

        Most important thing here is to keep number of synonym expansions at
        minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3,
        Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and
        `T (T3, T3, Bool)`.

      * Otherwise types don't have same shapes and so the difference is clearly
        visible. It doesn't do any expansions and show these types.

    Note that we only expand top-layer type synonyms. Only when top-layer
    constructors are the same we start expanding inner type synonyms.

    Suppose top-layer type synonyms of t1 and t2 can expand N and M times,
    respectively. If their type-synonym-expanded forms will meet at some point (i.e.
    will have same shapes according to `sameShapes` function), it's possible to find
    where they meet in O(N+M) top-layer type synonym expansions and O(min(N,M))
    comparisons. We first collect all the top-layer expansions of t1 and t2 in two
    lists, then drop the prefix of the longer list so that they have same lengths.
    Then we search through both lists in parallel, and return the first pair of
    types that have same shapes. Inner types of these two types with same shapes
    are then expanded using the same algorithm.

    In case they don't meet, we return the last pair of types in the lists, which
    has top-layer type synonyms completely expanded. (in this case the inner types
    are not expanded at all, as the current form already shows the type error)
    -}

    -- | Expand type synonyms in given types only enough to make them as similar as
    -- possible. Returned types are the same in terms of used type synonyms.
    --
    -- To expand all synonyms, see 'Type.expandTypeSynonyms'.
    --
    -- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for
    -- some examples of how this should work.
    expandSynonymsToMatch :: Type -> Type -> (Type, Type)
    expandSynonymsToMatch :: Type -> Type -> (Type, Type)
    expandSynonymsToMatch Type
    ty1 Type
    ty2 = (Type
    ty1_ret, Type
    ty2_ret)
      where
        (Type
    ty1_ret, Type
    ty2_ret) = Type -> Type -> (Type, Type)
    go Type
    ty1 Type
    ty2

        -- Returns (type synonym expanded version of first type,
        --          type synonym expanded version of second type)
        go :: Type -> Type -> (Type, Type)
        go :: Type -> Type -> (Type, Type)
    go Type
    t1 Type
    t2
          | Type
    t1 Type -> Type -> Bool
    `pickyEqType` Type
    t2 =
            -- Types are same, nothing to do
            (Type
    t1, Type
    t2)

        go (TyConApp TyCon
    tc1 [Type]
    tys1) (TyConApp TyCon
    tc2 [Type]
    tys2)
          | TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
          , [Type]
    tys1 [Type] -> [Type] -> Bool
    forall a b. [a] -> [b] -> Bool
    `equalLength` [Type]
    tys2 =
            -- Type constructors are same. They may be synonyms, but we don't
            -- expand further. The lengths of tys1 and tys2 must be equal;
            -- for example, with type S a = a, we don't want
            -- to zip (S Monad Int) and (S Bool).
            let ([Type]
    tys1', [Type]
    tys2') =
                  [(Type, Type)] -> ([Type], [Type])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (String
    -> (Type -> Type -> (Type, Type))
    -> [Type]
    -> [Type]
    -> [(Type, Type)]
    forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "expandSynonymsToMatch" Type -> Type -> (Type, Type)
    go [Type]
    tys1 [Type]
    tys2)
             in (TyCon -> [Type] -> Type
    TyConApp TyCon
    tc1 [Type]
    tys1', TyCon -> [Type] -> Type
    TyConApp TyCon
    tc2 [Type]
    tys2')

        go (AppTy Type
    t1_1 Type
    t1_2) (AppTy Type
    t2_1 Type
    t2_2) =
          let (Type
    t1_1', Type
    t2_1') = Type -> Type -> (Type, Type)
    go Type
    t1_1 Type
    t2_1
              (Type
    t1_2', Type
    t2_2') = Type -> Type -> (Type, Type)
    go Type
    t1_2 Type
    t2_2
           in (Type -> Type -> Type
    mkAppTy Type
    t1_1' Type
    t1_2', Type -> Type -> Type
    mkAppTy Type
    t2_1' Type
    t2_2')

        go ty1 :: Type
    ty1@(FunTy AnonArgFlag
    _ Type
    w1 Type
    t1_1 Type
    t1_2) ty2 :: Type
    ty2@(FunTy AnonArgFlag
    _ Type
    w2 Type
    t2_1 Type
    t2_2) | Type
    w1 Type -> Type -> Bool
    `eqType` Type
    w2 =
          let (Type
    t1_1', Type
    t2_1') = Type -> Type -> (Type, Type)
    go Type
    t1_1 Type
    t2_1
              (Type
    t1_2', Type
    t2_2') = Type -> Type -> (Type, Type)
    go Type
    t1_2 Type
    t2_2
           in ( Type
    ty1 { ft_arg :: Type
    ft_arg = Type
    t1_1', ft_res :: Type
    ft_res = Type
    t1_2' }
              , Type
    ty2 { ft_arg :: Type
    ft_arg = Type
    t2_1', ft_res :: Type
    ft_res = Type
    t2_2' })

        go (ForAllTy VarBndr TcTyVar ArgFlag
    b1 Type
    t1) (ForAllTy VarBndr TcTyVar ArgFlag
    b2 Type
    t2) =
          -- NOTE: We may have a bug here, but we just can't reproduce it easily.
          -- See D1016 comments for details and our attempts at producing a test
          -- case. Short version: We probably need RnEnv2 to really get this right.
          let (Type
    t1', Type
    t2') = Type -> Type -> (Type, Type)
    go Type
    t1 Type
    t2
           in (VarBndr TcTyVar ArgFlag -> Type -> Type
    ForAllTy VarBndr TcTyVar ArgFlag
    b1 Type
    t1', VarBndr TcTyVar ArgFlag -> Type -> Type
    ForAllTy VarBndr TcTyVar ArgFlag
    b2 Type
    t2')

        go (CastTy Type
    ty1 KindCoercion
    _) Type
    ty2 = Type -> Type -> (Type, Type)
    go Type
    ty1 Type
    ty2
        go Type
    ty1 (CastTy Type
    ty2 KindCoercion
    _) = Type -> Type -> (Type, Type)
    go Type
    ty1 Type
    ty2

        go Type
    t1 Type
    t2 =
          -- See Note [Expanding type synonyms to make types similar] for how this
          -- works
          let
            t1_exp_tys :: [Type]
    t1_exp_tys = Type
    t1 Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : Type -> [Type]
    tyExpansions Type
    t1
            t2_exp_tys :: [Type]
    t2_exp_tys = Type
    t2 Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : Type -> [Type]
    tyExpansions Type
    t2
            t1_exps :: Int
    t1_exps    = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    t1_exp_tys
            t2_exps :: Int
    t2_exps    = [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    t2_exp_tys
            dif :: Int
    dif        = Int -> Int
    forall a. Num a => a -> a
    abs (Int
    t1_exps Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    t2_exps)
          in
            [(Type, Type)] -> (Type, Type)
    followExpansions ([(Type, Type)] -> (Type, Type)) -> [(Type, Type)] -> (Type, Type)
    forall a b. (a -> b) -> a -> b
    $
              String -> [Type] -> [Type] -> [(Type, Type)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "expandSynonymsToMatch.go"
                (if Int
    t1_exps Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    t2_exps then Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    drop Int
    dif [Type]
    t1_exp_tys else [Type]
    t1_exp_tys)
                (if Int
    t2_exps Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    t1_exps then Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    drop Int
    dif [Type]
    t2_exp_tys else [Type]
    t2_exp_tys)

        -- Expand the top layer type synonyms repeatedly, collect expansions in a
        -- list. The list does not include the original type.
        --
        -- Example, if you have:
        --
        --   type T10 = T9
        --   type T9  = T8
        --   ...
        --   type T0  = Int
        --
        -- `tyExpansions T10` returns [T9, T8, T7, ... Int]
        --
        -- This only expands the top layer, so if you have:
        --
        --   type M a = Maybe a
        --
        -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded)
        tyExpansions :: Type -> [Type]
        tyExpansions :: Type -> [Type]
    tyExpansions = (Type -> Maybe (Type, Type)) -> Type -> [Type]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr (\Type
    t -> (\Type
    x -> (Type
    x, Type
    x)) (Type -> (Type, Type)) -> Maybe Type -> Maybe (Type, Type)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Type -> Maybe Type
    tcView Type
    t)

        -- Drop the type pairs until types in a pair look alike (i.e. the outer
        -- constructors are the same).
        followExpansions :: [(Type, Type)] -> (Type, Type)
        followExpansions :: [(Type, Type)] -> (Type, Type)
    followExpansions [] = String -> SDoc -> (Type, Type)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "followExpansions" SDoc
    empty
        followExpansions [(Type
    t1, Type
    t2)]
          | Type -> Type -> Bool
    sameShapes Type
    t1 Type
    t2 = Type -> Type -> (Type, Type)
    go Type
    t1 Type
    t2 -- expand subtrees
          | Bool
    otherwise        = (Type
    t1, Type
    t2) -- the difference is already visible
        followExpansions ((Type
    t1, Type
    t2) : [(Type, Type)]
    tss)
          -- Traverse subtrees when the outer shapes are the same
          | Type -> Type -> Bool
    sameShapes Type
    t1 Type
    t2 = Type -> Type -> (Type, Type)
    go Type
    t1 Type
    t2
          -- Otherwise follow the expansions until they look alike
          | Bool
    otherwise = [(Type, Type)] -> (Type, Type)
    followExpansions [(Type, Type)]
    tss

        sameShapes :: Type -> Type -> Bool
        sameShapes :: Type -> Type -> Bool
    sameShapes AppTy{}          AppTy{}          = Bool
    True
        sameShapes (TyConApp TyCon
    tc1 [Type]
    _) (TyConApp TyCon
    tc2 [Type]
    _) = TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
        sameShapes (FunTy {})       (FunTy {})       = Bool
    True
        sameShapes (ForAllTy {})    (ForAllTy {})    = Bool
    True
        sameShapes (CastTy Type
    ty1 KindCoercion
    _)   Type
    ty2              = Type -> Type -> Bool
    sameShapes Type
    ty1 Type
    ty2
        sameShapes Type
    ty1              (CastTy Type
    ty2 KindCoercion
    _)   = Type -> Type -> Bool
    sameShapes Type
    ty1 Type
    ty2
        sameShapes Type
    _                Type
    _                = Bool
    False

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Contexts for renaming errors}
    *                                                                      *
    ************************************************************************
    -}

    withHsDocContext :: HsDocContext -> SDoc -> SDoc
    withHsDocContext :: HsDocContext -> SDoc -> SDoc
    withHsDocContext HsDocContext
    ctxt SDoc
    doc = SDoc
    doc SDoc -> SDoc -> SDoc
    $$ HsDocContext -> SDoc
    inHsDocContext HsDocContext
    ctxt

    inHsDocContext :: HsDocContext -> SDoc
    inHsDocContext :: HsDocContext -> SDoc
    inHsDocContext HsDocContext
    ctxt = String -> SDoc
    text String
    "In" SDoc -> SDoc -> SDoc
    <+> HsDocContext -> SDoc
    pprHsDocContext HsDocContext
    ctxt

    pprHsDocContext :: HsDocContext -> SDoc
    pprHsDocContext :: HsDocContext -> SDoc
    pprHsDocContext (GenericCtx SDoc
    doc)      = SDoc
    doc
    pprHsDocContext (TypeSigCtx SDoc
    doc)      = String -> SDoc
    text String
    "the type signature for" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc
    pprHsDocContext (StandaloneKindSigCtx SDoc
    doc) = String -> SDoc
    text String
    "the standalone kind signature for" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc
    pprHsDocContext HsDocContext
    PatCtx                = String -> SDoc
    text String
    "a pattern type-signature"
    pprHsDocContext HsDocContext
    SpecInstSigCtx        = String -> SDoc
    text String
    "a SPECIALISE instance pragma"
    pprHsDocContext HsDocContext
    DefaultDeclCtx        = String -> SDoc
    text String
    "a `default' declaration"
    pprHsDocContext HsDocContext
    DerivDeclCtx          = String -> SDoc
    text String
    "a deriving declaration"
    pprHsDocContext (RuleCtx FieldLabelString
    name)        = String -> SDoc
    text String
    "the rewrite rule" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    doubleQuotes (FieldLabelString -> SDoc
    ftext FieldLabelString
    name)
    pprHsDocContext (TyDataCtx LocatedN RdrName
    tycon)     = String -> SDoc
    text String
    "the data type declaration for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    tycon)
    pprHsDocContext (FamPatCtx LocatedN RdrName
    tycon)     = String -> SDoc
    text String
    "a type pattern of family instance for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    tycon)
    pprHsDocContext (TySynCtx LocatedN RdrName
    name)       = String -> SDoc
    text String
    "the declaration for type synonym" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    name)
    pprHsDocContext (TyFamilyCtx LocatedN RdrName
    name)    = String -> SDoc
    text String
    "the declaration for type family" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    name)
    pprHsDocContext (ClassDeclCtx LocatedN RdrName
    name)   = String -> SDoc
    text String
    "the declaration for class" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    name)
    pprHsDocContext HsDocContext
    ExprWithTySigCtx      = String -> SDoc
    text String
    "an expression type signature"
    pprHsDocContext HsDocContext
    TypBrCtx              = String -> SDoc
    text String
    "a Template-Haskell quoted type"
    pprHsDocContext HsDocContext
    HsTypeCtx             = String -> SDoc
    text String
    "a type argument"
    pprHsDocContext HsDocContext
    HsTypePatCtx          = String -> SDoc
    text String
    "a type argument in a pattern"
    pprHsDocContext HsDocContext
    GHCiCtx               = String -> SDoc
    text String
    "GHCi input"
    pprHsDocContext (SpliceTypeCtx LHsType GhcPs
    hs_ty) = String -> SDoc
    text String
    "the spliced type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsType GhcPs
    GenLocated SrcSpanAnnA (HsType GhcPs)
    hs_ty)
    pprHsDocContext HsDocContext
    ClassInstanceCtx      = String -> SDoc
    text String
    "GHC.Tc.Gen.Splice.reifyInstances"

    pprHsDocContext (ForeignDeclCtx LocatedN RdrName
    name)
       = String -> SDoc
    text String
    "the foreign declaration for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN RdrName
    name)
    pprHsDocContext (ConDeclCtx [LocatedN Name
    name])
       = String -> SDoc
    text String
    "the definition of data constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LocatedN Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LocatedN Name
    name)
    pprHsDocContext (ConDeclCtx [LocatedN Name]
    names)
       = String -> SDoc
    text String
    "the definition of data constructors" SDoc -> SDoc -> SDoc
    <+> [LocatedN Name] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    interpp'SP [LocatedN Name]
    names