{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

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

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

import GHC.Prelude

import GHC.Builtin.Names
import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon )

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.Driver.Backend
import GHC.Hs

import GHC.Tc.Errors.Types
import GHC.Tc.Types.Constraint
import {-# SOURCE #-} GHC.Tc.Types( getLclEnvLoc, lclEnvInGeneratedCode )
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.Error.Codes ( constructorCode )
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.Unit.Module.Warnings  ( pprWarningTxtForMsg )

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 GHC.Data.BooleanFormula (pprBooleanFormulaNice)

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
import qualified Language.Haskell.TH as TH

data TcRnMessageOpts = TcRnMessageOpts { TcRnMessageOpts -> Bool
tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not
                                       }

defaultTcRnMessageOpts :: TcRnMessageOpts
defaultTcRnMessageOpts :: TcRnMessageOpts
defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: Bool
tcOptsShowContext = Bool
True }


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

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

         in SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
show_kinds forall a b. (a -> b) -> a -> b
$
              SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald
                Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser TyCon
fam_tc) (CoAxBranch
eqn1 forall a. a -> [a] -> [a]
: [CoAxBranch]
rest_eqns)))
    TcRnBangOnUnliftedType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Strictness flag has no effect on unlifted type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnLazyBangOnUnliftedType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Lazy flag has no effect on unlifted type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnMultipleDefaultDeclarations [LDefaultDecl GhcRn]
dup_things
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Multiple default declarations")
              Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map LDefaultDecl GhcRn -> SDoc
pp [LDefaultDecl GhcRn]
dup_things))
         where
           pp :: LDefaultDecl GhcRn -> SDoc
           pp :: LDefaultDecl GhcRn -> SDoc
pp (L SrcSpanAnnA
locn (DefaultDecl XCDefaultDecl GhcRn
_ [LHsType GhcRn]
_))
             = forall doc. IsLine doc => String -> doc
text String
"here was another default declaration" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
locn)
    TcRnBadDefaultType Type
ty [Class]
deflt_clss
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"The default type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not an instance of")
              Int
2 (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\SDoc
a SDoc
b -> SDoc
a forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"or" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
b) (forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotesforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> SDoc
ppr) [Class]
deflt_clss))
    TcRnMessage
TcRnPatSynBundledWithNonDataCon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms can be bundled only with datatypes."
    TcRnPatSynBundledWithWrongType Type
expected_res_ty Type
res_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms can only be bundled with matching type constructors"
               forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"Couldn't match expected type of"
               forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
expected_res_ty)
               forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"with actual type of"
               forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
res_ty)
    TcRnDupeModuleExport ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"Duplicate"
                , SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"Module" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
                , forall doc. IsLine doc => String -> doc
text String
"in export list" ]
    TcRnExportedModNotImported ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (forall doc. IsLine doc => String -> doc
text String
"module" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"is not imported"
    TcRnNullExportedModule ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (forall doc. IsLine doc => String -> doc
text String
"module" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"exports nothing"
    TcRnMissingExportList ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (forall doc. IsLine doc => String -> doc
text String
"module" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"is missing an export list"
    TcRnExportHiddenComponents IE GhcPs
export_item
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (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 forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => [doc] -> doc
hsep [ SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr GreName
child)
                , forall doc. IsLine doc => String -> doc
text String
"is exported by", SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie1)
                , forall doc. IsLine doc => String -> doc
text String
"and",            SDoc -> SDoc
quotes (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 forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"The type constructor" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
parent_name)
                 forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not the parent of the" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
what_is
                 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
thing forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'.'
                 forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text (String -> String
capitalise String
what_is)
                    forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"s can only be exported with their parent type constructor."
                 forall doc. IsDoc doc => doc -> doc -> doc
$$ (case [SDoc]
parents of
                       [] -> forall doc. IsOutput doc => doc
empty
                       [SDoc
_] -> forall doc. IsLine doc => String -> doc
text String
"Parent:"
                       [SDoc]
_  -> forall doc. IsLine doc => String -> doc
text String
"Parents:") forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => [doc] -> doc
fsep (forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
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 = forall a. Outputable a => a -> SDoc
ppr GreName
child
        parents :: [SDoc]
parents = forall a b. (a -> b) -> [a] -> [b]
map 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 forall a b. (a -> b) -> a -> b
$
           forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Conflicting exports for" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr OccName
occ) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
                , forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child1 GlobalRdrElt
gre1 IE GhcPs
ie1
                , 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 (forall a. Outputable a => a -> SDoc
ppr a
ie) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"exports" forall doc. IsLine doc => doc -> doc -> doc
<+>
                                                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 = forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl
                                   | Bool
otherwise         = forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> Name
flSelector FieldLabel
fl)
        ppr_name (NormalGreName Name
name) = forall a. Outputable a => a -> SDoc
ppr Name
name
    TcRnAmbiguousField HsExpr GhcRn
rupd TyCon
parent_type
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
          forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"The record update" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
rupd
                   forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"with type" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr TyCon
parent_type
                   forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is ambiguous."
               , forall doc. IsLine doc => String -> doc
text String
"This will not be supported by -XDuplicateRecordFields in future releases of GHC."
               ]
    TcRnMissingFields ConLike
con [(FieldLabelString, Type)]
fields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
header, Int -> SDoc -> SDoc
nest Int
2 SDoc
rest]
         where
           rest :: SDoc
rest | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = forall doc. IsOutput doc => doc
empty
                | Bool
otherwise   = forall doc. IsDoc doc => [doc] -> doc
vcat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)
           header :: SDoc
header = forall doc. IsLine doc => String -> doc
text String
"Fields of" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ConLike
con) forall doc. IsLine doc => doc -> doc -> doc
<+>
                    forall doc. IsLine doc => String -> doc
text String
"not initialised" forall doc. IsLine doc => doc -> doc -> doc
<>
                    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields then forall doc. IsOutput doc => doc
empty else forall doc. IsLine doc => doc
colon
    TcRnFieldUpdateInvalidType [(FieldLabelString, Type)]
prs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Record update for insufficiently polymorphic field"
                   forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [(FieldLabelString, Type)]
prs forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
              Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat [ forall a. Outputable a => a -> SDoc
ppr FieldLabelString
f forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
ty | (FieldLabelString
f,Type
ty) <- [(FieldLabelString, Type)]
prs ])
    TcRnNoConstructorHasAllFields [FieldLabelString]
conflictingFields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"No constructor has all these fields:")
              Int
2 (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 forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Cannot use a mixture of pattern synonym and record selectors" forall doc. IsDoc doc => doc -> doc -> doc
$$
           forall doc. IsLine doc => String -> doc
text String
"Record selectors defined by"
             forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
data_name)
             forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
             forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
data_sels forall doc. IsDoc doc => doc -> doc -> doc
$$
           forall doc. IsLine doc => String -> doc
text String
"Pattern synonym selectors defined by"
             forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
pat_name)
             forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
             forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
pat_syn_sels
    TcRnMissingStrictFields ConLike
con [(FieldLabelString, Type)]
fields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
header, Int -> SDoc -> SDoc
nest Int
2 SDoc
rest]
         where
           rest :: SDoc
rest | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = forall doc. IsOutput doc => doc
empty  -- Happens for non-record constructors
                                       -- with strict fields
                | Bool
otherwise   = forall doc. IsDoc doc => [doc] -> doc
vcat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)

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

    TcRnSpecialClassInst Class
cls Bool
because_safeHaskell
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => String -> doc
text String
"Class" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ Class -> Name
className Class
cls)
                   forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"does not support user-specified instances"
                   forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
safeHaskell_msg
          where
            safeHaskell_msg :: SDoc
safeHaskell_msg
              | Bool
because_safeHaskell
              = forall doc. IsLine doc => String -> doc
text String
" when Safe Haskell is enabled."
              | Bool
otherwise
              = forall doc. IsLine doc => doc
dot
    TcRnForallIdentifier RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => [doc] -> doc
fsep [ forall doc. IsLine doc => String -> doc
text String
"The use of" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
                                     forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"as an identifier",
                   forall doc. IsLine doc => String -> doc
text String
"will become an error in a future GHC release." ]
    TcRnMessage
TcRnTypeEqualityOutOfScope
      -> [SDoc] -> DecoratedSDoc
mkDecorated
           [ forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"~") forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"operator is out of scope." forall doc. IsDoc doc => doc -> doc -> doc
$$
             forall doc. IsLine doc => String -> doc
text String
"Assuming it to stand for an equality constraint."
           , forall doc. IsLine doc => String -> doc
text String
"NB:" forall doc. IsLine doc => doc -> doc -> doc
<+> (SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"~") forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"used to be built-in syntax but now is a regular type operator" forall doc. IsDoc doc => doc -> doc -> doc
$$
                             forall doc. IsLine doc => String -> doc
text String
"exported from Data.Type.Equality and Prelude.") forall doc. IsDoc doc => doc -> doc -> doc
$$
             forall doc. IsLine doc => String -> doc
text String
"If you are using a custom Prelude, consider re-exporting it."
           , forall doc. IsLine doc => String -> doc
text String
"This will become an error in a future GHC release." ]
    TcRnMessage
TcRnTypeEqualityRequiresOperators
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => [doc] -> doc
fsep [ forall doc. IsLine doc => String -> doc
text String
"The use of" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"~")
                                     forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"without TypeOperators",
                   forall doc. IsLine doc => String -> doc
text String
"will become an error in a future GHC release." ]
    TcRnIllegalTypeOperator SDoc
overall_ty RdrName
op
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Illegal operator" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
op) forall doc. IsLine doc => doc -> doc -> doc
<+>
           forall doc. IsLine doc => String -> doc
text String
"in type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr SDoc
overall_ty)
    TcRnIllegalTypeOperatorDecl RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Illegal declaration of a type or class operator" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
name)
    TcRnMessage
TcRnGADTMonoLocalBinds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => [doc] -> doc
fsep [ forall doc. IsLine doc => String -> doc
text String
"Pattern matching on GADTs without MonoLocalBinds"
                 , forall doc. IsLine doc => String -> doc
text String
"is fragile." ]
    TcRnIncorrectNameSpace Name
name Bool
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated 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
            = forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
            = forall doc. IsLine doc => String -> doc
text String
"Illegal term-level use of the" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
          ns :: NameSpace
ns = Name -> NameSpace
nameNameSpace Name
name
          what :: SDoc
what = NameSpace -> SDoc
pprNameSpace NameSpace
ns forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name)
    TcRnNotInScope NotInScopeError
err RdrName
name [ImportError]
imp_errs [GhcHint]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
name NotInScopeError
err forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs)
    TcRnUntickedPromotedThing UntickedPromotedThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsLine doc => String -> doc
text String
"Unticked promoted" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
           where
             what :: SDoc
             what :: SDoc
what = case UntickedPromotedThing
thing of
               UntickedPromotedThing
UntickedExplicitList -> forall doc. IsLine doc => String -> doc
text String
"list" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
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 forall doc. IsLine doc => String -> doc
text String
"constructor:" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
con forall doc. IsLine doc => doc -> doc -> doc
<> if Bool
bare_sym then forall doc. IsOutput doc => doc
empty else forall doc. IsLine doc => doc
dot
    TcRnIllegalBuiltinSyntax SDoc
what RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => String -> doc
text String
"Illegal", SDoc
what, forall doc. IsLine doc => String -> doc
text String
"of built-in syntax:", forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name]
    TcRnWarnDefaulting [Ct]
tidy_wanteds Maybe TcTyVar
tidy_tv Type
default_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => [doc] -> doc
hsep forall a b. (a -> b) -> a -> b
$ [ forall doc. IsLine doc => String -> doc
text String
"Defaulting" ]
                     forall a. [a] -> [a] -> [a]
++
                     (case Maybe TcTyVar
tidy_tv of
                         Maybe TcTyVar
Nothing -> []
                         Just TcTyVar
tv -> [forall doc. IsLine doc => String -> doc
text String
"the type variable"
                                    , SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)])
                     forall a. [a] -> [a] -> [a]
++
                     [ forall doc. IsLine doc => String -> doc
text String
"to type"
                     , SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
default_ty)
                     , forall doc. IsLine doc => String -> doc
text String
"in the following constraint" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [Ct]
tidy_wanteds ])
             Int
2
             ([Ct] -> SDoc
pprWithArising [Ct]
tidy_wanteds)


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

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

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

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

    TcRnIllegalForeignDeclBackend Either (ForeignExport GhcRn) (ForeignImport GhcRn)
_decl Backend
_backend ExpectedBackends
expectedBknds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsLine doc => [doc] -> doc
fsep (forall doc. IsLine doc => String -> doc
text String
"Illegal foreign declaration: requires one of these back ends:" forall a. a -> [a] -> [a]
:
               SDoc -> [SDoc] -> [SDoc]
commafyWith (forall doc. IsLine doc => String -> doc
text String
"or") (forall a b. (a -> b) -> [a] -> [b]
map (forall doc. IsLine doc => String -> doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backend -> String
backendDescription) ExpectedBackends
expectedBknds))

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

    TcRnIllegalForeignType Maybe ArgOrResult
mArgOrResult IllegalForeignTypeReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated 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 -> forall doc. IsOutput doc => doc
empty
          Just ArgOrResult
Arg -> forall doc. IsLine doc => String -> doc
text String
"argument"
          Just ArgOrResult
Result -> forall doc. IsLine doc => String -> doc
text String
"result"
        msg :: SDoc
msg = forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"Unacceptable", SDoc
arg_or_res
                   , forall doc. IsLine doc => String -> doc
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 (forall a. Outputable a => a -> SDoc
ppr Type
ty) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"cannot be marshalled in a foreign call"
               in case TypeCannotBeMarshaledReason
why of
                TypeCannotBeMarshaledReason
NotADataType ->
                  SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not a data type"
                NewtypeDataConNotInScope Maybe TyCon
Nothing ->
                  SDoc -> Int -> SDoc -> SDoc
hang SDoc
innerMsg Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"because its data constructor is not in scope"
                NewtypeDataConNotInScope (Just TyCon
tc) ->
                  SDoc -> Int -> SDoc -> SDoc
hang SDoc
innerMsg Int
2 forall a b. (a -> b) -> a -> b
$
                    forall doc. IsLine doc => String -> doc
text String
"because the data constructor for"
                    forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
tc) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not in scope"
                TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded ->
                  SDoc
innerMsg forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"UnliftedFFITypes is required to marshal unlifted types"
                TypeCannotBeMarshaledReason
NotABoxedMarshalableTyCon -> SDoc
innerMsg
                TypeCannotBeMarshaledReason
ForeignLabelNotAPtr ->
                  SDoc
innerMsg forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)"
                TypeCannotBeMarshaledReason
NotSimpleUnliftedType ->
                  SDoc
innerMsg forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"foreign import prim only accepts simple unlifted types"
                TypeCannotBeMarshaledReason
NotBoxedKindAny ->
                  forall doc. IsLine doc => String -> doc
text String
"Expected kind" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"Type") forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"or" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"UnliftedType") forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsDoc doc => doc -> doc -> doc
$$
                  forall doc. IsLine doc => String -> doc
text String
"but" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"has kind" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
typeKind Type
ty))
            ForeignDynNotPtr Type
expected Type
ty ->
              forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Expected: Ptr/FunPtr" forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
expected forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma, forall doc. IsLine doc => String -> doc
text String
"  Actual:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
ty ]
            IllegalForeignTypeReason
SafeHaskellMustBeInIO ->
              forall doc. IsLine doc => String -> doc
text String
"Safe Haskell is on, all FFI imports must be in the IO monad"
            IllegalForeignTypeReason
IOResultExpected ->
              forall doc. IsLine doc => String -> doc
text String
"IO result type expected"
            IllegalForeignTypeReason
UnexpectedNestedForall ->
              forall doc. IsLine doc => String -> doc
text String
"Unexpected nested forall"
            IllegalForeignTypeReason
LinearTypesNotAllowed ->
              forall doc. IsLine doc => String -> doc
text String
"Linear types are not supported in FFI declarations, see #18472"
            IllegalForeignTypeReason
OneArgExpected ->
              forall doc. IsLine doc => String -> doc
text String
"One argument expected"
            IllegalForeignTypeReason
AtLeastOneArgExpected ->
              forall doc. IsLine doc => String -> doc
text String
"At least one argument expected"
    TcRnInvalidCIdentifier CLabelString
target
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => [doc] -> doc
sep [SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr CLabelString
target) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not a valid C identifier"]
    TcRnExpectedValueId TcTyThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall a. Outputable a => a -> SDoc
ppr TcTyThing
thing forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"used where a value identifier was expected"
    TcRnNotARecordSelector Name
field
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => [doc] -> doc
hsep [SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
field), forall doc. IsLine doc => String -> doc
text String
"is not a record selector"]
    TcRnRecSelectorEscapedTyVar OccName
lbl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Cannot use record selector" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr OccName
lbl) forall doc. IsLine doc => doc -> doc -> doc
<+>
           forall doc. IsLine doc => String -> doc
text String
"as a function due to escaped type variables"
    TcRnPatSynNotBidirectional Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"non-bidirectional pattern synonym"
           forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"used in an expression"
    TcRnSplicePolymorphicLocalVar TcTyVar
ident
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Can't splice the polymorphic local variable" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TcTyVar
ident)
    TcRnIllegalDerivingItem LHsSigType GhcRn
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Illegal deriving item" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr LHsSigType GhcRn
hs_ty)
    TcRnUnexpectedAnnotation HsType GhcRn
ty HsSrcBang
bang
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           let err :: String
err = case HsSrcBang
bang of
                 HsSrcBang SourceText
_ SrcUnpackedness
SrcUnpack SrcStrictness
_           -> String
"UNPACK"
                 HsSrcBang SourceText
_ SrcUnpackedness
SrcNoUnpack SrcStrictness
_         -> String
"NOUNPACK"
                 HsSrcBang SourceText
_ SrcUnpackedness
NoSrcUnpack SrcStrictness
SrcLazy   -> String
"laziness"
                 HsSrcBang SourceText
_ SrcUnpackedness
_ SrcStrictness
_                   -> String
"strictness"
            in forall doc. IsLine doc => String -> doc
text String
"Unexpected" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
err forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"annotation:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty forall doc. IsDoc doc => doc -> doc -> doc
$$
               forall doc. IsLine doc => String -> doc
text String
err forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"annotation cannot appear nested inside a type"
    TcRnIllegalRecordSyntax HsType GhcRn
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Record syntax is illegal here:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty
    TcRnUnexpectedTypeSplice HsType GhcRn
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Unexpected type splice:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty
    TcRnInvalidVisibleKindArgument LHsType GhcRn
arg Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Cannot apply function of kind" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty)
             forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"to visible kind argument" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr LHsType GhcRn
arg)
    TcRnTooManyBinders Type
ki [LHsTyVarBndr () GhcRn]
bndrs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Not a function kind:")
              Int
4 (forall a. Outputable a => a -> SDoc
ppr Type
ki) forall doc. IsDoc doc => doc -> doc -> doc
$$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"but extra binders found:")
              Int
4 (forall doc. IsLine doc => [doc] -> doc
fsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr () GhcRn]
bndrs))
    TcRnDifferentNamesForTyVar Name
n1 Name
n2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Different names for the same type variable:") Int
2 SDoc
info
         where
           info :: SDoc
info | Name -> OccName
nameOccName Name
n1 forall a. Eq a => a -> a -> Bool
/= Name -> OccName
nameOccName Name
n2
                = SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
n1) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"and" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
n2)
                | Bool
otherwise -- Same OccNames! See C2 in
                            -- Note [Swizzling the tyvars before generaliseTcTyCon]
                = forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
n1) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"bound at" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
n1)
                       , SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
n2) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"bound at" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
n2) ]
    TcRnInvalidReturnKind DataSort
data_sort AllowedDataResKind
allowed_kind Type
kind Maybe SuggestUnliftedTypes
_suggested_ext
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => [doc] -> doc
sep [ DataSort -> SDoc
ppDataSort DataSort
data_sort forall doc. IsLine doc => doc -> doc -> doc
<+>
                 forall doc. IsLine doc => String -> doc
text String
"has non-" forall doc. IsLine doc => doc -> doc -> doc
<>
                 SDoc
allowed_kind_tycon
               , (if Bool
is_data_family then forall doc. IsLine doc => String -> doc
text String
"and non-variable" else forall doc. IsOutput doc => doc
empty) forall doc. IsLine doc => doc -> doc -> doc
<+>
                 forall doc. IsLine doc => String -> doc
text String
"return kind" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
kind)
               ]
         where
          is_data_family :: Bool
is_data_family =
            case DataSort
data_sort of
              DataDeclSort{}     -> Bool
False
              DataInstanceSort{} -> Bool
False
              DataSort
DataFamilySort     -> Bool
True
          allowed_kind_tycon :: SDoc
allowed_kind_tycon =
            case AllowedDataResKind
allowed_kind of
              AllowedDataResKind
AnyTYPEKind  -> forall a. Outputable a => a -> SDoc
ppr TyCon
tYPETyCon
              AllowedDataResKind
AnyBoxedKind -> forall a. Outputable a => a -> SDoc
ppr TyCon
boxedRepDataConTyCon
              AllowedDataResKind
LiftedKind   -> forall a. Outputable a => a -> SDoc
ppr Type
liftedTypeKind
    TcRnClassKindNotConstraint Type
_kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Kind signature on a class must end with" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
constraintKind forall doc. IsDoc doc => doc -> doc -> doc
$$
           forall doc. IsLine doc => String -> doc
text String
"unobscured by type families"
    TcRnUnpromotableThing Name
name PromotionErr
err
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           (SDoc -> Int -> SDoc -> SDoc
hang (PromotionErr -> SDoc
pprPECategory PromotionErr
err forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"cannot be used here")
                        Int
2 (forall doc. IsLine doc => doc -> doc
parens SDoc
reason))
        where
          reason :: SDoc
reason = case PromotionErr
err of
                     ConstrainedDataConPE Type
pred
                                    -> forall doc. IsLine doc => String -> doc
text String
"it has an unpromotable context"
                                       forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
pred)
                     PromotionErr
FamDataConPE   -> forall doc. IsLine doc => String -> doc
text String
"it comes from a data family instance"
                     PromotionErr
NoDataKindsDC  -> forall doc. IsLine doc => String -> doc
text String
"perhaps you intended to use DataKinds"
                     PromotionErr
PatSynPE       -> forall doc. IsLine doc => String -> doc
text String
"pattern synonyms cannot be promoted"
                     PromotionErr
RecDataConPE   -> SDoc
same_rec_group_msg
                     PromotionErr
ClassPE        -> SDoc
same_rec_group_msg
                     PromotionErr
TyConPE        -> SDoc
same_rec_group_msg
                     PromotionErr
TermVariablePE -> forall doc. IsLine doc => String -> doc
text String
"term variables cannot be promoted"
          same_rec_group_msg :: SDoc
same_rec_group_msg = forall doc. IsLine doc => String -> doc
text String
"it is defined and used in the same recursive group"
    TcRnMatchesHaveDiffNumArgs HsMatchContext GhcTc
argsContext (MatchArgMatches LocatedA (Match GhcRn body)
match1 NonEmpty (LocatedA (Match GhcRn body))
bad_matches)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           (forall doc. IsDoc doc => [doc] -> doc
vcat [ forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsMatchContext p -> SDoc
pprMatchContextNouns HsMatchContext GhcTc
argsContext forall doc. IsLine doc => doc -> doc -> doc
<+>
                   forall doc. IsLine doc => String -> doc
text String
"have different numbers of arguments"
                 , Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA (Match GhcRn body)
match1))
                 , Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (forall a. NonEmpty a -> a
NE.head NonEmpty (LocatedA (Match GhcRn body))
bad_matches)))])
    TcRnCannotBindScopedTyVarInPatSig NonEmpty (Name, TcTyVar)
sig_tvs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"You cannot bind scoped type variable"
                  forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name, TcTyVar)
sig_tvs)
                 forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
pprQuotedList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name, TcTyVar)
sig_tvs))
              Int
2 (forall doc. IsLine doc => String -> doc
text String
"in a pattern binding signature")
    TcRnCannotBindTyVarsInPatBind NonEmpty (Name, TcTyVar)
_offenders
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Binding type variables is not allowed in pattern bindings"
    TcRnTooManyTyArgsInConPattern ConLike
con_like Int
expected_number Int
actual_number
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsLine doc => String -> doc
text String
"Too many type arguments in constructor pattern for" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ConLike
con_like) forall doc. IsDoc doc => doc -> doc -> doc
$$
           forall doc. IsLine doc => String -> doc
text String
"Expected no more than" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
expected_number forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
semi forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"got" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
actual_number
    TcRnMultipleInlinePragmas TcTyVar
poly_id LocatedA InlinePragma
fst_inl_prag NonEmpty (LocatedA InlinePragma)
inl_prags
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Multiple INLINE pragmas for" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr TcTyVar
poly_id)
             Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall doc. IsLine doc => String -> doc
text String
"Ignoring all but the first"
                      forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}.
(Outputable a, Outputable a) =>
GenLocated a a -> SDoc
pp_inl (LocatedA InlinePragma
fst_inl_prag forall a. a -> [a] -> [a]
: forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LocatedA InlinePragma)
inl_prags)))
         where
           pp_inl :: GenLocated a a -> SDoc
pp_inl (L a
loc a
prag) = forall a. Outputable a => a -> SDoc
ppr a
prag forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr a
loc)
    TcRnUnexpectedPragmas TcTyVar
poly_id NonEmpty (LSig GhcRn)
bad_sigs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Discarding unexpected pragmas for" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr TcTyVar
poly_id)
              Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
getLoc) forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LSig GhcRn)
bad_sigs))
    TcRnNonOverloadedSpecialisePragma LIdP GhcRn
fun_name
       -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => String -> doc
text String
"SPECIALISE pragma for non-overloaded function"
              forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr LIdP GhcRn
fun_name)
    TcRnSpecialiseNotVisible Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsLine doc => String -> doc
text String
"You cannot SPECIALISE" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name)
           forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"because its definition is not visible in this module"
    TcRnNameByTemplateHaskellQuote RdrName
name -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
      forall doc. IsLine doc => String -> doc
text String
"Cannot redefine a Name retrieved by a Template Haskell quote:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr RdrName
name
    TcRnIllegalBindingOfBuiltIn OccName
name -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
       forall doc. IsLine doc => String -> doc
text String
"Illegal binding of built-in syntax:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr OccName
name
    TcRnPragmaWarning {OccName
pragma_warning_occ :: TcRnMessage -> OccName
pragma_warning_occ :: OccName
pragma_warning_occ, WarningTxt GhcRn
pragma_warning_msg :: TcRnMessage -> WarningTxt GhcRn
pragma_warning_msg :: WarningTxt GhcRn
pragma_warning_msg, ModuleName
pragma_warning_import_mod :: TcRnMessage -> ModuleName
pragma_warning_import_mod :: ModuleName
pragma_warning_import_mod, ModuleName
pragma_warning_defined_mod :: TcRnMessage -> ModuleName
pragma_warning_defined_mod :: ModuleName
pragma_warning_defined_mod}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"In the use of"
                forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
pragma_warning_occ)
                forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr OccName
pragma_warning_occ)
                , forall doc. IsLine doc => doc -> doc
parens SDoc
impMsg forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon ]
          , forall p. WarningTxt p -> SDoc
pprWarningTxtForMsg WarningTxt GhcRn
pragma_warning_msg ]
          where
            impMsg :: SDoc
impMsg  = forall doc. IsLine doc => String -> doc
text String
"imported from" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
pragma_warning_import_mod forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
extra
            extra :: SDoc
extra | ModuleName
pragma_warning_import_mod forall a. Eq a => a -> a -> Bool
== ModuleName
pragma_warning_defined_mod = forall doc. IsOutput doc => doc
empty
                  | Bool
otherwise = forall doc. IsLine doc => String -> doc
text String
", but defined in" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr ModuleName
pragma_warning_defined_mod
    TcRnIllegalHsigDefaultMethods Name
name NonEmpty (LHsBind GhcRn)
meths
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Illegal default method" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsBind GhcRn)
meths) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"in class definition of" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"in hsig file"
    TcRnBadGenericMethod Name
clas Name
op
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
clas),
          forall doc. IsLine doc => String -> doc
text String
"has a generic-default signature without a binding", SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
op)]
    TcRnWarningMinimalDefIncomplete ClassMinimalDef
mindef
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"The MINIMAL pragma does not require:"
          , Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef)
          , forall doc. IsLine doc => String -> doc
text String
"but there is no default implementation." ]
    TcRnDefaultMethodForPragmaLacksBinding TcTyVar
sel_id Sig GhcRn
prag
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig GhcRn
prag forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"for default method"
          forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TcTyVar
sel_id)
          forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"lacks an accompanying binding"
    TcRnIgnoreSpecialisePragmaOnDefMethod Name
sel_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Ignoring SPECIALISE pragmas on default method"
          forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
sel_name)
    TcRnBadMethodErr{Name
badMethodErrClassName :: TcRnMessage -> Name
badMethodErrClassName :: Name
badMethodErrClassName, Name
badMethodErrMethodName :: TcRnMessage -> Name
badMethodErrMethodName :: Name
badMethodErrMethodName}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
badMethodErrClassName),
          forall doc. IsLine doc => String -> doc
text String
"does not have a method", SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
badMethodErrMethodName)]
    TcRnNoExplicitAssocTypeOrDefaultDeclaration Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"No explicit" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"associated type"
          forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"or default declaration for"
          forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name)
    TcRnMessage
TcRnIllegalTypeData
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Illegal type-level data declaration"
    TcRnTypeDataForbids TypeDataForbids
feature
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall a. Outputable a => a -> SDoc
ppr TypeDataForbids
feature forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"are not allowed in type data declarations."

    TcRnIllegalNewtype DataCon
con Bool
show_linear_types IllegalNewtypeReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
msg, SDoc
additional]
        where
          (SDoc
msg,SDoc
additional) =
            case IllegalNewtypeReason
reason of
              DoesNotHaveSingleField Int
n_flds ->
                (forall doc. IsLine doc => [doc] -> doc
sep [
                  forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must have exactly one field",
                  Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$
                    forall doc. IsLine doc => String -> doc
text String
"but" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr DataCon
con) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"has" forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
speakN Int
n_flds
                ],
                forall a. Outputable a => a -> SDoc
ppr DataCon
con forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
IsNonLinear ->
                (forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must be linear",
                forall a. Outputable a => a -> SDoc
ppr DataCon
con forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
True DataCon
con))
              IllegalNewtypeReason
IsGADT ->
                (forall doc. IsLine doc => String -> doc
text String
"A newtype must not be a GADT",
                forall a. Outputable a => a -> SDoc
ppr DataCon
con forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
sneaky_eq_spec
                                       (forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasConstructorContext ->
                (forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have a context in its type",
                forall a. Outputable a => a -> SDoc
ppr DataCon
con forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasExistentialTyVar ->
                (forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have existential type variables",
                forall a. Outputable a => a -> SDoc
ppr DataCon
con forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasStrictnessAnnotation ->
                (forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have a strictness annotation", forall doc. IsOutput doc => doc
empty)

          -- Is the data con a "covert" GADT?  See Note [isCovertGadtDataCon]
          -- in GHC.Core.DataCon
          sneaky_eq_spec :: Bool
sneaky_eq_spec = DataCon -> Bool
isCovertGadtDataCon DataCon
con

    TcRnTypedTHWithPolyType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Illegal polytype:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
ty
             , forall doc. IsLine doc => String -> doc
text String
"The type of a Typed Template Haskell expression must" forall doc. IsLine doc => doc -> doc -> doc
<+>
               forall doc. IsLine doc => String -> doc
text String
"not have any quantification." ]
    TcRnSpliceThrewException SplicePhase
phase SomeException
_exn String
exn_msg LHsExpr GhcTc
expr Bool
show_code
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
           forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Exception when trying to" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
phaseStr forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"compile-time code:"
                , Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsLine doc => String -> doc
text String
exn_msg)
                , if Bool
show_code then forall doc. IsLine doc => String -> doc
text String
"Code:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcTc
expr else forall doc. IsOutput doc => doc
empty]
         where phaseStr :: String
phaseStr =
                 case SplicePhase
phase of
                   SplicePhase
SplicePhase_Run -> String
"run"
                   SplicePhase
SplicePhase_CompileAndLink -> String
"compile and link"
    TcRnInvalidTopDecl HsDecl GhcPs
_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsLine doc => String -> doc
text String
"Only function, value, annotation, and foreign import declarations may be added with addTopDecls"
    TcRnNonExactName RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"The binder" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
name) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not a NameU.")
            Int
2 (forall doc. IsLine doc => String -> doc
text String
"Probable cause: you used mkName instead of newName to generate a binding.")
    TcRnAddInvalidCorePlugin String
plugin
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         SDoc -> Int -> SDoc -> SDoc
hang
           (forall doc. IsLine doc => String -> doc
text String
"addCorePlugin: invalid plugin module "
              forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show String
plugin)
           )
           Int
2
           (forall doc. IsLine doc => String -> doc
text String
"Plugins in the current package can't be specified.")
    TcRnAddDocToNonLocalDefn DocLoc
doc_loc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsLine doc => String -> doc
text String
"Can't add documentation to" forall doc. IsLine doc => doc -> doc -> doc
<+> forall {doc}. IsLine doc => DocLoc -> doc
ppr_loc DocLoc
doc_loc forall doc. IsLine doc => doc -> doc -> doc
<+>
         forall doc. IsLine doc => String -> doc
text String
"as it isn't inside the current module"
      where
        ppr_loc :: DocLoc -> doc
ppr_loc (TH.DeclDoc Name
n) = forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$ forall a. Ppr a => a -> String
TH.pprint Name
n
        ppr_loc (TH.ArgDoc Name
n Int
_) = forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$ forall a. Ppr a => a -> String
TH.pprint Name
n
        ppr_loc (TH.InstDoc Type
t) = forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$ forall a. Ppr a => a -> String
TH.pprint Type
t
        ppr_loc DocLoc
TH.ModuleDoc = forall doc. IsLine doc => String -> doc
text String
"the module header"

    TcRnFailedToLookupThInstName Type
th_type LookupTHInstNameErrReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         case LookupTHInstNameErrReason
reason of
           LookupTHInstNameErrReason
NoMatchesFound ->
             forall doc. IsLine doc => String -> doc
text String
"Couldn't find any instances of"
               forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text (forall a. Ppr a => a -> String
TH.pprint Type
th_type)
               forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"to add documentation to"
           LookupTHInstNameErrReason
CouldNotDetermineInstance ->
             forall doc. IsLine doc => String -> doc
text String
"Couldn't work out what instance"
               forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text (forall a. Ppr a => a -> String
TH.pprint Type
th_type)
               forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is supposed to be"
    TcRnCannotReifyInstance Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"reifyInstances:" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty))
            Int
2 (forall doc. IsLine doc => String -> doc
text String
"is not a class constraint or type family application")
    TcRnCannotReifyOutOfScopeThing Name
th_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text (forall a. Ppr a => a -> String
TH.pprint Name
th_name)) forall doc. IsLine doc => doc -> doc -> doc
<+>
                 forall doc. IsLine doc => String -> doc
text String
"is not in scope at a reify"
               -- Ugh! Rather an indirect way to display the name
    TcRnCannotReifyThingNotInTypeEnv Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not in the type environment at a reify"
    TcRnNoRolesAssociatedWithThing TcTyThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsLine doc => String -> doc
text String
"No roles associated with" forall doc. IsLine doc => doc -> doc -> doc
<+> (forall a. Outputable a => a -> SDoc
ppr TcTyThing
thing)
    TcRnCannotRepresentType UnrepresentableTypeDescr
sort Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => String -> doc
text String
"Can't represent" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
sort_doc forall doc. IsLine doc => doc -> doc -> doc
<+>
               forall doc. IsLine doc => String -> doc
text String
"in Template Haskell:",
                 Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr Type
ty)]
       where
         sort_doc :: SDoc
sort_doc = forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$
           case UnrepresentableTypeDescr
sort of
             UnrepresentableTypeDescr
LinearInvisibleArgument -> String
"linear invisible argument"
             UnrepresentableTypeDescr
CoercionsInTypes -> String
"coercions in types"
    TcRnRunSpliceFailure Maybe String
mCallingFnName (ConversionFail ThingBeingConverted
what ConversionFailReason
reason)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDoc
addCallingFn
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDoc
addSpliceInfo
           forall a b. (a -> b) -> a -> b
$ ConversionFailReason -> SDoc
pprConversionFailReason ConversionFailReason
reason
      where
        addCallingFn :: SDoc -> SDoc
addCallingFn SDoc
rest =
          case Maybe String
mCallingFnName of
            Maybe String
Nothing -> SDoc
rest
            Just String
callingFn ->
              SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text (String
"Error in a declaration passed to " forall a. [a] -> [a] -> [a]
++ String
callingFn forall a. [a] -> [a] -> [a]
++ String
":"))
                 Int
2 SDoc
rest
        addSpliceInfo :: SDoc -> SDoc
addSpliceInfo = case ThingBeingConverted
what of
          ConvDec Dec
d -> forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"declaration" Dec
d
          ConvExp Exp
e -> forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"expression" Exp
e
          ConvPat Pat
p -> forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"pattern" Pat
p
          ConvType Type
t -> forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"type" Type
t
        addSliceInfo' :: String -> a -> SDoc -> SDoc
addSliceInfo' String
what a
item SDoc
reasonErr = SDoc
reasonErr forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
descr
          where
                -- Show the item in pretty syntax normally,
                -- but with all its constructors if you say -dppr-debug
            descr :: SDoc
descr = SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"When splicing a TH" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
what forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
                       Int
2 (forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug forall a b. (a -> b) -> a -> b
$ \case
                           Bool
True  -> forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show a
item)
                           Bool
False -> forall doc. IsLine doc => String -> doc
text (forall a. Ppr a => a -> String
TH.pprint a
item))
    TcRnReportCustomQuasiError Bool
_ String
msg -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
msg
    TcRnInterfaceLookupError Name
_ SDoc
sdoc -> SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
sdoc
    TcRnUnsatisfiedMinimalDef ClassMinimalDef
mindef
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsDoc doc => [doc] -> doc
vcat [forall doc. IsLine doc => String -> doc
text String
"No explicit implementation for"
              ,Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef
             ]
    TcRnMisplacedInstSig Name
name LHsSigType GhcRn
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Illegal type signature in instance declaration:")
                  Int
2 (SDoc -> Int -> SDoc -> SDoc
hang (forall a. NamedThing a => a -> SDoc
pprPrefixName Name
name)
                        Int
2 (SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr LHsSigType GhcRn
hs_ty))
             ]
    TcRnBadBootFamInstDecl {}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Illegal family instance in hs-boot file"
    TcRnIllegalFamilyInstance TyCon
tycon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Illegal family instance for" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
             , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr TyCon
tycon forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not an indexed type family")]
    TcRnMissingClassAssoc TyCon
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Associated type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
name) forall doc. IsLine doc => doc -> doc -> doc
<+>
        forall doc. IsLine doc => String -> doc
text String
"must be inside a class instance"
    TcRnBadFamInstDecl TyCon
tc_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Illegal family instance for" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
tc_name)
    TcRnNotOpenFamily TyCon
tc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Illegal instance for closed family" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
    TcRnMessage
TcRnNoRebindableSyntaxRecordDot -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
      forall doc. IsLine doc => String -> doc
text String
"RebindableSyntax is required if OverloadedRecordUpdate is enabled."
    TcRnMessage
TcRnNoFieldPunsRecordDot -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
      forall doc. IsLine doc => String -> doc
text String
"For this to work enable NamedFieldPuns"
    TcRnIllegalStaticExpression HsExpr GhcPs
e -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Illegal static expression:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
    TcRnIllegalStaticFormInSplice HsExpr GhcPs
e -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
      forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"static forms cannot be used in splices:"
          , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
          ]
    TcRnListComprehensionDuplicateBinding Name
n -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        (forall doc. IsLine doc => String -> doc
text String
"Duplicate binding in parallel list comprehension for:"
          forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
n))
    TcRnEmptyStmtsGroup EmptyStatementGroupErrReason
cause -> SDoc -> DecoratedSDoc
mkSimpleDecorated  forall a b. (a -> b) -> a -> b
$ case EmptyStatementGroupErrReason
cause of
      EmptyStatementGroupErrReason
EmptyStmtsGroupInParallelComp ->
        forall doc. IsLine doc => String -> doc
text String
"Empty statement group in parallel comprehension"
      EmptyStatementGroupErrReason
EmptyStmtsGroupInTransformListComp ->
        forall doc. IsLine doc => String -> doc
text String
"Empty statement group preceding 'group' or 'then'"
      EmptyStmtsGroupInDoNotation HsDoFlavour
ctxt ->
        forall doc. IsLine doc => String -> doc
text String
"Empty" forall doc. IsLine doc => doc -> doc -> doc
<+> HsDoFlavour -> SDoc
pprHsDoFlavour HsDoFlavour
ctxt
      EmptyStatementGroupErrReason
EmptyStmtsGroupInArrowNotation ->
        forall doc. IsLine doc => String -> doc
text String
"Empty 'do' block in an arrow command"
    TcRnLastStmtNotExpr HsStmtContext GhcRn
ctxt (UnexpectedStatement StmtLR GhcPs GhcPs body
stmt) ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang SDoc
last_error Int
2 (forall a. Outputable a => a -> SDoc
ppr StmtLR GhcPs GhcPs body
stmt)
      where
        last_error :: SDoc
last_error =
          forall doc. IsLine doc => String -> doc
text String
"The last statement in" forall doc. IsLine doc => doc -> doc -> doc
<+> forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsStmtContext p -> SDoc
pprAStmtContext HsStmtContext GhcRn
ctxt
          forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"must be an expression"
    TcRnUnexpectedStatementInContext HsStmtContext GhcRn
ctxt (UnexpectedStatement StmtLR GhcPs GhcPs body
stmt) Maybe Extension
_ -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
       forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"Unexpected" forall doc. IsLine doc => doc -> doc -> doc
<+> forall (p :: Pass) body. Stmt (GhcPass p) body -> SDoc
pprStmtCat StmtLR GhcPs GhcPs body
stmt forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"statement"
                       , forall doc. IsLine doc => String -> doc
text String
"in" forall doc. IsLine doc => doc -> doc -> doc
<+> forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsStmtContext p -> SDoc
pprAStmtContext HsStmtContext GhcRn
ctxt ]
    TcRnMessage
TcRnIllegalTupleSection -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
      forall doc. IsLine doc => String -> doc
text String
"Illegal tuple section"
    TcRnIllegalImplicitParameterBindings Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs)
eBinds -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Outputable a => a -> SDoc
msg forall a. Outputable a => a -> SDoc
msg Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs)
eBinds
      where
        msg :: a -> SDoc
msg a
binds = SDoc -> Int -> SDoc -> SDoc
hang
          (forall doc. IsLine doc => String -> doc
text String
"Implicit-parameter bindings illegal in an mdo expression")
          Int
2 (forall a. Outputable a => a -> SDoc
ppr a
binds)
    TcRnSectionWithoutParentheses HsExpr GhcPs
expr -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
      SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"A section must be enclosed in parentheses")
         Int
2 (forall doc. IsLine doc => String -> doc
text String
"thus:" forall doc. IsLine doc => doc -> doc -> doc
<+> (forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
expr)))

    TcRnLoopySuperclassSolve CtLoc
wtd_loc Type
wtd_pty ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
header, SDoc
warning, SDoc
user_manual ]
      where
        header, warning, user_manual :: SDoc
        header :: SDoc
header
          = forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"I am solving the constraint" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
wtd_pty) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
                 , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ CtOrigin -> SDoc
pprCtOrigin (CtLoc -> CtOrigin
ctLocOrigin CtLoc
wtd_loc) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
                 , forall doc. IsLine doc => String -> doc
text String
"in a way that might turn out to loop at runtime." ]
        warning :: SDoc
warning
          = forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Starting from GHC 9.10, this warning will turn into an error." ]
        user_manual :: SDoc
user_manual =
          forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"See the user manual, § Undecidable instances and loopy superclasses." ]
    TcRnCannotDefaultConcrete FixedRuntimeRepOrigin
frr
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated forall a b. (a -> b) -> a -> b
$
         forall a. Outputable a => a -> SDoc
ppr (FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context FixedRuntimeRepOrigin
frr) forall doc. IsDoc doc => doc -> doc -> doc
$$
         forall doc. IsLine doc => String -> doc
text String
"cannot be assigned a fixed runtime representation," forall doc. IsLine doc => doc -> doc -> doc
<+>
         forall doc. IsLine doc => String -> doc
text String
"not even by defaulting."

  diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
    TcRnUnknownMessage UnknownDiagnostic
m
      -> forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason UnknownDiagnostic
m
    TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
      -> case TcRnMessageDetailed
msg_with_info of
           TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason TcRnMessage
m
    TcRnWithHsDocContext HsDocContext
_ TcRnMessage
msg
      -> forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason TcRnMessage
msg
    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
    TcRnTagToEnumResTyTypeData{}
      -> 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 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
    TcRnLazyBangOnUnliftedType{}
      -> 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
    TcRnIllegalTypeOperatorDecl {}
      -> 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 GhcRn) (ForeignImport GhcRn)
_ UnsupportedCallConvention
unsupportedCC
      -> case UnsupportedCallConvention
unsupportedCC of
           UnsupportedCallConvention
StdCallConvUnsupported -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnsupportedCallingConventions
           UnsupportedCallConvention
_ -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalForeignType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidCIdentifier{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnExpectedValueId{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNotARecordSelector{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRecSelectorEscapedTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynNotBidirectional{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSplicePolymorphicLocalVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalDerivingItem{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedAnnotation{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalRecordSyntax{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedTypeSplice{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidVisibleKindArgument{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTooManyBinders{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDifferentNamesForTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidReturnKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnClassKindNotConstraint{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnpromotableThing{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMatchesHaveDiffNumArgs{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotBindScopedTyVarInPatSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotBindTyVarsInPatBind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTooManyTyArgsInConPattern{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMultipleInlinePragmas{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnUnexpectedPragmas{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnNonOverloadedSpecialisePragma{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnSpecialiseNotVisible{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnNameByTemplateHaskellQuote{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalBindingOfBuiltIn{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPragmaWarning{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnWarningsDeprecations
    TcRnIllegalHsigDefaultMethods{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadGenericMethod{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnWarningMinimalDefIncomplete{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnDefaultMethodForPragmaLacksBinding{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIgnoreSpecialisePragmaOnDefMethod{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnBadMethodErr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoExplicitAssocTypeOrDefaultDeclaration{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag
Opt_WarnMissingMethods)
    TcRnMessage
TcRnIllegalTypeData
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTypeDataForbids{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalNewtype{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTypedTHWithPolyType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSpliceThrewException{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidTopDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNonExactName{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAddInvalidCorePlugin{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAddDocToNonLocalDefn{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnFailedToLookupThInstName{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotReifyInstance{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotReifyOutOfScopeThing{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotReifyThingNotInTypeEnv{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoRolesAssociatedWithThing{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotRepresentType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRunSpliceFailure{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnReportCustomQuasiError Bool
isError String
_
      -> if Bool
isError then DiagnosticReason
ErrorWithoutFlag else DiagnosticReason
WarningWithoutFlag
    TcRnInterfaceLookupError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnsatisfiedMinimalDef{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag
Opt_WarnMissingMethods)
    TcRnMisplacedInstSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadBootFamInstDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalFamilyInstance{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMissingClassAssoc{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadFamInstDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNotOpenFamily{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoRebindableSyntaxRecordDot{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoFieldPunsRecordDot{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalStaticExpression{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalStaticFormInSplice{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnListComprehensionDuplicateBinding{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnEmptyStmtsGroup{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLastStmtNotExpr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedStatementInContext{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSectionWithoutParentheses{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalImplicitParameterBindings{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTupleSection{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLoopySuperclassSolve{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnLoopySuperclassSolve
    TcRnCannotDefaultConcrete{}
      -> DiagnosticReason
ErrorWithoutFlag

  diagnosticHints :: TcRnMessage -> [GhcHint]
diagnosticHints = \case
    TcRnUnknownMessage UnknownDiagnostic
m
      -> forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic
m
    TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
      -> case TcRnMessageDetailed
msg_with_info of
           TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
m
    TcRnWithHsDocContext HsDocContext
_ TcRnMessage
msg
      -> forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
msg
    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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Module
mod]
    TcRnIdNotExportedFromLocalSig Name
name
      -> [Name -> Maybe Module -> GhcHint
SuggestAddToHSigExportList Name
name 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
    TcRnTagToEnumResTyTypeData{}
      -> [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 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 forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> AvailableBindings
NamedBindings (Name
x 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
    TcRnLazyBangOnUnliftedType{}
      -> [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 = forall doc. IsLine doc => String -> doc
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]
    TcRnIllegalTypeOperatorDecl {}
      -> [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 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 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
    TcRnExpectedValueId{}
      -> [GhcHint]
noHints
    TcRnNotARecordSelector{}
      -> [GhcHint]
noHints
    TcRnRecSelectorEscapedTyVar{}
      -> [GhcHint
SuggestPatternMatchingSyntax]
    TcRnPatSynNotBidirectional{}
      -> [GhcHint]
noHints
    TcRnSplicePolymorphicLocalVar{}
      -> [GhcHint]
noHints
    TcRnIllegalDerivingItem{}
      -> [GhcHint]
noHints
    TcRnUnexpectedAnnotation{}
      -> [GhcHint]
noHints
    TcRnIllegalRecordSyntax{}
      -> [GhcHint]
noHints
    TcRnUnexpectedTypeSplice{}
      -> [GhcHint]
noHints
    TcRnInvalidVisibleKindArgument{}
      -> [GhcHint]
noHints
    TcRnTooManyBinders{}
      -> [GhcHint]
noHints
    TcRnDifferentNamesForTyVar{}
      -> [GhcHint]
noHints
    TcRnInvalidReturnKind DataSort
_ AllowedDataResKind
_ Type
_ Maybe SuggestUnliftedTypes
mb_suggest_unlifted_ext
      -> case Maybe SuggestUnliftedTypes
mb_suggest_unlifted_ext of
           Maybe SuggestUnliftedTypes
Nothing -> [GhcHint]
noHints
           Just SuggestUnliftedTypes
SuggestUnliftedNewtypes -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UnliftedNewtypes]
           Just SuggestUnliftedTypes
SuggestUnliftedDatatypes -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UnliftedDatatypes]
    TcRnClassKindNotConstraint{}
      -> [GhcHint]
noHints
    TcRnUnpromotableThing{}
      -> [GhcHint]
noHints
    TcRnMatchesHaveDiffNumArgs{}
      -> [GhcHint]
noHints
    TcRnCannotBindScopedTyVarInPatSig{}
      -> [GhcHint]
noHints
    TcRnCannotBindTyVarsInPatBind{}
      -> [GhcHint]
noHints
    TcRnTooManyTyArgsInConPattern{}
      -> [GhcHint]
noHints
    TcRnMultipleInlinePragmas{}
      -> [GhcHint]
noHints
    TcRnUnexpectedPragmas{}
      -> [GhcHint]
noHints
    TcRnNonOverloadedSpecialisePragma{}
      -> [GhcHint]
noHints
    TcRnSpecialiseNotVisible Name
name
      -> [Name -> GhcHint
SuggestSpecialiseVisibilityHints Name
name]
    TcRnNameByTemplateHaskellQuote{}
      -> [GhcHint]
noHints
    TcRnIllegalBindingOfBuiltIn{}
      -> [GhcHint]
noHints
    TcRnPragmaWarning{}
      -> [GhcHint]
noHints
    TcRnIllegalHsigDefaultMethods{}
      -> [GhcHint]
noHints
    TcRnBadGenericMethod{}
      -> [GhcHint]
noHints
    TcRnWarningMinimalDefIncomplete{}
      -> [GhcHint]
noHints
    TcRnDefaultMethodForPragmaLacksBinding{}
      -> [GhcHint]
noHints
    TcRnIgnoreSpecialisePragmaOnDefMethod{}
      -> [GhcHint]
noHints
    TcRnBadMethodErr{}
      -> [GhcHint]
noHints
    TcRnNoExplicitAssocTypeOrDefaultDeclaration{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnIllegalTypeData
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeData]
    TcRnTypeDataForbids{}
      -> [GhcHint]
noHints
    TcRnIllegalNewtype{}
      -> [GhcHint]
noHints
    TcRnTypedTHWithPolyType{}
      -> [GhcHint]
noHints
    TcRnSpliceThrewException{}
      -> [GhcHint]
noHints
    TcRnInvalidTopDecl{}
      -> [GhcHint]
noHints
    TcRnNonExactName{}
      -> [GhcHint]
noHints
    TcRnAddInvalidCorePlugin{}
      -> [GhcHint]
noHints
    TcRnAddDocToNonLocalDefn{}
      -> [GhcHint]
noHints
    TcRnFailedToLookupThInstName{}
      -> [GhcHint]
noHints
    TcRnCannotReifyInstance{}
      -> [GhcHint]
noHints
    TcRnCannotReifyOutOfScopeThing{}
      -> [GhcHint]
noHints
    TcRnCannotReifyThingNotInTypeEnv{}
      -> [GhcHint]
noHints
    TcRnNoRolesAssociatedWithThing{}
      -> [GhcHint]
noHints
    TcRnCannotRepresentType{}
      -> [GhcHint]
noHints
    TcRnRunSpliceFailure{}
      -> [GhcHint]
noHints
    TcRnReportCustomQuasiError{}
      -> [GhcHint]
noHints
    TcRnInterfaceLookupError{}
      -> [GhcHint]
noHints
    TcRnUnsatisfiedMinimalDef{}
      -> [GhcHint]
noHints
    TcRnMisplacedInstSig{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.InstanceSigs]
    TcRnBadBootFamInstDecl{}
      -> [GhcHint]
noHints
    TcRnIllegalFamilyInstance{}
      -> [GhcHint]
noHints
    TcRnMissingClassAssoc{}
      -> [GhcHint]
noHints
    TcRnBadFamInstDecl{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeFamilies]
    TcRnNotOpenFamily{}
      -> [GhcHint]
noHints
    TcRnNoRebindableSyntaxRecordDot{}
      -> [GhcHint]
noHints
    TcRnNoFieldPunsRecordDot{}
      -> [GhcHint]
noHints
    TcRnIllegalStaticExpression{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.StaticPointers]
    TcRnIllegalStaticFormInSplice{}
      -> [GhcHint]
noHints
    TcRnListComprehensionDuplicateBinding{}
      -> [GhcHint]
noHints
    TcRnEmptyStmtsGroup EmptyStmtsGroupInDoNotation{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.NondecreasingIndentation]
    TcRnEmptyStmtsGroup{}
      -> [GhcHint]
noHints
    TcRnLastStmtNotExpr{}
      -> [GhcHint]
noHints
    TcRnUnexpectedStatementInContext HsStmtContext GhcRn
_ UnexpectedStatement
_ Maybe Extension
mExt
      | Maybe Extension
Nothing <- Maybe Extension
mExt -> [GhcHint]
noHints
      | Just Extension
ext <- Maybe Extension
mExt -> [Extension -> GhcHint
suggestExtension Extension
ext]
    TcRnSectionWithoutParentheses{}
      -> [GhcHint]
noHints
    TcRnIllegalImplicitParameterBindings{}
      -> [GhcHint]
noHints
    TcRnIllegalTupleSection{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TupleSections]
    TcRnLoopySuperclassSolve CtLoc
wtd_loc Type
wtd_pty
      -> [Type -> ClsInstOrQC -> GhcHint
LoopySuperclassSolveHint Type
wtd_pty ClsInstOrQC
cls_or_qc]
      where
        cls_or_qc :: ClsInstOrQC
        cls_or_qc :: ClsInstOrQC
cls_or_qc = case CtLoc -> CtOrigin
ctLocOrigin CtLoc
wtd_loc of
          ScOrigin ClsInstOrQC
c_or_q NakedScFlag
_ -> ClsInstOrQC
c_or_q
          CtOrigin
_                 -> ClsInstOrQC
IsClsInst -- shouldn't happen
    TcRnCannotDefaultConcrete{}
      -> [AvailableBindings -> GhcHint
SuggestAddTypeSignatures AvailableBindings
UnnamedBinding]

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

-- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z",
-- and so on.  The `and` stands for any `conjunction`, which is passed in.
commafyWith :: SDoc -> [SDoc] -> [SDoc]
commafyWith :: SDoc -> [SDoc] -> [SDoc]
commafyWith SDoc
_ [] = []
commafyWith SDoc
_ [SDoc
x] = [SDoc
x]
commafyWith SDoc
conjunction [SDoc
x, SDoc
y] = [SDoc
x forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
conjunction forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
y]
commafyWith SDoc
conjunction [SDoc]
xs = [SDoc] -> [SDoc]
addConjunction forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma [SDoc]
xs
    where addConjunction :: [SDoc] -> [SDoc]
addConjunction [SDoc
x, SDoc
y] = [SDoc
x, SDoc
conjunction, SDoc
y]
          addConjunction (SDoc
x : [SDoc]
xs) = SDoc
x forall a. a -> [a] -> [a]
: [SDoc] -> [SDoc]
addConjunction [SDoc]
xs
          addConjunction [SDoc]
_ = forall a. HasCallStack => String -> a
panic String
"commafyWith expected 2 or more elements"

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 forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
gen1ClassKey Bool -> Bool -> Bool
&& Int
n_args_to_keep 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 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 forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrCannotEtaReduceEnough{}
    | UsingGeneralizedNewtypeDeriving
newtype_deriving forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrOnlyAnyClassDeriveable TyCon
_ DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrNotDeriveable DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled 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 = forall doc. IsLine doc => String -> doc
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 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
                                 -> Bool
                                 -> DecoratedSDoc
                                 -> DecoratedSDoc
messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo -> Bool -> DecoratedSDoc -> DecoratedSDoc
messageWithInfoDiagnosticMessage UnitState
unit_state ErrInfo{SDoc
errInfoSupplementary :: SDoc
errInfoContext :: SDoc
errInfoSupplementary :: ErrInfo -> SDoc
errInfoContext :: ErrInfo -> SDoc
..} Bool
show_ctxt DecoratedSDoc
important =
  let err_info' :: [SDoc]
err_info' = forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state) ([SDoc
errInfoContext | Bool
show_ctxt] forall a. [a] -> [a] -> [a]
++ [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
  = forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
kind forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"item"
                     forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr b
ie)
                forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"suggests that",
          SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr a
tc) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"has (in-scope) constructors or class methods,",
          forall doc. IsLine doc => String -> doc
text String
"but it has none" ]

dodgy_msg_insert :: forall p . (Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) => IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert :: forall (p :: Pass).
(Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) =>
IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert IdP (GhcPass p)
tc = forall pass. XIEThingAll pass -> LIEWrappedName pass -> IE pass
IEThingAll forall a. EpAnn a
noAnn LIEWrappedName (GhcPass p)
ii
  where
    ii :: LIEWrappedName (GhcPass p)
    ii :: LIEWrappedName (GhcPass p)
ii = forall a an. a -> LocatedAn an a
noLocA (forall p. XIEName p -> LIdP p -> IEWrappedName p
IEName NoExtField
noExtField forall a b. (a -> b) -> a -> b
$ forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass 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 forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"does not have a fixed runtime representation:"
  forall doc. IsDoc doc => doc -> doc -> doc
$$ 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 forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
tidy_ty forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> 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 (HasDebugCallStack => Type -> Type
typeKind Type
ty)

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

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

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

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

formatExportItemError :: SDoc -> String -> SDoc
formatExportItemError :: SDoc -> String -> SDoc
formatExportItemError SDoc
exportedThing String
reason =
  forall doc. IsLine doc => [doc] -> doc
hsep [ forall doc. IsLine doc => String -> doc
text String
"The export item"
       , SDoc -> SDoc
quotes SDoc
exportedThing
       , forall doc. IsLine doc => String -> doc
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 (forall doc. IsLine doc => String -> doc
text String
"to pick a different strategy") Extension
LangExt.DerivingStrategies

useGND :: GhcHint
useGND :: GhcHint
useGND = let info :: SDoc
info = forall doc. IsLine doc => String -> doc
text String
"for GHC's" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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 forall doc. IsLine doc => [doc] -> doc
sep [(SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Can't make a derived instance of")
                   Int
2 (SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
pred) forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
via_mechanism)
                forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 SDoc
extra) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon,
               Int -> SDoc -> SDoc
nest Int
2 SDoc
why]
      else SDoc
why
  where
    strat_used :: Bool
strat_used = forall a. Maybe a -> Bool
isJust Maybe (DerivStrategy GhcTc)
mb_strat
    extra :: SDoc
extra | Bool -> Bool
not Bool
strat_used, (UsingGeneralizedNewtypeDeriving
newtype_deriving forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
YesGeneralizedNewtypeDeriving)
          = forall doc. IsLine doc => String -> doc
text String
"(even with cunning GeneralizedNewtypeDeriving)"
          | Bool
otherwise = forall doc. IsOutput doc => doc
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
                  = forall doc. IsLine doc => String -> doc
text String
"with the" forall doc. IsLine doc => doc -> doc -> doc
<+> (forall a. DerivStrategy a -> SDoc
derivStrategyName DerivStrategy GhcTc
strat) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"strategy"
                  | Bool
otherwise
                  = forall doc. IsOutput doc => doc
empty

badCon :: DataCon -> SDoc -> SDoc
badCon :: DataCon -> SDoc -> SDoc
badCon DataCon
con SDoc
msg = forall doc. IsLine doc => String -> doc
text String
"Constructor" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr DataCon
con) forall doc. IsLine doc => doc -> doc -> doc
<+> 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
_
    -> forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Cannot derive well-kinded instance of form"
                         forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> [Type] -> SDoc
pprClassPred Class
cls [Type]
cls_tys
                                       forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr TyCon
tc forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"...")))
                  Int
2 forall doc. IsOutput doc => doc
empty
           , Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsLine doc => String -> doc
text String
"Class" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Class
cls)
                         forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"expects an argument of kind"
                         forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
cls_kind))
           ]
  DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst
    ->     forall doc. IsLine doc => String -> doc
text String
"Generic instances can only be derived in"
       forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"Safe Haskell using the stock strategy."
  DerivErrDerivingViaWrongKind Type
cls_kind Type
via_ty Type
via_kind
    -> SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Cannot derive instance via" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
via_ty))
          Int
2 (forall doc. IsLine doc => String -> doc
text String
"Class" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Class
cls)
                  forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"expects an argument of kind"
                  forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
cls_kind) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
','
         SDoc -> SDoc -> SDoc
$+$ forall doc. IsLine doc => String -> doc
text String
"but" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
via_ty)
                  forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"has kind" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
via_kind))
  DerivErrNoEtaReduce Type
inst_ty
    -> forall doc. IsLine doc => [doc] -> doc
sep [forall doc. IsLine doc => String -> doc
text String
"Cannot eta-reduce to an instance of form",
            Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsLine doc => String -> doc
text String
"instance (...) =>"
                   forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> [Type] -> SDoc
pprClassPred Class
cls ([Type]
cls_tys 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
         (forall doc. IsLine doc => String -> doc
text String
"Cannot derive instances in hs-boot files"
          SDoc -> SDoc -> SDoc
$+$ forall doc. IsLine doc => String -> doc
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 (forall doc. IsLine doc => String -> doc
text String
"The data constructors of" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
tc) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"are not all in scope")
            Int
2 (forall doc. IsLine doc => String -> doc
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
         (forall doc. IsLine doc => String -> doc
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
         (forall doc. IsLine doc => String -> doc
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
         ( forall doc. IsLine doc => String -> doc
text String
"The last argument of the instance must be a"
         forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
         (forall doc. IsLine doc => String -> doc
text String
"No family instance for" forall doc. IsLine doc => doc -> doc -> doc
<+> 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 (forall a. Outputable a => a -> SDoc
ppr Class
cls) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
         forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (HasAssociatedDataFamInsts
hasAdfs 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     -> forall doc. IsOutput doc => doc
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     -> forall doc. IsOutput doc => doc
empty
               ]
       where

         adfs_msg :: SDoc
adfs_msg  = forall doc. IsLine doc => String -> doc
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
           (forall doc. IsLine doc => String -> doc
text String
"the associated type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
            forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not parameterized over the last type variable")
           Int
2 (forall doc. IsLine doc => String -> doc
text String
"of the class" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (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
           (forall doc. IsLine doc => String -> doc
text String
"the associated type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
            forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"contains the last type variable")
          Int
2 (forall doc. IsLine doc => String -> doc
text String
"of the class" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Class
cls)
            forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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 = forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
eta_ok SDoc
eta_msg
           eta_msg :: SDoc
eta_msg = forall doc. IsLine doc => String -> doc
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 (forall a. Outputable a => a -> SDoc
ppr TyCon
tc) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is a type class,"
                          forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"and can only have a derived instance"
                          SDoc -> SDoc -> SDoc
$+$ forall doc. IsLine doc => String -> doc
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 forall doc. IsOutput doc => doc
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 (forall a. Outputable a => a -> SDoc
ppr Type
predType) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
         (forall doc. IsLine doc => String -> doc
text String
"You need " forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr Extension
ext
            forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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 (forall doc. IsLine doc => String -> doc
text String
"Don't know how to derive" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Class
cls))
              Int
2 (forall doc. IsLine doc => String -> doc
text String
"for type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (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
         (forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) forall doc. IsLine doc => doc -> doc -> doc
<+>
                forall doc. IsLine doc => String -> doc
text String
"must be an enumeration type"
              , forall doc. IsLine doc => String -> doc
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) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
         (forall doc. IsLine doc => String -> doc
text String
"Data type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
         (forall doc. IsLine doc => String -> doc
text String
"Data type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
           forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"must not have a class context:" forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
pprTheta [Type]
bad_stupid_theta)
  DerivErrBadConstructor Maybe HasWildcard
_ [DeriveInstanceBadConstructor]
reasons
    -> let why :: SDoc
why = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"must be truly polymorphic in the last argument of the data type"
                 DerivErrBadConCovariant DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"must not use the type variable in a function argument"
                 DerivErrBadConFunTypes DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"must not contain function types"
                 DerivErrBadConWrongArg DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
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 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"is a GADT"
                 DerivErrBadConHasExistentials DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"has existential type variables in its type"
                 DerivErrBadConHasConstraints DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"has constraints in its type"
                 DerivErrBadConHasHigherRankType DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"has a higher-rank type"
  DerivErrGenerics [DeriveGenericsErrReason]
reasons
    -> let why :: SDoc
why = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ 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
                -> forall a. Outputable a => a -> SDoc
ppr TyCon
tc_name forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"must not have a datatype context"
             DerivErrGenericsMustNotHaveExoticArgs DataCon
dc
                -> forall a. Outputable a => a -> SDoc
ppr DataCon
dc forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"must not have exotic unlifted or polymorphic arguments"
             DerivErrGenericsMustBeVanillaDataCon DataCon
dc
                -> forall a. Outputable a => a -> SDoc
ppr DataCon
dc forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"must be a vanilla data constructor"
             DerivErrGenericsMustHaveSomeTypeParams TyCon
rep_tc
                ->     forall doc. IsLine doc => String -> doc
text String
"Data type" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
                   forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"must have some type parameters"
             DerivErrGenericsMustNotHaveExistentials DataCon
con
               -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"must not have existential arguments"
             DerivErrGenericsWrongArgKind DataCon
con
               -> DataCon -> SDoc -> SDoc
badCon DataCon
con forall a b. (a -> b) -> a -> b
$
                    forall doc. IsLine doc => String -> doc
text String
"applies a type to an argument involving the last parameter"
                 forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
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 forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"  or" forall doc. IsDoc doc => doc -> doc -> doc
$$ 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 })
    = forall doc. IsLine doc => String -> doc
text String
"CEC" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
braces (forall doc. IsDoc doc => [doc] -> doc
vcat
         [ forall doc. IsLine doc => String -> doc
text String
"cec_binds"              forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr EvBindsVar
bvar
         , forall doc. IsLine doc => String -> doc
text String
"cec_defer_type_errors"  forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
dte
         , forall doc. IsLine doc => String -> doc
text String
"cec_expr_holes"         forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
eh
         , forall doc. IsLine doc => String -> doc
text String
"cec_type_holes"         forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
th
         , forall doc. IsLine doc => String -> doc
text String
"cec_out_of_scope_holes" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
osh
         , forall doc. IsLine doc => String -> doc
text String
"cec_warn_redundant"     forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Bool
wr
         , forall doc. IsLine doc => String -> doc
text String
"cec_expand_syns"        forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Bool
es
         , forall doc. IsLine doc => String -> doc
text String
"cec_suppress"           forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc
equals forall doc. IsLine doc => doc -> doc -> doc
<+> 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
_ (BadTelescope TyVarBndrs
telescope [TcTyVar]
skols) =
  SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"These kind and type variables:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr TyVarBndrs
telescope forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsLine doc => String -> doc
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
ctxt
  (CannotUnifyVariable
    { mismatchMsg :: TcSolverReportMsg -> MismatchMsg
mismatchMsg         = MismatchMsg
msg
    , cannotUnifyReason :: TcSolverReportMsg -> CannotUnifyVariableReason
cannotUnifyReason   = CannotUnifyVariableReason
reason })
  =  SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
msg
  forall doc. IsDoc doc => doc -> doc -> doc
$$ SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt CannotUnifyVariableReason
reason
pprTcSolverReportMsg SolverReportErrCtxt
ctxt
  (Mismatch
     { mismatchMsg :: TcSolverReportMsg -> MismatchMsg
mismatchMsg           = MismatchMsg
mismatch_msg
     , mismatchTyVarInfo :: TcSolverReportMsg -> Maybe TyVarInfo
mismatchTyVarInfo     = Maybe TyVarInfo
tv_info
     , mismatchAmbiguityInfo :: TcSolverReportMsg -> [AmbiguityInfo]
mismatchAmbiguityInfo = [AmbiguityInfo]
ambig_infos
     , mismatchCoercibleInfo :: TcSolverReportMsg -> Maybe CoercibleMsg
mismatchCoercibleInfo = Maybe CoercibleMsg
coercible_info })
  = SDoc -> Int -> SDoc -> SDoc
hang (SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_msg)
     Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat ( forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt) Maybe TyVarInfo
tv_info
             forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty CoercibleMsg -> SDoc
pprCoercibleMsg Maybe CoercibleMsg
coercible_info
             forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map AmbiguityInfo -> SDoc
pprAmbiguityInfo [AmbiguityInfo]
ambig_infos ))
pprTcSolverReportMsg SolverReportErrCtxt
_ (FixedRuntimeRepError [FixedRuntimeRepErrorInfo]
frr_origs) =
  forall doc. IsDoc doc => [doc] -> doc
vcat (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 forall (t :: * -> *) a. Foldable t => t a -> Int
length [FixedRuntimeRepErrorInfo]
frr_origs forall a. Ord a => a -> a -> Bool
> Int
1 then (SDoc
bullet forall doc. IsLine doc => doc -> doc -> doc
<+>) else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
        forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => [doc] -> doc
sep [ FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext FixedRuntimeRepContext
frr_ctxt
                   , forall doc. IsLine doc => String -> doc
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 -> forall doc. IsOutput doc => doc
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 (HasDebugCallStack => Type -> Type
typeKind Type
inner_ty)
        Type
_ -> Bool
False

    type_printout :: Type -> SDoc
    type_printout :: Type -> SDoc
type_printout Type
ty =
      forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions 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 forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Its kind is:"
                  , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprWithTYPE (HasDebugCallStack => Type -> Type
typeKind Type
ty)
                  , forall doc. IsLine doc => String -> doc
text String
"(Use -fprint-explicit-coercions to see the full type.)" ]
        else forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Its type is:"
                  , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr Type
ty forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprWithTYPE (HasDebugCallStack => 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 =
          forall doc. IsLine doc => String -> doc
text String
"Cannot unify" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
not_conc)
      forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"with the type variable" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)
      forall doc. IsDoc doc => doc -> doc -> doc
$$  forall doc. IsLine doc => String -> doc
text String
"because it is not a concrete" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot
      where
        ki :: Type
ki = TcTyVar -> Type
tyVarKind TcTyVar
tv
        what :: SDoc
        what :: SDoc
what
          | Type -> Bool
isRuntimeRepTy Type
ki
          = SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"RuntimeRep")
          | Type -> Bool
isLevityTy Type
ki
          = SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
"Levity")
          | Bool
otherwise
          = forall doc. IsLine doc => String -> doc
text String
"type"
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
  = forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is untouchable"
        , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"inside the constraints:" forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
pprEvVarTheta [TcTyVar]
given
        , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"bound by" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
        , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"at" forall doc. IsLine doc => doc -> doc -> doc
<+>
          forall a. Outputable a => a -> SDoc
ppr (TcLclEnv -> RealSrcSpan
getLclEnvLoc (Implication -> TcLclEnv
ic_env Implication
implic)) ]
pprTcSolverReportMsg SolverReportErrCtxt
_ (BlockedEquality ErrorItem
item) =
  forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Cannot use equality for substitution:")
           Int
2 (forall a. Outputable a => a -> SDoc
ppr (ErrorItem -> Type
errorItemPred ErrorItem
item))
       , forall doc. IsLine doc => String -> doc
text String
"Doing so would be ill-kinded." ]
pprTcSolverReportMsg SolverReportErrCtxt
_ (ExpectingMoreArguments Int
n TypedThing
thing) =
  forall doc. IsLine doc => String -> doc
text String
"Expecting" forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
speakN (forall a. Num a => a -> a
abs Int
n) forall doc. IsLine doc => doc -> doc -> doc
<+>
    SDoc
more forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TypedThing
thing)
  where
    more :: SDoc
more
     | Int
n forall a. Eq a => a -> a -> Bool
== Int
1    = forall doc. IsLine doc => String -> doc
text String
"more argument to"
     | Bool
otherwise = forall doc. IsLine doc => String -> doc
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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
givens
     then CtLoc -> SDoc -> SDoc
addArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) forall a b. (a -> b) -> a -> b
$
            forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"Unbound implicit parameter" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [Type]
preds
                , Int -> SDoc -> SDoc
nest Int
2 ([Type] -> SDoc
pprParendTheta [Type]
preds) ]
     else SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt ([Implication]
-> NonEmpty ErrorItem -> Maybe CND_Extra -> MismatchMsg
CouldNotDeduce [Implication]
givens (ErrorItem
item forall a. a -> [a] -> NonEmpty a
:| [ErrorItem]
items) forall a. Maybe a
Nothing)
  where
    preds :: [Type]
preds = forall a b. (a -> b) -> [a] -> [b]
map ErrorItem -> Type
errorItemPred (ErrorItem
item forall a. a -> [a] -> [a]
: [ErrorItem]
items)
pprTcSolverReportMsg SolverReportErrCtxt
_ (AmbiguityPreventsSolvingCt ErrorItem
item ([TcTyVar], [TcTyVar])
ambigs) =
  AmbiguityInfo -> SDoc
pprAmbiguityInfo (Bool -> ([TcTyVar], [TcTyVar]) -> AmbiguityInfo
Ambiguity Bool
True ([TcTyVar], [TcTyVar])
ambigs) forall doc. IsLine doc => doc -> doc -> doc
<+>
  CtLoc -> SDoc
pprArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) forall doc. IsDoc doc => doc -> doc -> doc
$$
  forall doc. IsLine doc => String -> doc
text String
"prevents the constraint" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprParendType forall a b. (a -> b) -> a -> b
$ ErrorItem -> Type
errorItemPred ErrorItem
item)
  forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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)
  =
    forall doc. IsDoc doc => [doc] -> doc
vcat
      [ SDoc
no_inst_msg
      , Int -> SDoc -> SDoc
nest Int
2 SDoc
extra_note
      , Maybe SDoc
mb_patsyn_prov forall a. Maybe a -> a -> a
`orElse` forall doc. IsOutput doc => doc
empty
      , forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool
has_ambigs Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens))
        (forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
lead_with_ambig forall a b. (a -> b) -> a -> b
$
                  AmbiguityInfo -> SDoc
pprAmbiguityInfo (Bool -> ([TcTyVar], [TcTyVar]) -> AmbiguityInfo
Ambiguity Bool
False ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs))
              , RelevantBindings -> SDoc
pprRelevantBindings RelevantBindings
binds
              , SDoc
potential_msg ])
      , forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (forall a. Maybe a -> Bool
isNothing Maybe SDoc
mb_patsyn_prov) 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
                    forall a. [a] -> [a] -> [a]
++ [SDoc]
drv_fixes forall a. [a] -> [a] -> [a]
++ [SDoc]
naked_sc_fixes)
      , forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
candidates))
        (SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"There are instances for similar types:")
            Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [ClsInst]
candidates)))
            -- See Note [Report candidate instances]
      , forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs
      , forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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)   = HasDebugCallStack => Type -> (Class, [Type])
getClassPredTys Type
pred
    -- See Note [Highlighting ambiguous type variables] in GHC.Tc.Errors
    ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs) = Type -> ([TcTyVar], [TcTyVar])
ambigTkvsOfTy Type
pred
    ambigs :: [TcTyVar]
ambigs = [TcTyVar]
ambig_kvs forall a. [a] -> [a] -> [a]
++ [TcTyVar]
ambig_tvs
    has_ambigs :: Bool
has_ambigs = Bool -> Bool
not (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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
ambigs)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TcTyVar -> Bool
isRuntimeUnkSkol [TcTyVar]
ambigs)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers)
                   Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens

    no_inst_msg :: SDoc
    no_inst_msg :: SDoc
no_inst_msg
      | Bool
lead_with_ambig
      = SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt forall a b. (a -> b) -> a -> b
$ ErrorItem -> ([TcTyVar], [TcTyVar]) -> TcSolverReportMsg
AmbiguityPreventsSolvingCt ErrorItem
item ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs)
      | Bool
otherwise
      = SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt forall a b. (a -> b) -> a -> b
$ [Implication]
-> NonEmpty ErrorItem -> Maybe CND_Extra -> MismatchMsg
CouldNotDeduce [Implication]
useful_givens (ErrorItem
item forall a. a -> [a] -> NonEmpty a
:| []) 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
      = forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) Bool -> Bool -> Bool
&& CtOrigin -> Bool
want_potential CtOrigin
orig) forall a b. (a -> b) -> a -> b
$
          SDoc
potential_hdr forall doc. IsDoc doc => doc -> doc -> doc
$$
          PotentialInstances -> SDoc
potentialInstancesErrMsg (PotentialInstances { matches :: [ClsInst]
matches = [], [ClsInst]
unifiers :: [ClsInst]
unifiers :: [ClsInst]
unifiers })

    potential_hdr :: SDoc
potential_hdr
      = forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
lead_with_ambig forall a b. (a -> b) -> a -> b
$
        forall doc. IsLine doc => String -> doc
text String
"Probable fix: use a type annotation to specify what"
        forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
ambig_tvs forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
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
      = forall a. a -> Maybe a
Just (forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"In other words, a successful match on the pattern"
                   , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr Pat GhcRn
pat
                   , forall doc. IsLine doc => String -> doc
text String
"does not provide the constraint" forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
pred ])
      | Bool
otherwise = forall a. Maybe a
Nothing

    extra_note :: SDoc
extra_note | 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)
               = forall doc. IsLine doc => String -> doc
text String
"(maybe you haven't applied a function to enough arguments?)"
               | Class -> Name
className Class
clas 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])
tcSplitTyConApp_maybe Type
ty
               , Bool -> Bool
not (TyCon -> Bool
isTypeFamilyTyCon TyCon
tc)
               = SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"GHC can't yet do polykinded")
                    Int
2 (forall doc. IsLine doc => String -> doc
text String
"Typeable" forall doc. IsLine doc => doc -> doc -> doc
<+>
                       forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr Type
ty forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
typeKind Type
ty)))
               | Bool
otherwise
               = forall doc. IsOutput doc => doc
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
      = forall doc. IsLine doc => String -> doc
text String
"fill in the wildcard constraint yourself"
      | Bool
otherwise
      = SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"use a standalone 'deriving instance' declaration,")
           Int
2 (forall doc. IsLine doc => String -> doc
text String
"so you can specify the instance context yourself")

    -- naked_sc_fix: try to produce a helpful error message for
    -- superclass constraints caught by the subtleties described by
    -- Note [Recursive superclasses] in GHC.TyCl.Instance
    naked_sc_fixes :: [SDoc]
naked_sc_fixes
      | ScOrigin ClsInstOrQC
_ NakedScFlag
NakedSc <- CtOrigin
orig  -- A superclass wanted with no instance decls used yet
      , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Implication -> Bool
non_tyvar_preds [Implication]
useful_givens  -- Some non-tyvar givens
      = [forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"If the constraint looks soluble from a superclass of the instance context,"
              , forall doc. IsLine doc => String -> doc
text String
"read 'Undecidable instances and loopy superclasses' in the user manual" ]]
      | Bool
otherwise = []

    non_tyvar_preds :: UserGiven -> Bool
    non_tyvar_preds :: Implication -> Bool
non_tyvar_preds = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TcTyVar -> Bool
non_tyvar_pred forall b c a. (b -> c) -> (a -> b) -> a -> c
. Implication -> [TcTyVar]
ic_given

    non_tyvar_pred :: EvVar -> Bool
    -- Tells if the Given is of form (C ty1 .. tyn), where the tys are not all tyvars
    non_tyvar_pred :: TcTyVar -> Bool
non_tyvar_pred TcTyVar
given = case Type -> Maybe (Class, [Type])
getClassPredTys_maybe (TcTyVar -> Type
idType TcTyVar
given) of
                             Just (Class
_, [Type]
tys) -> Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isTyVarTy [Type]
tys)
                             Maybe (Class, [Type])
Nothing       -> Bool
False

pprTcSolverReportMsg (CEC {cec_encl :: SolverReportErrCtxt -> [Implication]
cec_encl = [Implication]
implics}) (OverlappingInstances ErrorItem
item NonEmpty ClsInst
matches [ClsInst]
unifiers) =
  forall doc. IsDoc doc => [doc] -> doc
vcat
    [ CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc forall a b. (a -> b) -> a -> b
$
        (forall doc. IsLine doc => String -> doc
text String
"Overlapping instances for"
        forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType (Class -> [Type] -> Type
mkClassPred Class
clas [Type]
tys))
    , forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
matching_givens) forall a b. (a -> b) -> a -> b
$
                  forall doc. IsLine doc => [doc] -> doc
sep [forall doc. IsLine doc => String -> doc
text String
"Matching givens (or their superclasses):"
                      , Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
matching_givens)]
    ,  PotentialInstances -> SDoc
potentialInstancesErrMsg
        (PotentialInstances { matches :: [ClsInst]
matches = forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
matches, [ClsInst]
unifiers :: [ClsInst]
unifiers :: [ClsInst]
unifiers })
    ,  forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
matching_givens Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. NonEmpty a -> [a]
NE.tail NonEmpty ClsInst
matches) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) 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.
         forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"There exists a (perhaps superclass) match:"
             , Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat ([Implication] -> [SDoc]
pp_givens [Implication]
useful_givens))]

    ,  forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.tail NonEmpty ClsInst
matches) forall a b. (a -> b) -> a -> b
$
       forall doc. IsLine doc => doc -> doc
parens (forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
tyCoVars) forall a b. (a -> b) -> a -> b
$
                        forall doc. IsLine doc => String -> doc
text String
"The choice depends on the instantiation of" forall doc. IsLine doc => doc -> doc -> doc
<+>
                          SDoc -> SDoc
quotes (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
tyCoVars)
                    , forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyCon]
famTyCons) forall a b. (a -> b) -> a -> b
$
                        if (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
tyCoVars)
                          then
                            forall doc. IsLine doc => String -> doc
text String
"The choice depends on the result of evaluating" forall doc. IsLine doc => doc -> doc -> doc
<+>
                              SDoc -> SDoc
quotes (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [TyCon]
famTyCons)
                          else
                            forall doc. IsLine doc => String -> doc
text String
"and the result of evaluating" forall doc. IsLine doc => doc -> doc -> doc
<+>
                              SDoc -> SDoc
quotes (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [TyCon]
famTyCons)
                    , forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SDoc]
matching_givens)) forall a b. (a -> b) -> a -> b
$
                      forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"To pick the first instance above, use IncoherentInstances"
                           , forall doc. IsLine doc => String -> doc
text String
"when compiling the other instance declarations"]
               ])]
  where
    ct_loc :: CtLoc
ct_loc          = ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item
    orig :: CtOrigin
orig            = CtLoc -> CtOrigin
ctLocOrigin CtLoc
ct_loc
    pred :: Type
pred            = ErrorItem -> Type
errorItemPred ErrorItem
item
    (Class
clas, [Type]
tys)     = HasDebugCallStack => Type -> (Class, [Type])
getClassPredTys Type
pred
    tyCoVars :: [TcTyVar]
tyCoVars        = [Type] -> [TcTyVar]
tyCoVarsOfTypesList [Type]
tys
    famTyCons :: [TyCon]
famTyCons       = forall a. (a -> Bool) -> [a] -> [a]
filter TyCon -> Bool
isFamilyTyCon forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet 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 = 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
             [] -> forall a. Maybe a
Nothing
             [Type]
_  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang ([Type] -> SDoc
pprTheta [Type]
ev_vars_matching)
                            Int
2 (forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"bound by" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                                   , forall doc. IsLine doc => String -> doc
text String
"at" forall doc. IsLine doc => doc -> doc -> doc
<+>
                                     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
                                 , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Type -> Bool
can_match (Type
pred 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' forall a. Eq a => a -> a -> Bool
== Class
clas
                                          Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust ([Type] -> [Type] -> Maybe Subst
tcMatchTys [Type]
tys [Type]
tys')
                     Maybe (Class, [Type])
Nothing -> Bool
False
pprTcSolverReportMsg SolverReportErrCtxt
_ (UnsafeOverlap ErrorItem
item ClsInst
match NonEmpty ClsInst
unsafe_overlapped) =
  forall doc. IsDoc doc => [doc] -> doc
vcat [ CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (forall doc. IsLine doc => String -> doc
text String
"Unsafe overlapping instances for"
                  forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType (Class -> [Type] -> Type
mkClassPred Class
clas [Type]
tys))
       , forall doc. IsLine doc => [doc] -> doc
sep [forall doc. IsLine doc => String -> doc
text String
"The matching instance is:",
              Int -> SDoc -> SDoc
nest Int
2 (ClsInst -> SDoc
pprInstance ClsInst
match)]
       , forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"It is compiled in a Safe module and as such can only"
              , forall doc. IsLine doc => String -> doc
text String
"overlap instances from the same module, however it"
              , forall doc. IsLine doc => String -> doc
text String
"overlaps the following instances from different" forall doc. IsLine doc => doc -> doc -> doc
<+>
                forall doc. IsLine doc => String -> doc
text String
"modules:"
              , Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat [[ClsInst] -> SDoc
pprInstances forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
unsafe_overlapped])
              ]
       ]
  where
    ct_loc :: CtLoc
ct_loc      = ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item
    pred :: Type
pred        = ErrorItem -> Type
errorItemPred ErrorItem
item
    (Class
clas, [Type]
tys) = HasDebugCallStack => Type -> (Class, [Type])
getClassPredTys Type
pred

pprCannotUnifyVariableReason :: SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc
pprCannotUnifyVariableReason :: SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt (CannotUnifyWithPolytype ErrorItem
item TcTyVar
tv1 Type
ty2 Maybe TyVarInfo
mb_tv_info) =
  forall doc. IsDoc doc => [doc] -> doc
vcat [ (if TcTyVar -> Bool
isSkolemTyVar TcTyVar
tv1
          then forall doc. IsLine doc => String -> doc
text String
"Cannot equate type variable"
          else forall doc. IsLine doc => String -> doc
text String
"Cannot instantiate unification variable")
         forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv1)
       , SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"with a" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"involving polytypes:") Int
2 (forall a. Outputable a => a -> SDoc
ppr Type
ty2)
       , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt) Maybe TyVarInfo
mb_tv_info ]
  where
    what :: SDoc
what = forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$ TypeOrKind -> String
levelString forall a b. (a -> b) -> a -> b
$
           CtLoc -> Maybe TypeOrKind
ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel

pprCannotUnifyVariableReason SolverReportErrCtxt
_ (SkolemEscape ErrorItem
item Implication
implic [TcTyVar]
esc_skols) =
  let
    esc_doc :: SDoc
esc_doc = forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"because" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"variable" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [TcTyVar]
esc_skols
                forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
esc_skols
              , forall doc. IsLine doc => String -> doc
text String
"would escape" forall doc. IsLine doc => doc -> doc -> doc
<+>
                if forall a. [a] -> Bool
isSingleton [TcTyVar]
esc_skols then forall doc. IsLine doc => String -> doc
text String
"its scope"
                                         else forall doc. IsLine doc => String -> doc
text String
"their scope" ]
  in
  forall doc. IsDoc doc => [doc] -> doc
vcat [ Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ SDoc
esc_doc
       , forall doc. IsLine doc => [doc] -> doc
sep [ (if forall a. [a] -> Bool
isSingleton [TcTyVar]
esc_skols
                then forall doc. IsLine doc => String -> doc
text String
"This (rigid, skolem)" forall doc. IsLine doc => doc -> doc -> doc
<+>
                     SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"variable is"
                else forall doc. IsLine doc => String -> doc
text String
"These (rigid, skolem)" forall doc. IsLine doc => doc -> doc -> doc
<+>
                     SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"variables are")
         forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"bound by"
       , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr (Implication -> SkolemInfoAnon
ic_info Implication
implic)
       , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"at" forall doc. IsLine doc => doc -> doc -> doc
<+>
         forall a. Outputable a => a -> SDoc
ppr (TcLclEnv -> RealSrcSpan
getLclEnvLoc (Implication -> TcLclEnv
ic_env Implication
implic)) ] ]
  where
    what :: SDoc
what = forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$ TypeOrKind -> String
levelString forall a b. (a -> b) -> a -> b
$
           CtLoc -> Maybe TypeOrKind
ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel

pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt
  (OccursCheck
    { occursCheckInterestingTyVars :: CannotUnifyVariableReason -> [TcTyVar]
occursCheckInterestingTyVars = [TcTyVar]
interesting_tvs
    , occursCheckAmbiguityInfos :: CannotUnifyVariableReason -> [AmbiguityInfo]
occursCheckAmbiguityInfos    = [AmbiguityInfo]
ambig_infos })
  = [TcTyVar] -> SDoc
ppr_interesting_tyVars [TcTyVar]
interesting_tvs
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map AmbiguityInfo -> SDoc
pprAmbiguityInfo [AmbiguityInfo]
ambig_infos)
  where
    ppr_interesting_tyVars :: [TcTyVar] -> SDoc
ppr_interesting_tyVars [] = forall doc. IsOutput doc => doc
empty
    ppr_interesting_tyVars (TcTyVar
tv:[TcTyVar]
tvs) =
      SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Type variable kinds:") Int
2 forall a b. (a -> b) -> a -> b
$
      forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (TcTyVar -> SDoc
tyvar_binding forall b c a. (b -> c) -> (a -> b) -> a -> c
. TidyEnv -> TcTyVar -> TcTyVar
tidyTyCoVarOcc (SolverReportErrCtxt -> TidyEnv
cec_tidy SolverReportErrCtxt
ctxt))
                (TcTyVar
tvforall a. a -> [a] -> [a]
:[TcTyVar]
tvs))
    tyvar_binding :: TcTyVar -> SDoc
tyvar_binding TcTyVar
tyvar = forall a. Outputable a => a -> SDoc
ppr TcTyVar
tyvar forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (TcTyVar -> Type
tyVarKind TcTyVar
tyvar)
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt (DifferentTyVars TyVarInfo
tv_info)
  = SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt TyVarInfo
tv_info
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt (RepresentationalEq TyVarInfo
tv_info Maybe CoercibleMsg
mb_coercible_msg)
  = SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt TyVarInfo
tv_info
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty CoercibleMsg -> SDoc
pprCoercibleMsg Maybe CoercibleMsg
mb_coercible_msg

pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt
  (BasicMismatch { mismatch_ea :: MismatchMsg -> MismatchEA
mismatch_ea   = MismatchEA
ea
                 , mismatch_item :: MismatchMsg -> ErrorItem
mismatch_item = ErrorItem
item
                 , mismatch_ty1 :: MismatchMsg -> Type
mismatch_ty1  = Type
ty1  -- Expected
                 , mismatch_ty2 :: MismatchMsg -> Type
mismatch_ty2  = Type
ty2  -- Actual
                 , mismatch_whenMatching :: MismatchMsg -> Maybe WhenMatching
mismatch_whenMatching = Maybe WhenMatching
mb_match_txt
                 , mismatch_mb_same_occ :: MismatchMsg -> Maybe SameOccInfo
mismatch_mb_same_occ  = Maybe SameOccInfo
same_occ_info })
  =  forall doc. IsDoc doc => [doc] -> doc
vcat [ CtLoc -> SDoc -> SDoc
addArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) SDoc
msg
          , SDoc
ea_extra
          , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> WhenMatching -> SDoc
pprWhenMatching SolverReportErrCtxt
ctxt) Maybe WhenMatching
mb_match_txt
          , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty SameOccInfo -> SDoc
pprSameOccInfo Maybe SameOccInfo
same_occ_info ]
  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)
      = forall doc. IsLine doc => String -> doc
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
        forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
herald1 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty1)
            , Int -> SDoc -> SDoc
nest Int
padding forall a b. (a -> b) -> a -> b
$
              forall doc. IsLine doc => String -> doc
text String
herald2 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
ty2) ]

      | Bool
otherwise
      = -- Print with vertical layout
        forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
herald1 forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
ty1
             , Int -> SDoc -> SDoc
nest Int
padding forall a b. (a -> b) -> a -> b
$
               forall doc. IsLine doc => String -> doc
text String
herald2 forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon forall doc. IsLine doc => doc -> doc -> doc
<+> 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
want_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
want_ea then (String
"actual " forall a. [a] -> [a] -> [a]
++ String
what) else String
"" ]

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

    (Bool
want_ea, SDoc
ea_extra)
      = case MismatchEA
ea of
         MismatchEA
NoEA        -> (Bool
False, forall doc. IsOutput doc => doc
empty)
         EA Maybe ExpectedActualInfo
mb_extra -> (Bool
True , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) Maybe ExpectedActualInfo
mb_extra)
    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) forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel)

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

pprMismatchMsg SolverReportErrCtxt
ctxt
  (TypeEqMismatch { teq_mismatch_ppr_explicit_kinds :: MismatchMsg -> Bool
teq_mismatch_ppr_explicit_kinds = Bool
ppr_explicit_kinds
                  , teq_mismatch_item :: MismatchMsg -> ErrorItem
teq_mismatch_item     = ErrorItem
item
                  , teq_mismatch_ty1 :: MismatchMsg -> Type
teq_mismatch_ty1      = Type
ty1   -- These types are the actual types
                  , teq_mismatch_ty2 :: MismatchMsg -> Type
teq_mismatch_ty2      = Type
ty2   --   that don't match; may be swapped
                  , teq_mismatch_expected :: MismatchMsg -> Type
teq_mismatch_expected = Type
exp   -- These are the context of
                  , teq_mismatch_actual :: MismatchMsg -> Type
teq_mismatch_actual   = Type
act   --   the mis-match
                  , teq_mismatch_what :: MismatchMsg -> Maybe TypedThing
teq_mismatch_what     = Maybe TypedThing
mb_thing
                  , teq_mb_same_occ :: MismatchMsg -> Maybe SameOccInfo
teq_mb_same_occ       = Maybe SameOccInfo
mb_same_occ })
  = CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
ppr_explicit_kinds SDoc
msg
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty SameOccInfo -> SDoc
pprSameOccInfo Maybe SameOccInfo
mb_same_occ
  where
    msg :: SDoc
msg | Just (TypeOrConstraint
torc, Type
rep) <- Type -> Maybe (TypeOrConstraint, Type)
sORTKind_maybe Type
exp
        = TypeOrConstraint -> Type -> SDoc
msg_for_exp_sort TypeOrConstraint
torc Type
rep

        | Just SDoc
nargs_msg <- Maybe SDoc
num_args_msg
        , Right MismatchMsg
ea_msg <- SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt (forall a. a -> Maybe a
Just ErrorItem
item) TypeOrKind
level CtOrigin
orig
        = SDoc
nargs_msg forall doc. IsDoc doc => doc -> doc -> doc
$$ SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
ea_msg

        | Type -> Type -> Type -> Type -> Bool
ea_looks_same Type
ty1 Type
ty2 Type
exp Type
act
        , Right MismatchMsg
ea_msg <- SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt (forall a. a -> Maybe a
Just ErrorItem
item) TypeOrKind
level CtOrigin
orig
        = SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
ea_msg

        | Bool
otherwise
        = SDoc
bale_out_msg

      -- bale_out_msg: the mismatched types are /inside/ exp and act
    bale_out_msg :: SDoc
bale_out_msg = forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
errs
      where
        errs :: [SDoc]
errs = case SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt forall a. Maybe a
Nothing TypeOrKind
level CtOrigin
orig of
                  Left [ExpectedActualInfo]
ea_info -> SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_err
                                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) [ExpectedActualInfo]
ea_info
                  Right MismatchMsg
ea_err -> [ SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_err
                                  , SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
ea_err ]
        mismatch_err :: MismatchMsg
mismatch_err = MismatchEA -> ErrorItem -> Type -> Type -> MismatchMsg
mkBasicMismatchMsg MismatchEA
NoEA ErrorItem
item Type
ty1 Type
ty2

      -- 'expected' is (TYPE rep) or (CONSTRAINT rep)
    msg_for_exp_sort :: TypeOrConstraint -> Type -> SDoc
msg_for_exp_sort TypeOrConstraint
exp_torc Type
exp_rep
      | Just (TypeOrConstraint
act_torc, Type
act_rep) <- Type -> Maybe (TypeOrConstraint, Type)
sORTKind_maybe Type
act
      = -- (TYPE exp_rep) ~ (CONSTRAINT act_rep) etc
        TypeOrConstraint -> Type -> SDoc
msg_torc_torc TypeOrConstraint
act_torc Type
act_rep
      | Bool
otherwise
      = -- (TYPE _) ~ Bool, etc
        SDoc
maybe_num_args_msg forall doc. IsDoc doc => doc -> doc -> doc
$$
        forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"Expected a" forall doc. IsLine doc => doc -> doc -> doc
<+> forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
            , forall doc. IsLine doc => String -> doc
text String
"but" forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                Maybe TypedThing
Nothing    -> forall doc. IsLine doc => String -> doc
text String
"found something with kind"
                Just TypedThing
thing -> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"has kind"
            , SDoc -> SDoc
quotes (Type -> SDoc
pprWithTYPE Type
act) ]

      where
        msg_torc_torc :: TypeOrConstraint -> Type -> SDoc
msg_torc_torc TypeOrConstraint
act_torc Type
act_rep
          | TypeOrConstraint
exp_torc forall a. Eq a => a -> a -> Bool
== TypeOrConstraint
act_torc
          = TypeOrConstraint -> Type -> SDoc
msg_same_torc TypeOrConstraint
act_torc Type
act_rep
          | Bool
otherwise
          = forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"Expected a" forall doc. IsLine doc => doc -> doc -> doc
<+> forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
                , forall doc. IsLine doc => String -> doc
text String
"but" forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                     Maybe TypedThing
Nothing    -> forall doc. IsLine doc => String -> doc
text String
"found a"
                     Just TypedThing
thing -> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is a"
                  forall doc. IsLine doc => doc -> doc -> doc
<+> forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
act_torc ]

        msg_same_torc :: TypeOrConstraint -> Type -> SDoc
msg_same_torc TypeOrConstraint
act_torc Type
act_rep
          | Just SDoc
exp_doc <- Type -> Maybe SDoc
describe_rep Type
exp_rep
          , Just SDoc
act_doc <- Type -> Maybe SDoc
describe_rep Type
act_rep
          = forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"Expected" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
exp_doc forall doc. IsLine doc => doc -> doc -> doc
<+> forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma
                , forall doc. IsLine doc => String -> doc
text String
"but" forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                     Just TypedThing
thing -> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is"
                     Maybe TypedThing
Nothing    -> forall doc. IsLine doc => String -> doc
text String
"got"
                  forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
act_doc forall doc. IsLine doc => doc -> doc -> doc
<+> forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
act_torc ]
        msg_same_torc TypeOrConstraint
_ Type
_ = SDoc
bale_out_msg

    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 forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel

    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 forall a. Num a => a -> a -> a
- Int
n_exp of
             Int
n | Int
n 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
               -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (Int -> TypedThing -> TcSolverReportMsg
ExpectingMoreArguments Int
n TypedThing
thing)
             Int
_ -> forall a. Maybe a
Nothing

      TypeOrKind
_ -> forall a. Maybe a
Nothing

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

    count_args :: Type -> Int
count_args Type
ty = forall a. (a -> Bool) -> [a] -> Int
count PiTyBinder -> Bool
isVisiblePiTyBinder forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Type -> ([PiTyBinder], Type)
splitPiTys Type
ty

    ppr_torc :: TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
TypeLike       = forall doc. IsLine doc => String -> doc
text String
"type";
    ppr_torc TypeOrConstraint
ConstraintLike = forall doc. IsLine doc => String -> doc
text String
"constraint"

    describe_rep :: RuntimeRepType -> Maybe SDoc
    -- describe_rep IntRep            = Just "an IntRep"
    -- describe_rep (BoxedRep Lifted) = Just "a lifted"
    --   etc
    describe_rep :: Type -> Maybe SDoc
describe_rep Type
rep
      | Just (TyCon
rr_tc, [Type]
rr_args) <- Type -> Maybe (TyCon, [Type])
splitRuntimeRep_maybe Type
rep
      = case [Type]
rr_args of
          [Type
lev_ty] | TyCon
rr_tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
boxedRepDataConKey
                   , Just Levity
lev <- Type -> Maybe Levity
levityType_maybe Type
lev_ty
                -> case Levity
lev of
                      Levity
Lifted   -> forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"a lifted")
                      Levity
Unlifted -> forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"a boxed unlifted")
          [] | TyCon
rr_tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
tupleRepDataConTyConKey -> forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"a zero-bit")
             | String -> Bool
starts_with_vowel String
rr_occ -> forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"an" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
rr_occ)
             | Bool
otherwise                -> forall a. a -> Maybe a
Just (forall doc. IsLine doc => String -> doc
text String
"a"  forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
rr_occ)
             where
               rr_occ :: String
rr_occ = OccName -> String
occNameString (forall a. NamedThing a => a -> OccName
getOccName TyCon
rr_tc)

          [Type]
_ -> forall a. Maybe a
Nothing -- Must be TupleRep [r1..rn]
      | Bool
otherwise = forall a. Maybe a
Nothing

    starts_with_vowel :: String -> Bool
starts_with_vowel (Char
c:String
_) = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"AEIOU"
    starts_with_vowel []    = Bool
False

pprMismatchMsg SolverReportErrCtxt
ctxt (CouldNotDeduce [Implication]
useful_givens (ErrorItem
item :| [ErrorItem]
others) Maybe CND_Extra
mb_extra)
  = SDoc
main_msg forall doc. IsDoc doc => doc -> doc -> doc
$$
     case Either [ExpectedActualInfo] MismatchMsg
supplementary of
      Left [ExpectedActualInfo]
infos
        -> forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) [ExpectedActualInfo]
infos)
      Right MismatchMsg
other_msg
        -> SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
other_msg
  where
    main_msg :: SDoc
main_msg
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens
      = CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc
no_instance_msg forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
missing)
      | Bool
otherwise
      = forall doc. IsDoc doc => [doc] -> doc
vcat (CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc
no_deduce_msg forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
missing)
              forall a. a -> [a] -> [a]
: [Implication] -> [SDoc]
pp_givens [Implication]
useful_givens)

    supplementary :: Either [ExpectedActualInfo] MismatchMsg
supplementary = case Maybe CND_Extra
mb_extra of
      Maybe CND_Extra
Nothing
        -> forall a b. a -> Either a b
Left []
      Just (CND_Extra TypeOrKind
level Type
ty1 Type
ty2)
        -> SolverReportErrCtxt
-> TypeOrKind
-> Type
-> Type
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_supplementary_ea_msg SolverReportErrCtxt
ctxt TypeOrKind
level Type
ty1 Type
ty2 CtOrigin
orig
    ct_loc :: CtLoc
ct_loc = ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item
    orig :: CtOrigin
orig   = CtLoc -> CtOrigin
ctLocOrigin CtLoc
ct_loc
    wanteds :: [Type]
wanteds = forall a b. (a -> b) -> [a] -> [b]
map ErrorItem -> Type
errorItemPred (ErrorItem
itemforall a. a -> [a] -> [a]
:[ErrorItem]
others)

    no_instance_msg :: SDoc
no_instance_msg =
      case [Type]
wanteds of
        [Type
wanted] | Just (TyCon
tc, [Type]
_) <- HasDebugCallStack => 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 -> forall doc. IsLine doc => String -> doc
text String
"No instance for"
        [Type]
_ -> forall doc. IsLine doc => String -> doc
text String
"Could not solve:"

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

    missing :: SDoc
missing =
      case [Type]
wanteds of
        [Type
wanted] -> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Type
wanted)
        [Type]
_        -> [Type] -> SDoc
pprTheta [Type]
wanteds



{- *********************************************************************
*                                                                      *
                 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 :: [ClsInst]
matches :: PotentialInstances -> [ClsInst]
matches, [ClsInst]
unifiers :: [ClsInst]
unifiers :: PotentialInstances -> [ClsInst]
unifiers }) =
  forall doc. IsDoc doc => [doc] -> doc
vcat
    [ forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
matches) forall a b. (a -> b) -> a -> b
$
       forall doc. IsLine doc => String -> doc
text String
"Matching instance" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [ClsInst]
matches forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon forall doc. IsDoc doc => doc -> doc -> doc
$$
         Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
ppr_inst [ClsInst]
matches))
    , forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) forall a b. (a -> b) -> a -> b
$
        (forall doc. IsLine doc => String -> doc
text String
"Potentially matching instance" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [ClsInst]
unifiers forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon) forall doc. IsDoc doc => doc -> doc -> doc
$$
         Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (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 =
  forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintPotentialInstances forall a b. (a -> b) -> a -> b
$ \Bool
print_insts ->
  (PprStyle -> SDoc) -> SDoc
getPprStyle 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 :: [ClsInst]
matches :: PotentialInstances -> [ClsInst]
matches, [ClsInst]
unifiers :: [ClsInst]
unifiers :: PotentialInstances -> [ClsInst]
unifiers })
  Bool
show_all_potentials PprStyle
sty
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
matches Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers
  = forall doc. IsOutput doc => doc
empty

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

  | Bool
otherwise
  = forall doc. IsDoc doc => [doc] -> doc
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 forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => [doc] -> doc
vcat
           [ forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Int
n_in_scope_hidden forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
             forall doc. IsLine doc => String -> doc
text String
"...plus"
               forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
speakNOf Int
n_in_scope_hidden (forall doc. IsLine doc => String -> doc
text String
"other")
           , forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Int
not_in_scopes forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
              SDoc -> SDoc
not_in_scope_msg (forall doc. IsLine doc => String -> doc
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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ClsInst -> Bool
inst_in_scope [ClsInst]
matches
    ([ClsInst]
in_scope_unifiers, [ClsInst]
not_in_scope_unifiers) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ClsInst -> Bool
inst_in_scope [ClsInst]
unifiers
    sorted_matches :: [ClsInst]
sorted_matches = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ClsInst -> ClsInst -> Ordering
fuzzyClsInstCmp [ClsInst]
in_scope_matches
    sorted_unifiers :: [ClsInst]
sorted_unifiers = 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           = (forall a. Int -> [a] -> [a]
take Int
n_show_matches  [ClsInst]
sorted_matches
                               ,forall a. Int -> [a] -> [a]
take Int
n_show_unifiers [ClsInst]
sorted_unifiers)
    n_in_scope_hidden :: Int
n_in_scope_hidden
      = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
sorted_matches forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
sorted_unifiers
      forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
show_these_matches forall a. Num a => a -> a -> a
- 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 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
not_in_scope_matches forall a. Num a => a -> a -> a
+ 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 forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
speakNOf Int
not_in_scopes (forall doc. IsLine doc => String -> doc
text String
"instance")
                     forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"involving out-of-scope types")
           Int
2 (forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
show_all_potentials 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 = forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Bool
show_all_potentials
                         Bool -> Bool -> Bool
|| (forall a b. [a] -> [b] -> Bool
equalLength [ClsInst]
show_these_matches [ClsInst]
matches
                             Bool -> Bool -> Bool
&& forall a b. [a] -> [b] -> Bool
equalLength [ClsInst]
show_these_unifiers [ClsInst]
unifiers)) forall a b. (a -> b) -> a -> b
$
                forall doc. IsLine doc => String -> doc
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 forall doc. IsDoc doc => doc -> doc -> doc
$$ (ClsInst, ClsInst) -> SDoc
ppr_overlapping (ClsInst, ClsInst)
overlap
  | Bool
otherwise
  = forall doc. IsOutput doc => doc
empty
    where
      overlap_header :: SDoc
      overlap_header :: SDoc
overlap_header
        | [(ClsInst, ClsInst)
_] <- [(ClsInst, ClsInst)]
overlapping_but_not_more_specific
        = forall doc. IsLine doc => String -> doc
text String
"An overlapping instance can only be chosen when it is strictly more specific."
        | Bool
otherwise
        = forall doc. IsLine doc => String -> doc
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
        = forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ClsInst -> TcTyVar
is_dfun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))
          [ (ClsInst
overlapper, ClsInst
overlappee)
          | [ClsInst]
these <- forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> 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 <- 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 forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
one)
                  Bool -> Bool -> Bool
|| OverlapMode -> Bool
hasOverlappableFlag (OverlapFlag -> OverlapMode
overlapMode forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
other)
                  = [(ClsInst
one, ClsInst
other)]
                  | OverlapMode -> Bool
hasOverlappingFlag (OverlapFlag -> OverlapMode
overlapMode forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
other)
                  Bool -> Bool -> Bool
|| OverlapMode -> Bool
hasOverlappableFlag (OverlapFlag -> OverlapMode
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
        = forall a. Maybe a -> Bool
isJust ([Type] -> [Type] -> Maybe Subst
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)
        = forall doc. IsLine doc => String -> doc
text String
"The first instance that follows overlaps the second, but is not more specific than it:"
        forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ 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 additional solver report information
*                                                                      *
**********************************************************************-}

-- | Pretty-print an informational message, to accompany a 'TcSolverReportMsg'.
pprExpectedActualInfo :: SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo :: SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
_ (ExpectedActual { ea_expected :: ExpectedActualInfo -> Type
ea_expected = Type
exp, ea_actual :: ExpectedActualInfo -> Type
ea_actual = Type
act }) =
  forall doc. IsDoc doc => [doc] -> doc
vcat
    [ forall doc. IsLine doc => String -> doc
text String
"Expected:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
exp
    , forall doc. IsLine doc => String -> doc
text String
"  Actual:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
act ]
pprExpectedActualInfo SolverReportErrCtxt
_
  (ExpectedActualAfterTySynExpansion
    { ea_expanded_expected :: ExpectedActualInfo -> Type
ea_expanded_expected = Type
exp
    , ea_expanded_actual :: ExpectedActualInfo -> Type
ea_expanded_actual   = Type
act } )
  = forall doc. IsDoc doc => [doc] -> doc
vcat
      [ forall doc. IsLine doc => String -> doc
text String
"Type synonyms expanded:"
      , forall doc. IsLine doc => String -> doc
text String
"Expected type:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
exp
      , forall doc. IsLine doc => String -> doc
text String
"  Actual type:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Type
act ]

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

pprWhenMatching :: SolverReportErrCtxt -> WhenMatching -> SDoc
pprWhenMatching :: SolverReportErrCtxt -> WhenMatching -> SDoc
pprWhenMatching SolverReportErrCtxt
ctxt (WhenMatching Type
cty1 Type
cty2 CtOrigin
sub_o Maybe TypeOrKind
mb_sub_t_or_k) =
  forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions 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 forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"When matching" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
sub_whats)
                      Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat [ forall a. Outputable a => a -> SDoc
ppr Type
cty1 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+>
                               forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
typeKind Type
cty1)
                             , forall a. Outputable a => a -> SDoc
ppr Type
cty2 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+>
                               forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
typeKind Type
cty2) ])
                , SDoc
supplementary ]
      else forall doc. IsLine doc => String -> doc
text String
"When matching the kind of" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (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 forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel
    sub_whats :: SDoc
sub_whats  = forall doc. IsLine doc => String -> doc
text (TypeOrKind -> String
levelString TypeOrKind
sub_t_or_k) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
's'
    supplementary :: SDoc
supplementary =
      case SolverReportErrCtxt
-> TypeOrKind
-> Type
-> Type
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_supplementary_ea_msg SolverReportErrCtxt
ctxt TypeOrKind
sub_t_or_k Type
cty1 Type
cty2 CtOrigin
sub_o of
        Left [ExpectedActualInfo]
infos -> forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) [ExpectedActualInfo]
infos
        Right MismatchMsg
msg  -> SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
msg

pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt (TyVarInfo { thisTyVar :: TyVarInfo -> TcTyVar
thisTyVar = TcTyVar
tv1, otherTy :: TyVarInfo -> Maybe TcTyVar
otherTy = Maybe TcTyVar
mb_tv2 }) =
  TcTyVar -> SDoc
mk_msg TcTyVar
tv1 forall doc. IsDoc doc => doc -> doc -> doc
$$ case Maybe TcTyVar
mb_tv2 of { Maybe TcTyVar
Nothing -> forall doc. IsOutput doc => doc
empty; Just TcTyVar
tv2 -> TcTyVar -> SDoc
mk_msg TcTyVar
tv2 }
  where
    mk_msg :: TcTyVar -> SDoc
mk_msg 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 (forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is an interactive-debugger skolem"
      MetaTv {}     -> forall doc. IsOutput doc => doc
empty

pprAmbiguityInfo :: AmbiguityInfo -> SDoc
pprAmbiguityInfo :: AmbiguityInfo -> SDoc
pprAmbiguityInfo (Ambiguity Bool
prepend_msg ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs)) = SDoc
msg
  where

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

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

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

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

      | Bool
otherwise -- "The type variable 't0' is ambiguous"
      = forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"variable" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [TcTyVar]
tkvs
        forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
tkvs forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. [a] -> SDoc
isOrAre [TcTyVar]
tkvs forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"ambiguous"
pprAmbiguityInfo (NonInjectiveTyFam TyCon
tc) =
  forall doc. IsLine doc => String -> doc
text String
"NB:" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
  forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is a non-injective type family"

pprSameOccInfo :: SameOccInfo -> SDoc
pprSameOccInfo :: SameOccInfo -> SDoc
pprSameOccInfo (SameOcc Bool
same_pkg Name
n1 Name
n2) =
  forall doc. IsLine doc => String -> doc
text String
"NB:" forall doc. IsLine doc => doc -> doc -> doc
<+> (Bool -> Name -> SDoc
ppr_from Bool
same_pkg Name
n1 forall doc. IsDoc doc => doc -> doc -> doc
$$ 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 (forall a. Outputable a => a -> SDoc
ppr Name
nm) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is defined at")
           Int
2 (forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc)
      | Bool
otherwise  -- Imported things have an UnhelpfulSrcSpan
      = SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
nm))
           Int
2 (forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"is defined in" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (forall unit. GenModule unit -> ModuleName
moduleName Module
mod))
                  , forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Bool
same_pkg Bool -> Bool -> Bool
|| Unit
pkg forall a. Eq a => a -> a -> Bool
== Unit
mainUnit) forall a b. (a -> b) -> a -> b
$
                    Int -> SDoc -> SDoc
nest Int
4 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"in package" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Unit
pkg) ])
      where
        pkg :: Unit
pkg = forall unit. GenModule unit -> unit
moduleUnit Module
mod
        mod :: Module
mod = HasDebugCallStack => Name -> Module
nameModule Name
nm
        loc :: SrcSpan
loc = Name -> SrcSpan
nameSrcSpan Name
nm

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

pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
pprHoleError SolverReportErrCtxt
_ (Hole { Type
hole_ty :: Hole -> Type
hole_ty :: Type
hole_ty, hole_occ :: Hole -> RdrName
hole_occ = RdrName
rdr }) (OutOfScopeHole [ImportError]
imp_errs)
  = SDoc
out_of_scope_msg forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs)
  where
    herald :: SDoc
herald | OccName -> Bool
isDataOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr) = forall doc. IsLine doc => String -> doc
text String
"Data constructor not in scope:"
           | Bool
otherwise     = forall doc. IsLine doc => String -> doc
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 (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
      | Bool
otherwise   = SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 (RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
rdr Type
hole_ty)
    boring_type :: Bool
boring_type = Type -> Bool
isTyVarTy Type
hole_ty
pprHoleError SolverReportErrCtxt
ctxt (Hole { Type
hole_ty :: Type
hole_ty :: Hole -> Type
hole_ty, RdrName
hole_occ :: RdrName
hole_occ :: Hole -> RdrName
hole_occ}) (HoleError HoleSort
sort [TcTyVar]
other_tvs [(SkolemInfoAnon, [TcTyVar])]
hole_skol_info) =
  forall doc. IsDoc doc => [doc] -> doc
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 (forall doc. IsLine doc => String -> doc
text String
"Found hole:")
          Int
2 (RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
hole_occ Type
hole_ty)
      HoleSort
TypeHole ->
        SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Found type wildcard" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
hole_occ))
          Int
2 (forall doc. IsLine doc => String -> doc
text String
"standing for" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_hole_type_with_kind)
      HoleSort
ConstraintHole ->
        SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Found extra-constraints wildcard standing for")
          Int
2 (SDoc -> SDoc
quotes forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprType Type
hole_ty)  -- always kind constraint

    hole_kind :: Type
hole_kind = HasDebugCallStack => Type -> Type
typeKind 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 forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprKind Type
hole_kind

    tyvars :: [TcTyVar]
tyvars = Type -> [TcTyVar]
tyCoVarsOfTypeList Type
hole_ty
    tyvars_msg :: SDoc
tyvars_msg = forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
tyvars) forall a b. (a -> b) -> a -> b
$
                 forall doc. IsLine doc => String -> doc
text String
"Where:" forall doc. IsLine doc => doc -> doc -> doc
<+> (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map TcTyVar -> SDoc
loc_msg [TcTyVar]
other_tvs)
                                    forall doc. IsDoc doc => doc -> doc -> doc
$$ 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
         | CLabelString -> Int
lengthFS (OccName -> CLabelString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
hole_occ)) forall a. Ord a => a -> a -> Bool
> Int
1  -- Don't give this hint for plain "_"
         = forall doc. IsLine doc => String -> doc
text String
"Or perhaps" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
hole_occ)
           forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is mis-spelled, or not in scope"
         | Bool
otherwise
         = forall doc. IsOutput doc => doc
empty

    type_hole_hint :: SDoc
type_hole_hint
         | DiagnosticReason
ErrorWithoutFlag <- SolverReportErrCtxt -> DiagnosticReason
cec_type_holes SolverReportErrCtxt
ctxt
         = forall doc. IsLine doc => String -> doc
text String
"To use the inferred type, enable PartialTypeSignatures"
         | Bool
otherwise
         = forall doc. IsOutput doc => doc
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 (forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is an ambiguous type variable"
           TcTyVarDetails
_         -> forall doc. IsOutput doc => doc
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 forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is a coercion variable"

pp_rdr_with_type :: RdrName -> Type -> SDoc
pp_rdr_with_type :: RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
occ Type
hole_ty = SDoc -> Int -> SDoc -> SDoc
hang (forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc RdrName
occ) Int
2 (SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> 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 (forall doc. IsLine doc => String -> doc
text String
"Not in scope:")
        Int
2 (SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name))
    NoExactName Name
name ->
      forall doc. IsLine doc => String -> doc
text String
"The Name" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not in scope."
    SameName [GlobalRdrElt]
gres ->
      forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall (t :: * -> *) a. Foldable t => t a -> Int
length [GlobalRdrElt]
gres forall a. Ord a => a -> a -> Bool
>= Int
2) (forall doc. IsLine doc => String -> doc
text String
"pprScopeError SameName: fewer than 2 elements" forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
gres))
      forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"Same Name in multiple name-spaces:")
           Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
pp_one [Name]
sorted_names))
      where
        sorted_names :: [Name]
sorted_names = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
nameSrcSpan) (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 (forall a. NamedThing a => a -> OccName
getOccName Name
name))
                  forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Name
name) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma)
               Int
2 (forall doc. IsLine doc => String -> doc
text String
"declared at:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
name))
    MissingBinding SDoc
thing [GhcHint]
_ ->
      forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"The" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
thing
               forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"for" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
          , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"lacks an accompanying binding" ]
    NotInScopeError
NoTopLevelBinding ->
      SDoc -> Int -> SDoc -> SDoc
hang (forall doc. IsLine doc => String -> doc
text String
"No top-level binding for")
        Int
2 (SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"in this module")
    UnknownSubordinate SDoc
doc ->
      SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not a (visible)" forall doc. IsLine doc => doc -> doc -> doc
<+> 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) =
    forall doc. IsLine doc => [doc] -> doc
hsep
      [ forall doc. IsLine doc => String -> doc
text String
"NB: no module named"
      , SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
      , forall doc. IsLine doc => String -> doc
text String
"is imported."
      ]
  ppr  (ModulesDoNotExport NonEmpty Module
mods OccName
occ_name)
    | Module
mod NE.:| [] <- NonEmpty Module
mods
    = forall doc. IsLine doc => [doc] -> doc
hsep
        [ forall doc. IsLine doc => String -> doc
text String
"NB: the module"
        , SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Module
mod)
        , forall doc. IsLine doc => String -> doc
text String
"does not export"
        , SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr OccName
occ_name) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot ]
    | Bool
otherwise
    = forall doc. IsLine doc => [doc] -> doc
hsep
        [ forall doc. IsLine doc => String -> doc
text String
"NB: neither"
        , [SDoc] -> SDoc
quotedListWithNor (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty Module
mods)
        , forall doc. IsLine doc => String -> doc
text String
"export"
        , SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr OccName
occ_name) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot ]

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

-- TODO: these functions should use GhcHint instead.

show_fixes :: [SDoc] -> SDoc
show_fixes :: [SDoc] -> SDoc
show_fixes []     = forall doc. IsOutput doc => doc
empty
show_fixes (SDoc
f:[SDoc]
fs) = forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"Possible fix:"
                        , Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc
f forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall doc. IsLine doc => String -> doc
text String
"or" forall doc. IsLine doc => doc -> doc -> doc
<+>) [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   -- Don't suggest adding (Eq T) to the context, say
  , (SkolemInfoAnon
skol:[SkolemInfoAnon]
skols) <- [Implication] -> Type -> [SkolemInfoAnon]
usefulContext [Implication]
implics Type
pred
  , let what :: SDoc
what | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SkolemInfoAnon]
skols
             , SigSkol (PatSynCtxt {}) Type
_ [(Name, TcTyVar)]
_ <- SkolemInfoAnon
skol
             = forall doc. IsLine doc => String -> doc
text String
"\"required\""
             | Bool
otherwise
             = forall doc. IsOutput doc => doc
empty
  = [forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"add" forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
pred
           forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"to the" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"context of"
         , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ SkolemInfoAnon -> SDoc
ppr_skol SkolemInfoAnon
skol forall doc. IsDoc doc => doc -> doc -> doc
$$
                    forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"or" forall doc. IsLine doc => doc -> doc -> doc
<+> 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
_) = forall doc. IsLine doc => String -> doc
text String
"the data constructor" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr DataCon
dc)
    ppr_skol (PatSkol (PatSynCon PatSyn
ps)   HsMatchContext GhcTc
_) = forall doc. IsLine doc => String -> doc
text String
"the pattern synonym"  forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr PatSyn
ps)
    ppr_skol SkolemInfoAnon
skol_info = 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 forall a. a -> [a] -> [a]
: [SkolemInfoAnon]
rest
       where
          -- Stop when the context binds a variable free in the predicate
          rest :: [SkolemInfoAnon]
rest | 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
      | 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 (forall doc. IsLine doc => String -> doc
text String
"from the context:") Implication
g
                 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> Implication -> SDoc
ppr_given (forall doc. IsLine doc => String -> doc
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 forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
pprEvVarTheta (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 (forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"bound by" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                       , forall doc. IsLine doc => String -> doc
text String
"at" forall doc. IsLine doc => doc -> doc -> doc
<+> 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 :: CtLoc -> SDoc
-- Used for the main, top-level error message
-- We've done special processing for TypeEq, KindEq, givens
pprArising :: CtLoc -> SDoc
pprArising CtLoc
ct_loc
  | Bool
in_generated_code = forall doc. IsOutput doc => doc
empty  -- See Note ["Arising from" messages in generated code]
  | Bool
suppress_origin   = forall doc. IsOutput doc => doc
empty
  | Bool
otherwise         = CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig
  where
    orig :: CtOrigin
orig = CtLoc -> CtOrigin
ctLocOrigin CtLoc
ct_loc
    in_generated_code :: Bool
in_generated_code = TcLclEnv -> Bool
lclEnvInGeneratedCode (CtLoc -> TcLclEnv
ctLocEnv CtLoc
ct_loc)
    suppress_origin :: Bool
suppress_origin
      | CtOrigin -> Bool
isGivenOrigin CtOrigin
orig = Bool
True
      | Bool
otherwise          = case CtOrigin
orig of
          TypeEqOrigin {}         -> Bool
True -- We've done special processing
          KindEqOrigin {}         -> Bool
True -- for TypeEq, KindEq, givens
          AmbiguityCheckOrigin {} -> Bool
True -- The "In the ambiguity check" context
                                          -- is sufficient; more would be repetitive
          CtOrigin
_ -> Bool
False

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

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 []
  = forall a. HasCallStack => String -> a
panic String
"pprWithArising"
pprWithArising (Ct
ct:[Ct]
cts)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ct]
cts
  = CtLoc -> SDoc -> SDoc
addArising CtLoc
loc ([Type] -> SDoc
pprTheta [Ct -> Type
ctPred Ct
ct])
  | Bool
otherwise
  = forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map Ct -> SDoc
ppr_one (Ct
ctforall 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 (forall doc. IsLine doc => doc -> doc
parens (Type -> SDoc
pprType (Ct -> Type
ctPred Ct
ct')))
                     Int
2 (CtLoc -> SDoc
pprCtLoc (Ct -> CtLoc
ctLoc Ct
ct'))

{- Note ["Arising from" messages in generated code]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider code generated when we desugar code before typechecking;
see Note [Rebindable syntax and HsExpansion].

In this code, constraints may be generated, but we don't want to
say "arising from a call of foo" if 'foo' doesn't appear in the
users code.  We leave the actual CtOrigin untouched (partly because
it is generated in many, many places), but suppress the "Arising from"
message for constraints that originate in generated code.
-}


{- *********************************************************************
*                                                                      *
                           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 (forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a, b) -> f (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' = forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a, b) -> f (a, c)
mapSnd (TidyEnv -> TcTyVar -> TcTyVar
tidyTyCoVarOcc TidyEnv
env) [(Name, TcTyVar)]
tv_prs
    inst_env :: NameEnv TcTyVar
inst_env = forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TcTyVar)]
tv_prs'

    tidy_ty :: TidyEnv -> Type -> Type
tidy_ty TidyEnv
env (ForAllTy (Bndr TcTyVar
tv ForAllTyFlag
vis) Type
ty)
      = VarBndr TcTyVar ForAllTyFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TcTyVar
tv' ForAllTyFlag
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 FunTyFlag
af Type
w Type
arg Type
res) -- Look under  c => t
      | FunTyFlag -> Bool
isInvisibleFunArg FunTyFlag
af
      = 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' <- forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv TcTyVar
inst_env (TcTyVar -> Name
tyVarName TcTyVar
tv)
      = ((TidyOccEnv
occ_env, 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 = forall a b. (a -> b) -> [a] -> [b]
map (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)) forall a. a -> a
id) [(SkolemInfoAnon, [TcTyVar])]
zonked_ty_vars
      in forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (SkolemInfoAnon, [TcTyVar]) -> SDoc
pp_one [(SkolemInfoAnon, [TcTyVar])]
tidy_ty_vars)
  where

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


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

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

skolsSpan :: [TcTyVar] -> SrcSpan
skolsSpan :: [TcTyVar] -> SrcSpan
skolsSpan [TcTyVar]
skol_tvs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (forall a b. (a -> b) -> [a] -> [b]
map 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 [ExpectedActualInfo] MismatchMsg
mk_supplementary_ea_msg :: SolverReportErrCtxt
-> TypeOrKind
-> Type
-> Type
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
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 [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt forall a. Maybe a
Nothing TypeOrKind
level CtOrigin
orig
  | Bool
otherwise
  = 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 [ExpectedActualInfo] MismatchMsg
-- 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 [ExpectedActualInfo] MismatchMsg
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
  = forall a b. b -> Either a b
Right 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  ea :: MismatchEA
ea = Maybe ExpectedActualInfo -> MismatchEA
EA forall a b. (a -> b) -> a -> b
$ if Bool
expanded_syns then forall a. a -> Maybe a
Just ExpectedActualInfo
ea_expanded else forall a. Maybe a
Nothing
         mismatch :: MismatchMsg
mismatch = MismatchEA -> ErrorItem -> Type -> Type -> MismatchMsg
mkBasicMismatchMsg MismatchEA
ea ErrorItem
item Type
exp Type
act
  = forall a b. b -> Either a b
Right MismatchMsg
mismatch
  | Bool
otherwise
  = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
    if Bool
expanded_syns
    then [ExpectedActualInfo
ea,ExpectedActualInfo
ea_expanded]
    else [ExpectedActualInfo
ea]

  where
    ea :: ExpectedActualInfo
ea = ExpectedActual { ea_expected :: Type
ea_expected = Type
exp, ea_actual :: Type
ea_actual = Type
act }
    ea_expanded :: ExpectedActualInfo
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
_ = 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 forall a. Eq a => a -> a -> Bool
== TyCon
tc2
      , [Type]
tys1 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') =
              forall a b. [(a, b)] -> ([a], [b])
unzip (forall a b c.
HasDebugCallStack =>
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 FunTyFlag
_ Type
w1 Type
t1_1 Type
t1_2) ty2 :: Type
ty2@(FunTy FunTyFlag
_ 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 ForAllTyFlag
b1 Type
t1) (ForAllTy VarBndr TcTyVar ForAllTyFlag
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 ForAllTyFlag -> Type -> Type
ForAllTy VarBndr TcTyVar ForAllTyFlag
b1 Type
t1', VarBndr TcTyVar ForAllTyFlag -> Type -> Type
ForAllTy VarBndr TcTyVar ForAllTyFlag
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 forall a. a -> [a] -> [a]
: Type -> [Type]
tyExpansions Type
t1
        t2_exp_tys :: [Type]
t2_exp_tys = Type
t2 forall a. a -> [a] -> [a]
: Type -> [Type]
tyExpansions Type
t2
        t1_exps :: Int
t1_exps    = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
t1_exp_tys
        t2_exps :: Int
t2_exps    = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
t2_exp_tys
        dif :: Int
dif        = forall a. Num a => a -> a
abs (Int
t1_exps forall a. Num a => a -> a -> a
- Int
t2_exps)
      in
        [(Type, Type)] -> (Type, Type)
followExpansions forall a b. (a -> b) -> a -> b
$
          forall a b. HasDebugCallStack => String -> [a] -> [b] -> [(a, b)]
zipEqual String
"expandSynonymsToMatch.go"
            (if Int
t1_exps forall a. Ord a => a -> a -> Bool
> Int
t2_exps then forall a. Int -> [a] -> [a]
drop Int
dif [Type]
t1_exp_tys else [Type]
t1_exp_tys)
            (if Int
t2_exps forall a. Ord a => a -> a -> Bool
> Int
t1_exps then 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 = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\Type
t -> (\Type
x -> (Type
x, Type
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Type -> Maybe Type
coreView 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 [] = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"followExpansions" forall doc. IsOutput doc => doc
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 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}
*                                                                      *
************************************************************************
-}

inHsDocContext :: HsDocContext -> SDoc
inHsDocContext :: HsDocContext -> SDoc
inHsDocContext HsDocContext
ctxt = forall doc. IsLine doc => String -> doc
text String
"In" forall doc. IsLine doc => doc -> doc -> doc
<+> HsDocContext -> SDoc
pprHsDocContext HsDocContext
ctxt

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

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

pprConversionFailReason :: ConversionFailReason -> SDoc
pprConversionFailReason :: ConversionFailReason -> SDoc
pprConversionFailReason = \case
  IllegalOccName NameSpace
ctxt_ns String
occ ->
    forall doc. IsLine doc => String -> doc
text String
"Illegal" forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNameSpace NameSpace
ctxt_ns
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"name:" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text String
occ)
  SumAltArityExceeded Int
alt Int
arity ->
    forall doc. IsLine doc => String -> doc
text String
"Sum alternative" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Int -> doc
int Int
alt
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"exceeds its arity," forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Int -> doc
int Int
arity
  IllegalSumAlt Int
alt ->
    forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Illegal sum alternative:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Int -> doc
int Int
alt
         , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Sum alternatives must start from 1" ]
  IllegalSumArity Int
arity ->
    forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Illegal sum arity:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Int -> doc
int Int
arity
         , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"Sums must have an arity of at least 2" ]
  MalformedType TypeOrKind
typeOrKind Type
ty ->
    forall doc. IsLine doc => String -> doc
text String
"Malformed " forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
ty_str forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show Type
ty)
    where ty_str :: String
ty_str = case TypeOrKind
typeOrKind of
                     TypeOrKind
TypeLevel -> String
"type"
                     TypeOrKind
KindLevel -> String
"kind"
  IllegalLastStatement HsDoFlavour
do_or_lc LStmt GhcPs (LHsExpr GhcPs)
stmt ->
    forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"Illegal last statement of" forall doc. IsLine doc => doc -> doc -> doc
<+> HsDoFlavour -> SDoc
pprAHsDoFlavour HsDoFlavour
do_or_lc forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
         , Int -> SDoc -> SDoc
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr LStmt GhcPs (LHsExpr GhcPs)
stmt
         , forall doc. IsLine doc => String -> doc
text String
"(It should be an expression.)" ]
  ConversionFailReason
KindSigsOnlyAllowedOnGADTs ->
    forall doc. IsLine doc => String -> doc
text String
"Kind signatures are only allowed on GADTs"
  IllegalDeclaration THDeclDescriptor
declDescr IllegalDecls
bad_decls ->
    forall doc. IsLine doc => [doc] -> doc
sep [ forall doc. IsLine doc => String -> doc
text String
"Illegal" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"in" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
descrDoc forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
        , Int -> SDoc -> SDoc
nest Int
2 SDoc
bads ]
    where
      (SDoc
what, SDoc
bads) = case IllegalDecls
bad_decls of
        IllegalDecls (forall a. NonEmpty a -> [a]
NE.toList -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls) ->
            (forall doc. IsLine doc => String -> doc
text String
"declaration" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls, forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls)
        IllegalFamDecls (forall a. NonEmpty a -> [a]
NE.toList -> [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
decls) ->
            ( forall doc. IsLine doc => String -> doc
text String
"family declaration" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. [a] -> SDoc
plural [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
decls, forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
decls)
      descrDoc :: SDoc
descrDoc = forall doc. IsLine doc => String -> doc
text forall a b. (a -> b) -> a -> b
$ case THDeclDescriptor
declDescr of
                   THDeclDescriptor
InstanceDecl -> String
"an instance declaration"
                   THDeclDescriptor
WhereClause -> String
"a where clause"
                   THDeclDescriptor
LetBinding -> String
"a let expression"
                   THDeclDescriptor
LetExpression -> String
"a let expression"
                   THDeclDescriptor
ClssDecl -> String
"a class declaration"
  ConversionFailReason
CannotMixGADTConsWith98Cons ->
    forall doc. IsLine doc => String -> doc
text String
"Cannot mix GADT constructors with Haskell 98"
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"constructors"
  ConversionFailReason
EmptyStmtListInDoBlock ->
    forall doc. IsLine doc => String -> doc
text String
"Empty stmt list in do-block"
  ConversionFailReason
NonVarInInfixExpr ->
    forall doc. IsLine doc => String -> doc
text String
"Non-variable expression is not allowed in an infix expression"
  ConversionFailReason
MultiWayIfWithoutAlts ->
    forall doc. IsLine doc => String -> doc
text String
"Multi-way if-expression with no alternatives"
  ConversionFailReason
CasesExprWithoutAlts ->
    forall doc. IsLine doc => String -> doc
text String
"\\cases expression with no alternatives"
  ConversionFailReason
ImplicitParamsWithOtherBinds ->
    forall doc. IsLine doc => String -> doc
text String
"Implicit parameters mixed with other bindings"
  InvalidCCallImpent String
from ->
    forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show String
from) forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"is not a valid ccall impent"
  ConversionFailReason
RecGadtNoCons ->
    forall doc. IsLine doc => String -> doc
text String
"RecGadtC must have at least one constructor name"
  ConversionFailReason
GadtNoCons ->
    forall doc. IsLine doc => String -> doc
text String
"GadtC must have at least one constructor name"
  InvalidTypeInstanceHeader Type
tys ->
    forall doc. IsLine doc => String -> doc
text String
"Invalid type instance header:"
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show Type
tys)
  InvalidTyFamInstLHS Type
lhs ->
    forall doc. IsLine doc => String -> doc
text String
"Invalid type family instance LHS:"
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show Type
lhs)
  ConversionFailReason
InvalidImplicitParamBinding ->
    forall doc. IsLine doc => String -> doc
text String
"Implicit parameter binding only allowed in let or where"
  DefaultDataInstDecl [LDataFamInstDecl GhcPs]
adts ->
    (forall doc. IsLine doc => String -> doc
text String
"Default data instance declarations"
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"are not allowed:")
      forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr [LDataFamInstDecl GhcPs]
adts
  FunBindLacksEquations Name
nm ->
    forall doc. IsLine doc => String -> doc
text String
"Function binding for"
    forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall doc. IsLine doc => String -> doc
text (forall a. Ppr a => a -> String
TH.pprint Name
nm))
    forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
"has no equations"