{-# 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(..)
  , pprTyThingUsedWrong
  , pprUntouchableVariable

  -- | Useful when overriding message printing.
  , messageWithInfoDiagnosticMessage
  , messageWithHsDocContext
  )
  where

import GHC.Prelude

import qualified Language.Haskell.TH as TH

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

import GHC.Types.Name.Reader
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Warnings

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 (CoAxBranch, coAxiomTyCon, coAxiomSingleBranch)
import GHC.Core.ConLike
import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst )
import GHC.Core.InstEnv
import GHC.Core.TyCo.Rep (Type(..))
import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen,
                          pprSourceTyCon, pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType)
import GHC.Core.PatSyn ( patSynName, pprPatSynType )
import GHC.Core.Predicate
import GHC.Core.Type
import GHC.Core.FVs( orphNamesOfTypes )
import GHC.CoreToIface

import GHC.Driver.Flags
import GHC.Driver.Backend
import GHC.Hs

import GHC.Tc.Errors.Types
import GHC.Tc.Types.BasicTypes
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Origin
import GHC.Tc.Types.Rank (Rank(..))
import GHC.Tc.Types.TH
import GHC.Tc.Utils.TcType

import GHC.Types.Error
import GHC.Types.Hint
import GHC.Types.Hint.Ppr () -- Outputable GhcHint
import GHC.Types.Basic
import GHC.Types.Error.Codes ( constructorCode )
import GHC.Types.Id
import GHC.Types.Id.Info ( RecSelParent(..) )
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.TyThing.Ppr ( pprTyThingInContext )
import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Fixity (defaultFixity)

import GHC.Iface.Errors.Types
import GHC.Iface.Errors.Ppr
import GHC.Iface.Syntax

import GHC.Unit.State
import GHC.Unit.Module

import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Data.List.SetOps ( nubOrdBy )
import GHC.Data.Maybe
import GHC.Data.Pair
import GHC.Settings.Constants (mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE)
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.Foldable ( fold )
import Data.Function (on)
import Data.List ( groupBy, sortBy, tails
                 , partition, unfoldr )
import Data.Ord ( comparing )
import Data.Bifunctor


defaultTcRnMessageOpts :: TcRnMessageOpts
defaultTcRnMessageOpts :: TcRnMessageOpts
defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: Bool
tcOptsShowContext = Bool
True
                                         , tcOptsIfaceOpts :: IfaceMessageOpts
tcOptsIfaceOpts = forall opts.
HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
DiagnosticOpts opts
defaultDiagnosticOpts @IfaceMessage }

instance HasDefaultDiagnosticOpts TcRnMessageOpts where
  defaultOpts :: TcRnMessageOpts
defaultOpts = TcRnMessageOpts
defaultTcRnMessageOpts

instance Diagnostic TcRnMessage where
  type DiagnosticOpts TcRnMessage = TcRnMessageOpts
  diagnosticMessage :: DiagnosticOpts TcRnMessage -> TcRnMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts TcRnMessage
opts = \case
    TcRnUnknownMessage (UnknownDiagnostic DiagnosticOpts TcRnMessage -> DiagnosticOpts a
f a
m)
      -> DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (DiagnosticOpts TcRnMessage -> DiagnosticOpts a
f DiagnosticOpts TcRnMessage
opts) 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
TcRnMessageOpts
opts)
                  (DiagnosticOpts TcRnMessage -> TcRnMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage DiagnosticOpts TcRnMessage
opts TcRnMessage
msg)
    TcRnWithHsDocContext HsDocContext
ctxt TcRnMessage
msg
      -> TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc
messageWithHsDocContext DiagnosticOpts TcRnMessage
TcRnMessageOpts
opts HsDocContext
ctxt (DiagnosticOpts TcRnMessage -> TcRnMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage DiagnosticOpts TcRnMessage
opts TcRnMessage
msg)
    TcRnSolverReport SolverReportWithCtxt
msg DiagnosticReason
_ [GhcHint]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt SolverReportWithCtxt
msg
    TcRnSolverDepthError Type
ty SubGoalDepth
depth -> SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
msg
      where
        msg :: SDoc
msg =
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reduction stack overflow; size =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SubGoalDepth -> SDoc
forall a. Outputable a => a -> SDoc
ppr SubGoalDepth
depth
               , SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When simplifying the following type:")
                    Arity
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) ]
    TcRnRedundantConstraints [TyVar]
redundants (SkolemInfoAnon
info, Bool
show_info)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Redundant constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
redundants SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
pprEvVarTheta [TyVar]
redundants
         SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ if Bool
show_info then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
info else SDoc
forall doc. IsOutput doc => doc
empty
    TcRnInaccessibleCode Implication
implic SolverReportWithCtxt
contra
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Inaccessible code in")
           Arity
2 (SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Implication -> SkolemInfoAnon
ic_info Implication
implic))
         SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt SolverReportWithCtxt
contra
    TcRnInaccessibleCoAxBranch TyCon
fam_tc CoAxBranch
cur_branch
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type family instance equation is overlapped:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
          Arity -> SDoc -> SDoc
nest Arity
2 (TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser TyCon
fam_tc CoAxBranch
cur_branch)
    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
errInfoContext :: SDoc
errInfoSupplementary :: SDoc
errInfoSupplementary :: ErrInfo -> SDoc
errInfoContext :: ErrInfo -> SDoc
..}
      -> [SDoc] -> DecoratedSDoc
mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           ( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
id_or_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is implicitly lifted in the TH quotation"
           ) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc
errInfoContext, SDoc
errInfoSupplementary]
    TcRnUnusedPatternBinds HsBind (GhcPass 'Renamed)
bind
      -> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This pattern-binding binds no variables:") Arity
2 (HsBind (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBind (GhcPass 'Renamed)
bind)]
    TcRnDodgyImports (DodgyImportsEmptyParent GlobalRdrElt
gre)
      -> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> GlobalRdrElt -> IE (GhcPass 'Renamed) -> SDoc
forall ie. Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc
dodgy_msg (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import") GlobalRdrElt
gre (GlobalRdrElt -> IE (GhcPass 'Renamed)
dodgy_msg_insert GlobalRdrElt
gre)]
    TcRnDodgyImports (DodgyImportsHiding ImportLookupReason
reason)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         ImportLookupReason -> SDoc
pprImportLookup ImportLookupReason
reason
    TcRnDodgyExports GlobalRdrElt
gre
      -> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> GlobalRdrElt -> IE (GhcPass 'Renamed) -> SDoc
forall ie. Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc
dodgy_msg (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"export") GlobalRdrElt
gre (GlobalRdrElt -> IE (GhcPass 'Renamed)
dodgy_msg_insert GlobalRdrElt
gre)]
    TcRnMissingImportList IE GhcPs
ie
      -> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The import item" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have an explicit import list"
                     ]
    TcRnMessage
TcRnUnsafeDueToPlugin
      -> [SDoc] -> DecoratedSDoc
mkDecorated [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Use of plugins makes the module unsafe"]
    TcRnModMissingRealSrcSpan Module
mod
      -> [SDoc] -> DecoratedSDoc
mkDecorated [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module does not have a RealSrcSpan:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod]
    TcRnIdNotExportedFromModuleSig Name
name Module
mod
      -> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The identifier" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not exist in the signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod
                     ]
    TcRnIdNotExportedFromLocalSig Name
name
      -> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The identifier" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                       String -> SDoc
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     -> [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcLoc
n]
               ShadowedNameProvenanceGlobal [GlobalRdrElt]
gres -> (GlobalRdrElt -> SDoc) -> [GlobalRdrElt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> SDoc
forall info. GlobalRdrEltX info -> SDoc
pprNameProvenance [GlobalRdrElt]
gres
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This binding for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"shadows the existing binding" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [SDoc] -> SDoc
forall a. [a] -> SDoc
plural [SDoc]
shadowed_locs,
                   Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
shadowed_locs)]
    TcRnInvalidWarningCategory WarningCategory
cat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Warning category" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (WarningCategory -> SDoc
forall a. Outputable a => a -> SDoc
ppr WarningCategory
cat) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not valid",
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(user-defined category names must begin with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"x-"),
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and contain only letters, numbers, apostrophes and dashes)" ]
    TcRnDuplicateWarningDecls LocatedN RdrName
d RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple warning declarations for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name),
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"also at " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
d)]
    TcRnSimplifierTooManyIterations Cts
simples IntWithInf
limit WantedConstraints
wc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"solveWanteds: too many iterations"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"limit =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IntWithInf -> SDoc
forall a. Outputable a => a -> SDoc
ppr IntWithInf
limit))
                Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unsolved:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WantedConstraints -> SDoc
forall a. Outputable a => a -> SDoc
ppr WantedConstraints
wc
                        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Simples:"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Cts -> SDoc
forall a. Outputable a => a -> SDoc
ppr Cts
simples
                        ])
    TcRnIllegalPatSynDecl LIdP GhcPs
rdrname
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal pattern synonym declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP GhcPs
LocatedN RdrName
rdrname))
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonym declarations are only valid at top level")
    TcRnLinearPatSyn Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms do not support linear fields (GHC #18806):") Arity
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnMessage
TcRnEmptyRecordUpdate
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty record update"
    TcRnIllegalFieldPunning Located RdrName
fld
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal use of punning for field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Located RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located RdrName
fld)
    TcRnIllegalWildcardsInRecord RecordFieldPart
fld_part
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal `..' in record" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RecordFieldPart -> SDoc
pprRecordFieldPart RecordFieldPart
fld_part
    TcRnIllegalWildcardInType Maybe Name
mb_name BadAnonWildcardContext
bad
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ case BadAnonWildcardContext
bad of
          BadAnonWildcardContext
WildcardNotLastInConstraint ->
            SDoc -> Arity -> SDoc -> SDoc
hang SDoc
notAllowed Arity
2 SDoc
constraint_hint_msg
          ExtraConstraintWildcardNotAllowed SoleExtraConstraintWildcardAllowed
allow_sole ->
            case SoleExtraConstraintWildcardAllowed
allow_sole of
              SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardNotAllowed ->
                SDoc
notAllowed
              SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardAllowed ->
                SDoc -> Arity -> SDoc -> SDoc
hang SDoc
notAllowed Arity
2 SDoc
sole_msg
          BadAnonWildcardContext
WildcardsNotAllowedAtAll ->
            SDoc
notAllowed
      where
        notAllowed, what, wildcard, how :: SDoc
        notAllowed :: SDoc
notAllowed = SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
wildcard SDoc -> SDoc -> SDoc
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 -> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
        what :: SDoc
what
          | Just Name
_ <- Maybe Name
mb_name
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Named wildcard"
          | ExtraConstraintWildcardNotAllowed {} <- BadAnonWildcardContext
bad
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Extra-constraint wildcard"
          | Bool
otherwise
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Wildcard"
        how :: SDoc
how = case BadAnonWildcardContext
bad of
          BadAnonWildcardContext
WildcardNotLastInConstraint
            -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not allowed in a constraint"
          BadAnonWildcardContext
_ -> String -> SDoc
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
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Extra-constraint wildcards must be anonymous"
                 , Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"e.g  f :: (Eq a, _) => blah") ]
          | Bool
otherwise
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"except as the last top-level constraint of a type signature"
                 , Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"e.g  f :: (Eq a, _) => blah") ]
        sole_msg :: SDoc
        sole_msg :: SDoc
sole_msg =
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"except as the sole constraint"
               , Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate field name"
                , SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ NonEmpty RdrName -> RdrName
forall a. NonEmpty a -> a
NE.head NonEmpty RdrName
dups))
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in record", RecordFieldPart -> SDoc
pprRecordFieldPart RecordFieldPart
fld_part ]
    TcRnIllegalViewPattern Pat GhcPs
pat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal view pattern: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcPs
pat]
    TcRnCharLiteralOutOfRange Char
c
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"character literal out of range: '\\" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
c  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\''
    TcRnIllegalWildcardsInConstructor Name
con
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal `{..}' notation for constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con)
                , Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record wildcards may not be used for constructors with unlabelled fields.")
                , Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Possible fix: Remove the `{..}' and add a match for each field of the constructor.")
                ]
    TcRnIgnoringAnnotations [LAnnDecl (GhcPass 'Renamed)]
anns
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ignoring ANN annotation" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated SrcSpanAnnA (AnnDecl (GhcPass 'Renamed))] -> SDoc
forall a. [a] -> SDoc
plural [LAnnDecl (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (AnnDecl (GhcPass 'Renamed))]
anns SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Annotations are not compatible with Safe Haskell."
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]
    TcRnInvalidTypeApplication Type
fun_ty LHsWcType (GhcPass 'Renamed)
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot apply expression of type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
fun_ty) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to a visible type argument" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsWcType (GhcPass 'Renamed)
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
hs_ty)
    TcRnMessage
TcRnTagToEnumMissingValArg
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"tagToEnum# must appear applied to one value argument"
    TcRnTagToEnumUnspecifiedResTy Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
              Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Specify the type by giving a type signature"
                      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"e.g. (tagToEnum# x) :: Bool" ])
    TcRnTagToEnumResTyNotAnEnum Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Result type must be an enumeration type")
    TcRnTagToEnumResTyTypeData Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Result type cannot be headed by a `type data` type")
    TcRnMessage
TcRnArrowIfThenElsePredDependsOnResultTy
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Predicate type of `ifThenElse' depends on result type"
    TcRnIllegalHsBootOrSigDecl HsBootOrSig
boot_or_sig BadBootDecls
decls
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
whr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
        where
          what :: SDoc
what = case BadBootDecls
decls of
            BootBindsPs      {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"binding"
            BootBindsRn      {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"binding"
            BootInstanceSigs {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance body"
            BootFamInst      {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"family instance"
            BootSpliceDecls  {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"splice"
            BootForeignDecls {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"foreign declaration"
            BootDefaultDecls {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"default declaration"
            BootRuleDecls    {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RULE pragma"
          whr :: SDoc
whr = case HsBootOrSig
boot_or_sig of
            HsBootOrSig
HsBoot -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an hs-boot file"
            HsBootOrSig
Hsig   -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a backpack signature file"
    TcRnBootMismatch HsBootOrSig
boot_or_sig BootMismatch
err ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ HsBootOrSig -> BootMismatch -> SDoc
pprBootMismatch HsBootOrSig
boot_or_sig BootMismatch
err
    TcRnRecursivePatternSynonym LHsBinds (GhcPass 'Renamed)
binds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Recursive pattern synonym definition with following bindings:")
               Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)) -> SDoc
forall a idR.
CollectPass (GhcPass 'Renamed) =>
GenLocated (SrcSpanAnn' a) (HsBindLR (GhcPass 'Renamed) idR)
-> SDoc
pprLBind ([GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] -> [SDoc])
-> (LHsBinds (GhcPass 'Renamed)
    -> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))])
-> LHsBinds (GhcPass 'Renamed)
-> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBinds (GhcPass 'Renamed)
-> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]
Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]
forall a. Bag a -> [a]
bagToList (LHsBinds (GhcPass 'Renamed) -> [SDoc])
-> LHsBinds (GhcPass 'Renamed) -> [SDoc]
forall a b. (a -> b) -> a -> b
$ LHsBinds (GhcPass 'Renamed)
binds)
          where
            pprLoc :: a -> SDoc
pprLoc a
loc = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"defined at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
loc)
            pprLBind :: CollectPass GhcRn => GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
            pprLBind :: forall a idR.
CollectPass (GhcPass 'Renamed) =>
GenLocated (SrcSpanAnn' a) (HsBindLR (GhcPass 'Renamed) idR)
-> SDoc
pprLBind (L SrcSpanAnn' a
loc HsBindLR (GhcPass 'Renamed) idR
bind) = (Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CollectFlag (GhcPass 'Renamed)
-> HsBindLR (GhcPass 'Renamed) idR -> [IdP (GhcPass 'Renamed)]
forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
collectHsBindBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders HsBindLR (GhcPass 'Renamed) idR
bind)
                                        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
pprLoc (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc)
    TcRnPartialTypeSigTyVarMismatch Name
n1 Name
n2 Name
fn_name LHsSigWcType (GhcPass 'Renamed)
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't match" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n1)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n2))
                Arity
2 (SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"both bound by the partial type signature:")
                        Arity
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType (GhcPass 'Renamed)
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
hs_ty))
    TcRnPartialTypeSigBadQuantifier Name
n Name
fn_name Maybe Type
m_unif_ty LHsSigWcType (GhcPass 'Renamed)
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't quantify over" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n))
                Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by the partial type signature:")
                             Arity
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType (GhcPass 'Renamed)
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
hs_ty)
                        , SDoc
extra ])
      where
        extra :: SDoc
extra | Just Type
rhs_ty <- Maybe Type
m_unif_ty
              = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"should really be", SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs_ty) ]
              | Bool
otherwise
              = SDoc
forall doc. IsOutput doc => doc
empty
    TcRnMissingSignature MissingSignature
what Exported
_ ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      case MissingSignature
what of
        MissingPatSynSig PatSyn
p ->
          SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonym with no type signature:")
            Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName (PatSyn -> Name
patSynName PatSyn
p) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PatSyn -> SDoc
pprPatSynType PatSyn
p)
        MissingTopLevelBindingSig Name
name Type
ty ->
          SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Top-level binding with no type signature:")
            Arity
2 (Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
ty)
        MissingTyConKindSig TyCon
tc Bool
cusks_enabled ->
          SDoc -> Arity -> SDoc -> SDoc
hang SDoc
msg
            Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName (TyCon -> Name
tyConName TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprKind (TyCon -> Type
tyConKind TyCon
tc))
          where
            msg :: SDoc
msg | Bool
cusks_enabled
                = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Top-level type constructor with no standalone kind signature or CUSK:"
                | Bool
otherwise
                = String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Polymorphic local binding with no type signature:"
               , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty ]
    TcRnOverloadedSig TcIdSigInfo
sig
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Overloaded signature conflicts with monomorphism restriction")
              Arity
2 (TcIdSigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSigInfo
sig)
    TcRnTupleConstraintInst Class
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You can't specify an instance for a tuple constraint"
    TcRnUserTypeError Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (Type -> SDoc
pprUserTypeErrorTy Type
ty)
    TcRnConstraintInKind Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal constraint in a kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty
    TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
tuple_or_sum Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal unboxed" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"tuple"
            UnboxedTupleOrSum
UnboxedSumType   -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sum"
    TcRnLinearFuncInKind Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal linear function in a kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty
    TcRnForAllEscapeError Type
ty Type
kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Quantified type's kind mentions quantified type variable")
                Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty))
           , SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where the body of the forall has this kind:")
                Arity
2 (SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
kind)) ]
    TcRnSimplifiableConstraint Type
pred InstanceWhat
what
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
pred) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"matches")
                Arity
2 (InstanceWhat -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstanceWhat
what)
           , SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This makes type inference for inner bindings fragile;")
                Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"either use MonoLocalBinds, or simplify it using the instance") ]
    TcRnArityMismatch TyThing
thing Arity
thing_arity Arity
nb_args
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what, SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"should have"
                , SDoc
n_arguments SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but has been given"
                , if Arity
nb_args Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0 then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"none" else Arity -> SDoc
forall doc. IsLine doc => Arity -> doc
int Arity
nb_args
                ]
          where
            what :: SDoc
what = case TyThing
thing of
              ATyCon TyCon
tc -> TyConFlavour TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> TyConFlavour TyCon
tyConFlavour TyCon
tc)
              TyThing
_         -> String -> SDoc
forall doc. IsLine doc => String -> doc
text (TyThing -> String
tyThingCategory TyThing
thing)
            n_arguments :: SDoc
n_arguments | Arity
thing_arity Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"no arguments"
                        | Arity
thing_arity Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"1 argument"
                        | Bool
True          = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [Arity -> SDoc
forall doc. IsLine doc => Arity -> doc
int Arity
thing_arity, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arguments"]
    TcRnIllegalInstance IllegalInstanceReason
reason ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ IllegalInstanceReason -> SDoc
pprIllegalInstance IllegalInstanceReason
reason
    TcRnVDQInTermType Maybe Type
mb_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ case Maybe Type
mb_ty of
               Maybe Type
Nothing -> SDoc
main_msg
               Just Type
ty -> SDoc -> Arity -> SDoc -> SDoc
hang (SDoc
main_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
':') Arity
2 (Type -> SDoc
pprType Type
ty)
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(GHC does not yet support this)" ]
      where
        main_msg :: SDoc
main_msg =
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal visible, dependent quantification" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the type of a term"
    TcRnBadQuantPredHead Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Quantified predicate must have a class or type variable head:")
              Arity
2 (Type -> SDoc
pprType Type
ty)
    TcRnIllegalTupleConstraint Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal tuple constraint:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty
    TcRnNonTypeVarArgInConstraint Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Non type-variable argument")
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the constraint:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty)
    TcRnIllegalImplicitParam Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal implicit parameter" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
ty)
    TcRnIllegalConstraintSynonymOfKind Type
kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal constraint synonym of kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
kind)
    TcRnOversaturatedVisibleKindArg Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal oversaturated visible kind argument:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           SDoc -> SDoc
quotes (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Type -> SDoc
pprParendType Type
ty)
    TcRnForAllRankErr Rank
rank Type
ty
      -> let herald :: SDoc
herald = case Type -> ([TyVar], Type)
tcSplitForAllTyVars Type
ty of
               ([], Type
_) -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal qualified type:"
               ([TyVar], Type)
_       -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal polymorphic type:"
             extra :: SDoc
extra = case Rank
rank of
               Rank
MonoTypeConstraint -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A constraint must be a monotype"
               Rank
_                  -> SDoc
forall doc. IsOutput doc => doc
empty
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc -> Arity -> SDoc -> SDoc
hang SDoc
herald Arity
2 (Type -> SDoc
pprType Type
ty), SDoc
extra]
    TcRnMonomorphicBindings [Name]
bindings
      -> let pp_bndrs :: SDoc
pp_bndrs = [Name] -> SDoc
pprBindings [Name]
bindings
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The Monomorphism Restriction applies to the binding"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Name] -> SDoc
forall a. [a] -> SDoc
plural [Name]
bindings
                  , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_bndrs ]
    TcRnOrphanInstance (Left ClsInst
cls_inst)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Orphan class instance:")
              Arity
2 (ClsInst -> SDoc
pprInstanceHdr ClsInst
cls_inst)
    TcRnOrphanInstance (Right FamInst
fam_inst)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Orphan family instance:")
              Arity
2 (FamInst -> SDoc
pprFamInst FamInst
fam_inst)
    TcRnFunDepConflict UnitState
unit_state NonEmpty ClsInst
sorted
      -> let herald :: SDoc
herald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Functional dependencies conflict between instance declarations:"
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (SDoc -> Arity -> SDoc -> SDoc
hang SDoc
herald Arity
2 ([ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
sorted))
    TcRnDupInstanceDecls UnitState
unit_state NonEmpty ClsInst
sorted
      -> let herald :: SDoc
herald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate instance declarations:"
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (SDoc -> Arity -> SDoc -> SDoc
hang SDoc
herald Arity
2 ([ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
sorted))
    TcRnConflictingFamInstDecls NonEmpty FamInst
sortedNE
      -> let sorted :: [FamInst]
sorted = NonEmpty FamInst -> [FamInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FamInst
sortedNE
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Conflicting family instance declarations:")
                 Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser (CoAxiom Unbranched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
ax) (CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch CoAxiom Unbranched
ax)
                         | FamInst
fi <- [FamInst]
sorted
                         , let ax :: CoAxiom Unbranched
ax = FamInst -> CoAxiom Unbranched
famInstAxiom FamInst
fi ])
    TcRnFamInstNotInjective InjectivityErrReason
rea TyCon
fam_tc (CoAxBranch
eqn1 NE.:| [CoAxBranch]
rest_eqns)
      -> let (SDoc
herald, Bool
show_kinds) = case InjectivityErrReason
rea of
               InjErrRhsBareTyVar [Type]
tys ->
                 (SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RHS of injective type family equation is a bare" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variable" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but these LHS type and kind patterns are not bare" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variables:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [Type]
tys, Bool
False)
               InjectivityErrReason
InjErrRhsCannotBeATypeFam ->
                 (SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RHS of injective type family equation cannot" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"be a type family:", Bool
False)
               InjectivityErrReason
InjErrRhsOverlap ->
                  (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type family equation right-hand sides overlap; this violates" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the family's injectivity annotation:", Bool
False)
               InjErrCannotInferFromRhs VarSet
tvs HasKinds
has_kinds SuggestUndecidableInstances
_ ->
                 let show_kinds :: Bool
show_kinds = HasKinds
has_kinds HasKinds -> HasKinds -> Bool
forall a. Eq a => a -> a -> Bool
== HasKinds
YesHasKinds
                     what :: SDoc
what = if Bool
show_kinds then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type/kind" else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type"
                     body :: SDoc
body = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                                  VarSet -> SDoc
pluralVarSet VarSet
tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> VarSet -> ([TyVar] -> SDoc) -> SDoc
pprVarSet VarSet
tvs ([TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList ([TyVar] -> SDoc) -> ([TyVar] -> [TyVar]) -> [TyVar] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TyVar] -> [TyVar]
scopedSort)
                                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot be inferred from the right-hand side." ]
                     in (SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
body SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the type family equation:", Bool
show_kinds)

         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
show_kinds (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> Arity -> SDoc -> SDoc
hang SDoc
herald
                Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((CoAxBranch -> SDoc) -> [CoAxBranch] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser TyCon
fam_tc) (CoAxBranch
eqn1 CoAxBranch -> [CoAxBranch] -> [CoAxBranch]
forall a. a -> [a] -> [a]
: [CoAxBranch]
rest_eqns)))
    TcRnBangOnUnliftedType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Strictness flag has no effect on unlifted type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnLazyBangOnUnliftedType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Lazy flag has no effect on unlifted type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnMultipleDefaultDeclarations [LDefaultDecl (GhcPass 'Renamed)]
dup_things
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple default declarations")
              Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenLocated SrcSpanAnnA (DefaultDecl (GhcPass 'Renamed)) -> SDoc)
-> [GenLocated SrcSpanAnnA (DefaultDecl (GhcPass 'Renamed))]
-> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LDefaultDecl (GhcPass 'Renamed) -> SDoc
GenLocated SrcSpanAnnA (DefaultDecl (GhcPass 'Renamed)) -> SDoc
pp [LDefaultDecl (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (DefaultDecl (GhcPass 'Renamed))]
dup_things))
         where
           pp :: LDefaultDecl GhcRn -> SDoc
           pp :: LDefaultDecl (GhcPass 'Renamed) -> SDoc
pp (L SrcSpanAnnA
locn (DefaultDecl XCDefaultDecl (GhcPass 'Renamed)
_ [LHsType (GhcPass 'Renamed)]
_))
             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"here was another default declaration" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
locn)
    TcRnBadDefaultType Type
ty [Class]
deflt_clss
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The default type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not an instance of")
              Arity
2 ((SDoc -> SDoc -> SDoc) -> [SDoc] -> SDoc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\SDoc
a SDoc
b -> SDoc
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
b) ((Class -> SDoc) -> [Class] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes(SDoc -> SDoc) -> (Class -> SDoc) -> Class -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [Class]
deflt_clss))
    TcRnMessage
TcRnPatSynBundledWithNonDataCon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms can only be bundled with matching type constructors"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't match expected type of"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
expected_res_ty)
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with actual type of"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
res_ty)
    TcRnDupeModuleExport ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate"
                , SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in export list" ]
    TcRnExportedModNotImported ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"is not imported"
    TcRnNullExportedModule ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"exports nothing"
    TcRnMissingExportList ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"is missing an export list"
    TcRnExportHiddenComponents IE GhcPs
export_item
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
export_item)
           String
"attempts to export constructors or class methods that are not visible here"
    TcRnDuplicateExport GlobalRdrElt
gre IE GhcPs
ie1 IE GhcPs
ie2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported by", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie1)
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and",            SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie2) ]
    TcRnExportedParentChildMismatch Name
parent_name TyThing
ty_thing Name
child [Name]
parent_names
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
parent_name)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not the parent of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
what_is
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'.'
                 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> String
capitalise String
what_is)
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"s can only be exported with their parent type constructor."
                 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (case [SDoc]
parents of
                       [] -> SDoc
forall doc. IsOutput doc => doc
empty
                       [SDoc
_] -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Parent:"
                       [SDoc]
_  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Parents:") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma [SDoc]
parents)
      where
        pp_category :: TyThing -> String
        pp_category :: TyThing -> String
pp_category (AnId TyVar
i)
          | TyVar -> Bool
isRecordSelector TyVar
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 = OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccName -> SDoc) -> OccName -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
child
        parents :: [SDoc]
parents = (Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
parent_names
    TcRnConflictingExports OccName
occ GlobalRdrElt
child_gre1 IE GhcPs
ie1 GlobalRdrElt
child_gre2 IE GhcPs
ie2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Conflicting exports for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
                , GlobalRdrElt -> IE GhcPs -> SDoc
forall {a} {info}. Outputable a => GlobalRdrEltX info -> a -> SDoc
ppr_export GlobalRdrElt
child_gre1 IE GhcPs
ie1
                , GlobalRdrElt -> IE GhcPs -> SDoc
forall {a} {info}. Outputable a => GlobalRdrEltX info -> a -> SDoc
ppr_export GlobalRdrElt
child_gre2 IE GhcPs
ie2
                ]
      where
        ppr_export :: GlobalRdrEltX info -> a -> SDoc
ppr_export GlobalRdrEltX info
gre a
ie =
          Arity -> SDoc -> SDoc
nest Arity
3 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            SDoc -> Arity -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ie) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exports" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrEltX info -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrEltX info
gre))
               Arity
2 (GlobalRdrEltX info -> SDoc
forall info. GlobalRdrEltX info -> SDoc
pprNameProvenance GlobalRdrEltX info
gre)
    TcRnDuplicateFieldExport (GlobalRdrElt
gre, IE GhcPs
ie1) NonEmpty (GlobalRdrElt, IE GhcPs)
gres_ies ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ( [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate record field"
                       , SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccName -> SDoc) -> OccName -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre)
                       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in export list" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon ]
                SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: ((GlobalRdrElt, IE GhcPs) -> SDoc)
-> [(GlobalRdrElt, IE GhcPs)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (GlobalRdrElt, IE GhcPs) -> SDoc
forall {a}. Outputable a => (GlobalRdrElt, a) -> SDoc
ppr_export ((GlobalRdrElt
gre,IE GhcPs
ie1) (GlobalRdrElt, IE GhcPs)
-> [(GlobalRdrElt, IE GhcPs)] -> [(GlobalRdrElt, IE GhcPs)]
forall a. a -> [a] -> [a]
: NonEmpty (GlobalRdrElt, IE GhcPs) -> [(GlobalRdrElt, IE GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (GlobalRdrElt, IE GhcPs)
gres_ies)
                )
      where
        ppr_export :: (GlobalRdrElt, a) -> SDoc
ppr_export (GlobalRdrElt
gre,a
ie) =
          Arity -> SDoc -> SDoc
nest Arity
3 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            SDoc -> Arity -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ie) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exports the field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
                       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"belonging to the constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [ConLikeName] -> SDoc
forall a. [a] -> SDoc
plural [ConLikeName]
fld_cons SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [ConLikeName] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [ConLikeName]
fld_cons ])
               Arity
2 (GlobalRdrElt -> SDoc
forall info. GlobalRdrEltX info -> SDoc
pprNameProvenance GlobalRdrElt
gre)
          where
            fld_cons :: [ConLikeName]
            fld_cons :: [ConLikeName]
fld_cons = UniqSet ConLikeName -> [ConLikeName]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (UniqSet ConLikeName -> [ConLikeName])
-> UniqSet ConLikeName -> [ConLikeName]
forall a b. (a -> b) -> a -> b
$ RecFieldInfo -> UniqSet ConLikeName
recFieldCons (RecFieldInfo -> UniqSet ConLikeName)
-> RecFieldInfo -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo GlobalRdrElt
gre
    TcRnAmbiguousFieldInUpdate (GlobalRdrElt
gre1, GlobalRdrElt
gre2, [GlobalRdrElt]
gres)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous record field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
fld SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
               , SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"It could refer to any of the following:")
                  Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GlobalRdrElt -> SDoc) -> [GlobalRdrElt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> SDoc
pprSugg (GlobalRdrElt
gre1 GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: GlobalRdrElt
gre2 GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: [GlobalRdrElt]
gres))
               ]
        where
          fld :: SDoc
fld = SDoc -> SDoc
quotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre1)
          pprSugg :: GlobalRdrElt -> SDoc
pprSugg GlobalRdrElt
gre = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
bullet SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
pprGRE GlobalRdrElt
gre SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                             , Arity -> SDoc -> SDoc
nest Arity
2 (GlobalRdrElt -> SDoc
forall info. GlobalRdrEltX info -> SDoc
pprNameProvenance GlobalRdrElt
gre) ]
          pprGRE :: GlobalRdrElt -> SDoc
pprGRE GlobalRdrElt
gre = case GlobalRdrElt -> GREInfo
greInfo GlobalRdrElt
gre of
            IAmRecField {}
              -> let parent :: Name
parent = Parent -> Name
par_is (Parent -> Name) -> Parent -> Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
gre
                 in String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"record field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
fld SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
parent)
            GREInfo
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
fld
    TcRnAmbiguousRecordUpdate HsExpr (GhcPass 'Renamed)
_rupd TyCon
tc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous record update with parent" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
               , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This type-directed disambiguation mechanism"
                      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"will not be supported by -XDuplicateRecordFields in future releases of GHC." ]
               , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Consider disambiguating using module qualification instead."
               ]
        where
          what :: SDoc
          what :: SDoc
what = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RecSelParent -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RecSelParent -> SDoc) -> RecSelParent -> SDoc
forall a b. (a -> b) -> a -> b
$ TyCon -> RecSelParent
RecSelData TyCon
tc)
    TcRnMissingFields ConLike
con [(FieldLabelString, Type)]
fields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
header, Arity -> SDoc -> SDoc
nest Arity
2 SDoc
rest]
         where
           rest :: SDoc
rest | [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = SDoc
forall doc. IsOutput doc => doc
empty
                | Bool
otherwise   = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((FieldLabelString, Type) -> SDoc)
-> [(FieldLabelString, Type)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)
           header :: SDoc
header = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Fields of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not initialised" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                    if [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields then SDoc
forall doc. IsOutput doc => doc
empty else SDoc
forall doc. IsLine doc => doc
colon
    TcRnFieldUpdateInvalidType [(FieldLabelString, Type)]
prs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record update for insufficiently polymorphic field"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [(FieldLabelString, Type)] -> SDoc
forall a. [a] -> SDoc
plural [(FieldLabelString, Type)]
prs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
              Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty | (FieldLabelString
f,Type
ty) <- [(FieldLabelString, Type)]
prs ])
    TcRnMissingStrictFields ConLike
con [(FieldLabelString, Type)]
fields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
header, Arity -> SDoc -> SDoc
nest Arity
2 SDoc
rest]
         where
           rest :: SDoc
rest | [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = SDoc
forall doc. IsOutput doc => doc
empty  -- Happens for non-record constructors
                                       -- with strict fields
                | Bool
otherwise   = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((FieldLabelString, Type) -> SDoc)
-> [(FieldLabelString, Type)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)

           header :: SDoc
header = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have the required strict field(s)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                    if [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields then SDoc
forall doc. IsOutput doc => doc
empty else SDoc
forall doc. IsLine doc => doc
colon
    TcRnBadRecordUpdate [RdrName]
upd_flds BadRecordUpdateReason
reason
      -> case BadRecordUpdateReason
reason of
          NoConstructorHasAllFields { conflictingFields :: BadRecordUpdateReason -> [FieldLabelString]
conflictingFields = [FieldLabelString]
conflicts }
            | [FieldLabelString
fld] <- [FieldLabelString]
conflicts
            -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
                [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
header
                     , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No constructor in scope has the field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
fld) ]
            | Bool
otherwise
            ->
              SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
                [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
header
                     , SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No constructor in scope has all of the following fields:")
                        Arity
2 ([FieldLabelString] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [FieldLabelString]
conflicts) ]
            where
              header :: SDoc
              header :: SDoc
header = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid record update."
          MultiplePossibleParents (RecSelParent
par1, RecSelParent
par2, [RecSelParent]
pars) ->
            SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous record update with field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [RdrName] -> SDoc
forall a. [a] -> SDoc
plural [RdrName]
upd_flds)
                       Arity
2 SDoc
ppr_flds
                   , SDoc -> Arity -> SDoc -> SDoc
hang ([RdrName] -> SDoc
forall a. [a] -> SDoc
thisOrThese [RdrName]
upd_flds SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [RdrName] -> SDoc
forall a. [a] -> SDoc
plural [RdrName]
upd_flds SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what_parent)
                       Arity
2 ([SDoc] -> SDoc
quotedListWithAnd ((RecSelParent -> SDoc) -> [RecSelParent] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map RecSelParent -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RecSelParent
par1RecSelParent -> [RecSelParent] -> [RecSelParent]
forall a. a -> [a] -> [a]
:RecSelParent
par2RecSelParent -> [RecSelParent] -> [RecSelParent]
forall a. a -> [a] -> [a]
:[RecSelParent]
pars))) ]
            where
              ppr_flds, what_parent, which :: SDoc
              ppr_flds :: SDoc
ppr_flds = [SDoc] -> SDoc
quotedListWithAnd ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (RdrName -> SDoc) -> [RdrName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [RdrName]
upd_flds
              what_parent :: SDoc
what_parent = case RecSelParent
par1 of
                RecSelData   {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"appear" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [RdrName] -> SDoc
forall a. [a] -> SDoc
singular [RdrName]
upd_flds
                                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
which SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"datatypes"
                RecSelPatSyn {} -> [RdrName] -> SDoc
forall a. [a] -> SDoc
isOrAre [RdrName]
upd_flds SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"associated with"
                                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
which SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern synonyms"
              which :: SDoc
which = case [RecSelParent]
pars of
                [] -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"both"
                [RecSelParent]
_  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"all of the"
          InvalidTyConParent TyCon
tc NonEmpty RecSelParent
pars ->
            SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No data constructor of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has all of the fields:")
                      Arity
2 ([RdrName] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [RdrName]
upd_flds)
                   , SDoc
pat_syn_msg ]
            where
              what :: SDoc
what = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RecSelParent -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> RecSelParent
RecSelData TyCon
tc))
              pat_syn_msg :: SDoc
pat_syn_msg
                | (RecSelParent -> Bool) -> NonEmpty RecSelParent -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case { RecSelPatSyn {} -> Bool
True; RecSelParent
_ -> Bool
False}) NonEmpty RecSelParent
pars
                = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: type-directed disambiguation is not supported for pattern synonym record fields."
                | Bool
otherwise
                = SDoc
forall doc. IsOutput doc => doc
empty
    TcRnStaticFormNotClosed Name
name NotClosedReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is used in a static form but it is not closed"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because it"
             SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (NotClosedReason -> [SDoc]
causes NotClosedReason
reason)
         where
          causes :: NotClosedReason -> [SDoc]
          causes :: NotClosedReason -> [SDoc]
causes NotClosedReason
NotLetBoundReason = [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not let-bound."]
          causes (NotTypeClosed VarSet
vs) =
            [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has a non-closed type because it contains the"
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variables:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
              VarSet -> ([TyVar] -> SDoc) -> SDoc
pprVarSet VarSet
vs ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> ([TyVar] -> [SDoc]) -> [TyVar] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ([SDoc] -> [SDoc]) -> ([TyVar] -> [SDoc]) -> [TyVar] -> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyVar -> SDoc) -> [TyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (TyVar -> SDoc) -> TyVar -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr))
            ]
          causes (NotClosed Name
n NotClosedReason
reason) =
            let msg :: SDoc
msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"uses" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"which"
             in case NotClosedReason
reason of
                  NotClosed Name
_ NotClosedReason
_ -> SDoc
msg SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: NotClosedReason -> [SDoc]
causes NotClosedReason
reason
                  NotClosedReason
_   -> let ([SDoc]
xs0, [SDoc]
xs1) = Arity -> [SDoc] -> ([SDoc], [SDoc])
forall a. Arity -> [a] -> ([a], [a])
splitAt Arity
1 ([SDoc] -> ([SDoc], [SDoc])) -> [SDoc] -> ([SDoc], [SDoc])
forall a b. (a -> b) -> a -> b
$ NotClosedReason -> [SDoc]
causes NotClosedReason
reason
                          in (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SDoc
msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>) [SDoc]
xs0 [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
xs1
    TcRnMessage
TcRnUselessTypeable
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Deriving" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
typeableClassName) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has no effect: all types now auto-derive Typeable"
    TcRnDerivingDefaults Class
cls
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep
                     [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Both DeriveAnyClass and"
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GeneralizedNewtypeDeriving are enabled"
                     , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Defaulting to the DeriveAnyClass strategy"
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for instantiating" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls
                     ]
    TcRnNonUnaryTypeclassConstraint LHsSigType (GhcPass 'Renamed)
ct
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
ct)
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found type wildcard" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_')
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"standing for" SDoc -> SDoc -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
True DeriveInstanceErrReason
reason
    TcRnLookupInstance Class
cls [Type]
tys LookupInstanceErrReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't match instance:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           Class -> [Type] -> LookupInstanceErrReason -> SDoc
lookupInstanceErrDiagnosticMessage Class
cls [Type]
tys LookupInstanceErrReason
reason
    TcRnMessage
TcRnLazyGADTPattern
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"An existential or GADT data constructor cannot be used")
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"inside a lazy (~) pattern")
    TcRnMessage
TcRnArrowProcGADTPattern
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Proc patterns cannot use existential or GADT data constructors"
    TcRnForallIdentifier RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The use of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
                                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"as an identifier",
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"will become an error in a future GHC release." ]
    TcRnMessage
TcRnTypeEqualityOutOfScope
      -> [SDoc] -> DecoratedSDoc
mkDecorated
           [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"operator is out of scope." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Assuming it to stand for an equality constraint."
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used to be built-in syntax but now is a regular type operator" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exported from Data.Type.Equality and Prelude.") SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"If you are using a custom Prelude, consider re-exporting it."
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This will become an error in a future GHC release." ]
    TcRnMessage
TcRnTypeEqualityRequiresOperators
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The use of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~")
                                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"without TypeOperators",
                   String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal operator" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
op) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SDoc
overall_ty)
    TcRnIllegalTypeOperatorDecl RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal declaration of a type or class operator" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)
    TcRnMessage
TcRnGADTMonoLocalBinds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern matching on GADTs without MonoLocalBinds"
                 , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is fragile." ]
    TcRnIncorrectNameSpace Name
name Bool
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc
msg
        where
          msg :: SDoc
msg
            -- We are in a type-level namespace,
            -- and the name is incorrectly at the term-level.
            | NameSpace -> Bool
isValNameSpace NameSpace
ns
            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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
            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal term-level use of the" SDoc -> SDoc -> SDoc
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 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
    TcRnNotInScope NotInScopeError
err RdrName
name [ImportError]
imp_errs [GhcHint]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
name NotInScopeError
err SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ImportError -> SDoc) -> [ImportError] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ImportError -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs)
    TcRnTermNameInType RdrName
name [GhcHint]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a term-level binding") SDoc -> SDoc -> SDoc
$+$
             (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" and can not be used at the type level.")
    TcRnUntickedPromotedThing UntickedPromotedThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unticked promoted" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
           where
             what :: SDoc
             what :: SDoc
what = case UntickedPromotedThing
thing of
               UntickedPromotedThing
UntickedExplicitList -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"list" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
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 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"constructor:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> if Bool
bare_sym then SDoc
forall doc. IsOutput doc => doc
empty else SDoc
forall doc. IsLine doc => doc
dot
    TcRnIllegalBuiltinSyntax SDoc
what RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal", SDoc
what, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of built-in syntax:", RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name]
    TcRnWarnDefaulting [Ct]
tidy_wanteds Maybe TyVar
tidy_tv Type
default_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Defaulting" ]
                     [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
                     (case Maybe TyVar
tidy_tv of
                         Maybe TyVar
Nothing -> []
                         Just TyVar
tv -> [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type variable"
                                    , SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv)])
                     [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
                     [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to type"
                     , SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
default_ty)
                     , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the following constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Ct] -> SDoc
forall a. [a] -> SDoc
plural [Ct]
tidy_wanteds ])
             Arity
2
             ([Ct] -> SDoc
pprWithArising [Ct]
tidy_wanteds)


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

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

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

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

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

    TcRnUnsupportedCallConv Either
  (ForeignExport (GhcPass 'Renamed))
  (ForeignImport (GhcPass 'Renamed))
_decl UnsupportedCallConvention
unsupportedCC
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           case UnsupportedCallConvention
unsupportedCC of
             UnsupportedCallConvention
StdCallConvUnsupported ->
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the 'stdcall' calling convention is unsupported on this platform,"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"treating as ccall"
             UnsupportedCallConvention
PrimCallConvUnsupported ->
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The `prim' calling convention can only be used with `foreign import'"
             UnsupportedCallConvention
JavaScriptCallConvUnsupported ->
               String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Arity -> SDoc -> SDoc
hang SDoc
msg Arity
2 SDoc
extra
      where
        arg_or_res :: SDoc
arg_or_res = case Maybe ArgOrResult
mArgOrResult of
          Maybe ArgOrResult
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
          Just ArgOrResult
Arg -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"argument"
          Just ArgOrResult
Result -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"result"
        msg :: SDoc
msg = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unacceptable", SDoc
arg_or_res
                   , String -> SDoc
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 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a data type"
                NewtypeDataConNotInScope TyCon
_ [] ->
                  SDoc -> Arity -> SDoc -> SDoc
hang SDoc
innerMsg Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because its data constructor is not in scope"
                NewtypeDataConNotInScope TyCon
tc [Type]
_ ->
                  SDoc -> Arity -> SDoc -> SDoc
hang SDoc
innerMsg Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because the data constructor for"
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope"
                TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded ->
                  SDoc
innerMsg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnliftedFFITypes is required to marshal unlifted types"
                TypeCannotBeMarshaledReason
NotABoxedMarshalableTyCon -> SDoc
innerMsg
                TypeCannotBeMarshaledReason
ForeignLabelNotAPtr ->
                  SDoc
innerMsg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
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 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"foreign import prim only accepts simple unlifted types"
                TypeCannotBeMarshaledReason
NotBoxedKindAny ->
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnliftedType") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty))
            ForeignDynNotPtr Type
expected Type
ty ->
              [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected: Ptr/FunPtr" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
expected SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty ]
            IllegalForeignTypeReason
SafeHaskellMustBeInIO ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Safe Haskell is on, all FFI imports must be in the IO monad"
            IllegalForeignTypeReason
IOResultExpected ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IO result type expected"
            IllegalForeignTypeReason
UnexpectedNestedForall ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected nested forall"
            IllegalForeignTypeReason
LinearTypesNotAllowed ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Linear types are not supported in FFI declarations, see #18472"
            IllegalForeignTypeReason
OneArgExpected ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"One argument expected"
            IllegalForeignTypeReason
AtLeastOneArgExpected ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"At least one argument expected"
    TcRnInvalidCIdentifier FastString
target
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc -> SDoc
quotes (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
target) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a valid C identifier"]
    TcRnExpectedValueId TcTyThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           TcTyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyThing
thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used where a value identifier was expected"
    TcRnRecSelectorEscapedTyVar OccName
lbl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot use record selector" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
lbl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"as a function due to escaped type variables"
    TcRnPatSynNotBidirectional Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"non-bidirectional pattern synonym"
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used in an expression"
    TcRnIllegalDerivingItem LHsSigType (GhcPass 'Renamed)
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal deriving item" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
hs_ty)
    TcRnUnexpectedAnnotation HsType (GhcPass 'Renamed)
ty HsSrcBang
bang
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
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 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"annotation:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsType (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType (GhcPass 'Renamed)
ty SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"annotation cannot appear nested inside a type"
    TcRnIllegalRecordSyntax Either (HsType GhcPs) (HsType (GhcPass 'Renamed))
either_ty_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record syntax is illegal here:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (HsType GhcPs -> SDoc)
-> (HsType (GhcPass 'Renamed) -> SDoc)
-> Either (HsType GhcPs) (HsType (GhcPass 'Renamed))
-> SDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Either (HsType GhcPs) (HsType (GhcPass 'Renamed))
either_ty_ty
    TcRnInvalidVisibleKindArgument LHsType (GhcPass 'Renamed)
arg Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot apply function of kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
             SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to visible kind argument" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
arg)
    TcRnTooManyBinders Type
ki [LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)]
bndrs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Not a function kind:")
              Arity
4 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ki) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but extra binders found:")
              Arity
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ((GenLocated
   SrcSpanAnnA
   (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
 -> SDoc)
-> [GenLocated
      SrcSpanAnnA
      (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))]
-> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))]
bndrs))
    TcRnDifferentNamesForTyVar Name
n1 Name
n2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Different names for the same type variable:") Arity
2 SDoc
info
         where
           info :: SDoc
info | Name -> OccName
nameOccName Name
n1 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
/= Name -> OccName
nameOccName Name
n2
                = SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n1) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n2)
                | Bool
otherwise -- Same OccNames! See C2 in
                            -- Note [Swizzling the tyvars before generaliseTcTyCon]
                = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n1) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
n1)
                       , SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n2) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
n2) ]

    TcRnDisconnectedTyVar Name
n
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Scoped type variable only appears non-injectively in declaration header:")
              Arity
2 (SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
n))

    TcRnInvalidReturnKind DataSort
data_sort AllowedDataResKind
allowed_kind Type
kind Maybe SuggestUnliftedTypes
_suggested_ext
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ DataSort -> SDoc
ppDataSort DataSort
data_sort SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has non-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                 SDoc
allowed_kind_tycon
               , (if Bool
is_data_family then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and non-variable" else SDoc
forall doc. IsOutput doc => doc
empty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"return kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
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  -> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tYPETyCon
              AllowedDataResKind
AnyBoxedKind -> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
boxedRepDataConTyCon
              AllowedDataResKind
LiftedKind   -> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
liftedTypeKind
    TcRnClassKindNotConstraint Type
_kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Kind signature on a class must end with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
constraintKind SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unobscured by type families"
    TcRnUnpromotableThing Name
name PromotionErr
err
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           (SDoc -> Arity -> SDoc -> SDoc
hang (PromotionErr -> SDoc
pprPECategory PromotionErr
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot be used here")
                        Arity
2 (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
reason))
        where
          reason :: SDoc
reason = case PromotionErr
err of
                     ConstrainedDataConPE [Type]
theta
                                    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"it has an unpromotable context"
                                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Type] -> SDoc
pprTheta [Type]
theta)

                     PromotionErr
FamDataConPE   -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"it comes from a data family instance"
                     PromotionErr
NoDataKindsDC  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"perhaps you intended to use DataKinds"
                     PromotionErr
PatSynPE       -> String -> SDoc
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 -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"term variables cannot be promoted"
                     PromotionErr
TypeVariablePE -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variables bound in a kind signature cannot be used in the type"
          same_rec_group_msg :: SDoc
same_rec_group_msg = String -> SDoc
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 (GhcPass 'Renamed) body)
match1 NonEmpty (LocatedA (Match (GhcPass 'Renamed) body))
bad_matches)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ HsMatchContext GhcTc -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsMatchContext p -> SDoc
pprMatchContextNouns HsMatchContext GhcTc
argsContext SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"have different numbers of arguments"
                 , Arity -> SDoc -> SDoc
nest Arity
2 (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LocatedA (Match (GhcPass 'Renamed) body) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA (Match (GhcPass 'Renamed) body)
match1))
                 , Arity -> SDoc -> SDoc
nest Arity
2 (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LocatedA (Match (GhcPass 'Renamed) body) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (NonEmpty (LocatedA (Match (GhcPass 'Renamed) body))
-> LocatedA (Match (GhcPass 'Renamed) body)
forall a. NonEmpty a -> a
NE.head NonEmpty (LocatedA (Match (GhcPass 'Renamed) body))
bad_matches)))])
    TcRnCannotBindScopedTyVarInPatSig NonEmpty (Name, TyVar)
sig_tvs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You cannot bind scoped type variable"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [(Name, TyVar)] -> SDoc
forall a. [a] -> SDoc
plural (NonEmpty (Name, TyVar) -> [(Name, TyVar)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name, TyVar)
sig_tvs)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Name] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList (((Name, TyVar) -> Name) -> [(Name, TyVar)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TyVar) -> Name
forall a b. (a, b) -> a
fst ([(Name, TyVar)] -> [Name]) -> [(Name, TyVar)] -> [Name]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Name, TyVar) -> [(Name, TyVar)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name, TyVar)
sig_tvs))
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a pattern binding signature")
    TcRnCannotBindTyVarsInPatBind NonEmpty (Name, TyVar)
_offenders
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Binding type variables is not allowed in pattern bindings"
    TcRnTooManyTyArgsInConPattern ConLike
con_like Arity
expected_number Arity
actual_number
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Too many type arguments in constructor pattern for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con_like) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected no more than" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
expected_number SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"got" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
actual_number
    TcRnMultipleInlinePragmas TyVar
poly_id LocatedA InlinePragma
fst_inl_prag NonEmpty (LocatedA InlinePragma)
inl_prags
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple INLINE pragmas for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
poly_id)
             Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ignoring all but the first"
                      SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (LocatedA InlinePragma -> SDoc)
-> [LocatedA InlinePragma] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA InlinePragma -> SDoc
forall {a} {a}.
(Outputable a, Outputable a) =>
GenLocated a a -> SDoc
pp_inl (LocatedA InlinePragma
fst_inl_prag LocatedA InlinePragma
-> [LocatedA InlinePragma] -> [LocatedA InlinePragma]
forall a. a -> [a] -> [a]
: NonEmpty (LocatedA InlinePragma) -> [LocatedA InlinePragma]
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) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
prag SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
loc)
    TcRnUnexpectedPragmas TyVar
poly_id NonEmpty (LSig (GhcPass 'Renamed))
bad_sigs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Discarding unexpected pragmas for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
poly_id)
              Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> SDoc)
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanAnnA -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnA -> SDoc)
-> (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> SrcSpanAnnA)
-> GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc) ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> [SDoc])
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LSig (GhcPass 'Renamed))
NonEmpty (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)))
bad_sigs))
    TcRnNonOverloadedSpecialisePragma LIdP (GhcPass 'Renamed)
fun_name
       -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SPECIALISE pragma for non-overloaded function"
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass 'Renamed)
LocatedN Name
fun_name)
    TcRnSpecialiseNotVisible Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You cannot SPECIALISE" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because its definition is not visible in this module"
    TcRnPragmaWarning {OccName
pragma_warning_occ :: OccName
pragma_warning_occ :: TcRnMessage -> OccName
pragma_warning_occ, WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: TcRnMessage -> WarningTxt (GhcPass 'Renamed)
pragma_warning_msg, ModuleName
pragma_warning_import_mod :: ModuleName
pragma_warning_import_mod :: TcRnMessage -> ModuleName
pragma_warning_import_mod, Maybe ModuleName
pragma_warning_defined_mod :: Maybe ModuleName
pragma_warning_defined_mod :: TcRnMessage -> Maybe ModuleName
pragma_warning_defined_mod}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the use of"
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
pragma_warning_occ)
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
pragma_warning_occ)
                , SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
impMsg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon ]
          , WarningTxt (GhcPass 'Renamed) -> SDoc
forall p. WarningTxt p -> SDoc
pprWarningTxtForMsg WarningTxt (GhcPass 'Renamed)
pragma_warning_msg ]
          where
            impMsg :: SDoc
impMsg  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"imported from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pragma_warning_import_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
extra
            extra :: SDoc
extra = case Maybe ModuleName
pragma_warning_defined_mod of
                      Just ModuleName
def_mod
                        | ModuleName
def_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
pragma_warning_import_mod
                          -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
", but defined in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
def_mod
                      Maybe ModuleName
_ -> SDoc
forall doc. IsOutput doc => doc
empty
    TcRnDifferentExportWarnings Name
name NonEmpty SrcSpan
locs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exported with different error messages",
                                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([SrcSpan] -> [SDoc]) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> SrcSpan -> Ordering) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SrcSpan -> SrcSpan -> Ordering
leftmost_smallest ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ NonEmpty SrcSpan -> [SrcSpan]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty SrcSpan
locs)]
    TcRnIncompleteExportWarnings Name
name NonEmpty SrcSpan
locs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"will not have its export warned about",
                                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"missing export warning at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([SrcSpan] -> [SDoc]) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> SrcSpan -> Ordering) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SrcSpan -> SrcSpan -> Ordering
leftmost_smallest ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ NonEmpty SrcSpan -> [SrcSpan]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty SrcSpan
locs)]
    TcRnIllegalHsigDefaultMethods Name
name NonEmpty (LHsBind (GhcPass 'Renamed))
meths
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal default method" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))] -> SDoc
forall a. [a] -> SDoc
plural (NonEmpty (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsBind (GhcPass 'Renamed))
NonEmpty (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed)))
meths) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in class definition of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in hsig file"
    TcRnHsigFixityMismatch TyThing
real_thing Fixity
real_fixity Fixity
sig_fixity
      ->
      let ppr_fix :: Fixity -> SDoc
ppr_fix Fixity
f = Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> if Fixity
f Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
defaultFixity then SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"default") else SDoc
forall doc. IsOutput doc => doc
empty
      in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
real_thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has conflicting fixities in the module",
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and its hsig file",
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Main module:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fixity -> SDoc
ppr_fix Fixity
real_fixity,
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Hsig file:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fixity -> SDoc
ppr_fix Fixity
sig_fixity]
    TcRnHsigShapeMismatch (HsigShapeSortMismatch AvailInfo
info1 AvailInfo
info2)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"While merging export lists, could not combine"
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
info1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
info2
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"one is a type, the other is a plain identifier")
    TcRnHsigShapeMismatch (HsigShapeNotUnifiable Name
name1 Name
name2 Bool
notHere)
      ->
      let extra :: SDoc
extra = if Bool
notHere
                  then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Neither name variable originates from the current signature."
                  else SDoc
forall doc. IsOutput doc => doc
empty
      in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"While merging export lists, could not unify"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name2 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
extra
    TcRnHsigMissingModuleExport OccName
occ UnitState
unit_state Module
impl_mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported by the hsig file, but not exported by the implementing module"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
impl_mod)
    TcRnBadGenericMethod Name
clas Name
op
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
clas),
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has a generic-default signature without a binding", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
op)]
    TcRnWarningMinimalDefIncomplete ClassMinimalDef
mindef
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The MINIMAL pragma does not require:"
          , Arity -> SDoc -> SDoc
nest Arity
2 (ClassMinimalDef -> SDoc
forall a. Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef)
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but there is no default implementation." ]
    TcRnDefaultMethodForPragmaLacksBinding TyVar
sel_id Sig (GhcPass 'Renamed)
prag
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Sig (GhcPass 'Renamed) -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig (GhcPass 'Renamed)
prag SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for default method"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
sel_id)
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lacks an accompanying binding"
    TcRnIgnoreSpecialisePragmaOnDefMethod Name
sel_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ignoring SPECIALISE pragmas on default method"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
sel_name)
    TcRnBadMethodErr{Name
badMethodErrClassName :: Name
badMethodErrClassName :: TcRnMessage -> Name
badMethodErrClassName, Name
badMethodErrMethodName :: Name
badMethodErrMethodName :: TcRnMessage -> Name
badMethodErrMethodName}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
badMethodErrClassName),
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have a method", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
badMethodErrMethodName)]
    TcRnMessage
TcRnIllegalTypeData
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal type-level data declaration"
    TcRnTypeDataForbids TypeDataForbids
feature
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        TypeDataForbids -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeDataForbids
feature SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
msg, SDoc
additional]
        where
          (SDoc
msg,SDoc
additional) =
            case IllegalNewtypeReason
reason of
              DoesNotHaveSingleField Arity
n_flds ->
                ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must have exactly one field",
                  Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
speakN Arity
n_flds
                ],
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
IsNonLinear ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must be linear",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
True DataCon
con))
              IllegalNewtypeReason
IsGADT ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype must not be a GADT",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
sneaky_eq_spec
                                       (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasConstructorContext ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have a context in its type",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasExistentialTyVar ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have existential type variables",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasStrictnessAnnotation ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have a strictness annotation", SDoc
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
    TcRnUnsatisfiedMinimalDef ClassMinimalDef
mindef
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No explicit implementation for"
              ,Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ClassMinimalDef -> SDoc
forall a. Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef
             ]
    TcRnMisplacedInstSig Name
name LHsSigType (GhcPass 'Renamed)
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal type signature in instance declaration:")
                  Arity
2 (SDoc -> Arity -> SDoc -> SDoc
hang (Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
name)
                        Arity
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
hs_ty))
             ]
    TcRnMessage
TcRnNoRebindableSyntaxRecordDot -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RebindableSyntax is required if OverloadedRecordUpdate is enabled."
    TcRnMessage
TcRnNoFieldPunsRecordDot -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"For this to work enable NamedFieldPuns"
    TcRnIllegalStaticExpression HsExpr GhcPs
e -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal static expression:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
    TcRnListComprehensionDuplicateBinding Name
n -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate binding in parallel list comprehension for:"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n))
    TcRnEmptyStmtsGroup EmptyStatementGroupErrReason
cause -> SDoc -> DecoratedSDoc
mkSimpleDecorated  (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ case EmptyStatementGroupErrReason
cause of
      EmptyStatementGroupErrReason
EmptyStmtsGroupInParallelComp ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty statement group in parallel comprehension"
      EmptyStatementGroupErrReason
EmptyStmtsGroupInTransformListComp ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty statement group preceding 'group' or 'then'"
      EmptyStmtsGroupInDoNotation HsDoFlavour
ctxt ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsDoFlavour -> SDoc
pprHsDoFlavour HsDoFlavour
ctxt
      EmptyStatementGroupErrReason
EmptyStmtsGroupInArrowNotation ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty 'do' block in an arrow command"
    TcRnLastStmtNotExpr HsStmtContext (GhcPass 'Renamed)
ctxt (UnexpectedStatement StmtLR GhcPs GhcPs body
stmt) ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Arity -> SDoc -> SDoc
hang SDoc
last_error Arity
2 (StmtLR GhcPs GhcPs body -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtLR GhcPs GhcPs body
stmt)
      where
        last_error :: SDoc
last_error =
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The last statement in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsStmtContext (GhcPass 'Renamed) -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsStmtContext p -> SDoc
pprAStmtContext HsStmtContext (GhcPass 'Renamed)
ctxt
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be an expression"
    TcRnUnexpectedStatementInContext HsStmtContext (GhcPass 'Renamed)
ctxt (UnexpectedStatement StmtLR GhcPs GhcPs body
stmt) Maybe Extension
_ -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StmtLR GhcPs GhcPs body -> SDoc
forall (p :: Pass) body. Stmt (GhcPass p) body -> SDoc
pprStmtCat StmtLR GhcPs GhcPs body
stmt SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"statement"
                       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsStmtContext (GhcPass 'Renamed) -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsStmtContext p -> SDoc
pprAStmtContext HsStmtContext (GhcPass 'Renamed)
ctxt ]
    TcRnMessage
TcRnIllegalTupleSection -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal tuple section"
    TcRnIllegalImplicitParameterBindings Either
  (HsLocalBindsLR GhcPs GhcPs)
  (HsLocalBindsLR (GhcPass 'Renamed) GhcPs)
eBinds -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        (HsLocalBindsLR GhcPs GhcPs -> SDoc)
-> (HsLocalBindsLR (GhcPass 'Renamed) GhcPs -> SDoc)
-> Either
     (HsLocalBindsLR GhcPs GhcPs)
     (HsLocalBindsLR (GhcPass 'Renamed) GhcPs)
-> SDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsLocalBindsLR GhcPs GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
msg HsLocalBindsLR (GhcPass 'Renamed) GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
msg Either
  (HsLocalBindsLR GhcPs GhcPs)
  (HsLocalBindsLR (GhcPass 'Renamed) GhcPs)
eBinds
      where
        msg :: a -> SDoc
msg a
binds = SDoc -> Arity -> SDoc -> SDoc
hang
          (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Implicit-parameter bindings illegal in an mdo expression")
          Arity
2 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
binds)
    TcRnSectionWithoutParentheses HsExpr GhcPs
expr -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A section must be enclosed in parentheses")
         Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"thus:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
expr)))
    TcRnMissingRoleAnnotation Name
name [Role]
roles -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Missing role annotation" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
         Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type role" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((Role -> SDoc) -> [Role] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Role]
roles))

    TcRnCapturedTermName RdrName
tv_name Either [GlobalRdrElt] Name
shadowed_term_names
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
tv_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is implicitly quantified," SDoc -> SDoc -> SDoc
$+$
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"even though another variable of the same name is in scope:" SDoc -> SDoc -> SDoc
$+$
          Arity -> SDoc -> SDoc
nest Arity
2 SDoc
var_names SDoc -> SDoc -> SDoc
$+$
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This is not forward-compatible with a planned GHC extension, RequiredTypeArguments."
        where
          var_names :: SDoc
var_names = case Either [GlobalRdrElt] Name
shadowed_term_names of
              Left [GlobalRdrElt]
gbl_names -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GlobalRdrElt -> SDoc) -> [GlobalRdrElt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\GlobalRdrElt
name -> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall info. GlobalRdrEltX info -> SDoc
pprNameProvenance GlobalRdrElt
name) [GlobalRdrElt]
gbl_names)
              Right Name
lcl_name -> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
lcl_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"defined at"
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
lcl_name)
    TcRnBindingOfExistingName RdrName
name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal binding of an existing name:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName -> RdrName
filterCTuple RdrName
name)
    TcRnMultipleFixityDecls SrcSpan
loc RdrName
rdr_name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple fixity declarations for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name),
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"also at " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc]
    TcRnMessage
TcRnIllegalPatternSynonymDecl -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal pattern synonym declaration"
    TcRnIllegalClassBinding DeclSort
dsort HsBindLR GhcPs GhcPs
bind -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not allowed in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
decl_sort
              , Arity -> SDoc -> SDoc
nest Arity
2 (HsBindLR GhcPs GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBindLR GhcPs GhcPs
bind) ]
      where
        decl_sort :: SDoc
decl_sort = case DeclSort
dsort of
          DeclSort
ClassDeclSort -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"class declaration:"
          DeclSort
InstanceDeclSort -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance declaration:"
        what :: SDoc
what = case HsBindLR GhcPs GhcPs
bind of
                  PatBind {}    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern bindings (except simple variables)"
                  PatSynBind {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms"
                                   -- Associated pattern synonyms are not implemented yet
                  HsBindLR GhcPs GhcPs
_ -> String -> SDoc -> SDoc
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"rnMethodBind" (HsBindLR GhcPs GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBindLR GhcPs GhcPs
bind)
    TcRnMessage
TcRnOrphanCompletePragma -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Orphan COMPLETE pragmas not supported" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A COMPLETE pragma must mention at least one data constructor" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or pattern synonym defined in the same module."
    TcRnEmptyCase HsMatchContext (GhcPass 'Renamed)
ctxt -> SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
message
      where
        pp_ctxt :: SDoc
pp_ctxt = case HsMatchContext (GhcPass 'Renamed)
ctxt of
          HsMatchContext (GhcPass 'Renamed)
CaseAlt                                  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"case expression"
          LamCaseAlt LamCaseVariant
LamCase                       -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\\case expression"
          ArrowMatchCtxt (ArrowLamCaseAlt LamCaseVariant
LamCase) -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\\case command"
          ArrowMatchCtxt HsArrowMatchContext
ArrowCaseAlt              -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"case command"
          ArrowMatchCtxt HsArrowMatchContext
KappaExpr                 -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"kappa abstraction"
          HsMatchContext (GhcPass 'Renamed)
_                                        -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(unexpected)"
                                                      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsMatchContext (GhcPass 'Renamed) -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsMatchContext p -> SDoc
pprMatchContextNoun HsMatchContext (GhcPass 'Renamed)
ctxt

        message :: SDoc
message = case HsMatchContext (GhcPass 'Renamed)
ctxt of
          LamCaseAlt LamCaseVariant
LamCases -> SDoc
lcases_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"expression"
          ArrowMatchCtxt (ArrowLamCaseAlt LamCaseVariant
LamCases) -> SDoc
lcases_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"command"
          HsMatchContext (GhcPass 'Renamed)
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty list of alternatives in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_ctxt

        lcases_msg :: SDoc
lcases_msg =
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty list of alternatives is not allowed in \\cases"
    TcRnNonStdGuards (NonStandardGuards [LStmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) body]
guards) -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"accepting non-standard pattern guards" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      Arity -> SDoc -> SDoc
nest Arity
4 ([GenLocated SrcSpanAnnA (Stmt (GhcPass 'Renamed) body)] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [LStmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) body]
[GenLocated SrcSpanAnnA (Stmt (GhcPass 'Renamed) body)]
guards)
    TcRnDuplicateSigDecl pairs :: NonEmpty (LocatedN RdrName, Sig GhcPs)
pairs@((L SrcSpanAnnN
_ RdrName
name, Sig GhcPs
sig) :| [(LocatedN RdrName, Sig GhcPs)]
_) -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what_it_is
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"s for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([SrcSpan] -> [SDoc]) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> SrcSpan -> Ordering) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SrcSpan -> SrcSpan -> Ordering
leftmost_smallest
                                        ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ ((LocatedN RdrName, Sig GhcPs) -> SrcSpan)
-> [(LocatedN RdrName, Sig GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (LocatedN RdrName -> SrcSpan)
-> ((LocatedN RdrName, Sig GhcPs) -> LocatedN RdrName)
-> (LocatedN RdrName, Sig GhcPs)
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocatedN RdrName, Sig GhcPs) -> LocatedN RdrName
forall a b. (a, b) -> a
fst)
                                        ([(LocatedN RdrName, Sig GhcPs)] -> [SrcSpan])
-> [(LocatedN RdrName, Sig GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ NonEmpty (LocatedN RdrName, Sig GhcPs)
-> [(LocatedN RdrName, Sig GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LocatedN RdrName, Sig GhcPs)
pairs)
          ]
      where
        what_it_is :: SDoc
what_it_is = Sig GhcPs -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig GhcPs
sig
    TcRnMisplacedSigDecl Sig (GhcPass 'Renamed)
sig -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Misplaced" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Sig (GhcPass 'Renamed) -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig (GhcPass 'Renamed)
sig SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon, Sig (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Sig (GhcPass 'Renamed)
sig]
    TcRnUnexpectedDefaultSig Sig GhcPs
sig -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected default signature:")
         Arity
2 (Sig GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Sig GhcPs
sig)
    TcRnDuplicateMinimalSig LSig GhcPs
sig1 LSig GhcPs
sig2 [LSig GhcPs]
otherSigs -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple minimal complete definitions"
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([SrcSpan] -> [SDoc]) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> SrcSpan -> Ordering) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SrcSpan -> SrcSpan -> Ordering
leftmost_smallest ([SrcSpan] -> [SrcSpan]) -> [SrcSpan] -> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Sig GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (Sig GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Sig GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs)
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Combine alternative minimal complete definitions with `|'" ]
      where
        sigs :: [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs = LSig GhcPs
GenLocated SrcSpanAnnA (Sig GhcPs)
sig1 GenLocated SrcSpanAnnA (Sig GhcPs)
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
forall a. a -> [a] -> [a]
: LSig GhcPs
GenLocated SrcSpanAnnA (Sig GhcPs)
sig2 GenLocated SrcSpanAnnA (Sig GhcPs)
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
forall a. a -> [a] -> [a]
: [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
otherSigs
    TcRnLoopySuperclassSolve CtLoc
wtd_loc Type
wtd_pty ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
header, SDoc
warning, SDoc
user_manual ]
      where
        header, warning, user_manual :: SDoc
        header :: SDoc
header
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"I am solving the constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
wtd_pty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                 , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ CtOrigin -> SDoc
pprCtOrigin (CtLoc -> CtOrigin
ctLocOrigin CtLoc
wtd_loc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                 , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a way that might turn out to loop at runtime." ]
        warning :: SDoc
warning
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
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 =
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"See the user manual, § Undecidable instances and loopy superclasses." ]
    TcRnMessage
TcRnUnexpectedStandaloneDerivingDecl -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal standalone deriving declaration"
    TcRnUnusedVariableInRuleDecl FastString
name Name
var -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rule" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon,
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Forall'd variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
var) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not appear on left hand side"]
    TcRnMessage
TcRnUnexpectedStandaloneKindSig -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal standalone kind signature"
    TcRnIllegalRuleLhs RuleLhsErrReason
errReason FastString
name LHsExpr (GhcPass 'Renamed)
lhs HsExpr (GhcPass 'Renamed)
bad_e -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rule" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
pprRuleName FastString
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon,
           Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
err,
                         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in left-hand side:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
lhs])]
      SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LHS must be of form (f e1 .. en) where f is not forall'd"
      where
        err :: SDoc
err = case RuleLhsErrReason
errReason of
          UnboundVariable RdrName
uv NotInScopeError
nis -> RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
uv NotInScopeError
nis
          RuleLhsErrReason
IllegalExpression -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal expression:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr (GhcPass 'Renamed)
bad_e
    TcRnDuplicateRoleAnnot NonEmpty (LRoleAnnotDecl GhcPs)
list -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate role annotations for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName -> SDoc) -> RdrName -> SDoc
forall a b. (a -> b) -> a -> b
$ RoleAnnotDecl GhcPs -> IdP GhcPs
forall (p :: Pass). RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p)
roleAnnotDeclName RoleAnnotDecl GhcPs
first_decl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
        Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs) -> SDoc)
-> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs) -> SDoc
forall {a} {a}.
Outputable a =>
GenLocated (SrcSpanAnn' a) a -> SDoc
pp_role_annot ([GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)] -> [SDoc])
-> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
-> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
sorted_list)
      where
        sorted_list :: NonEmpty (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
sorted_list = (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
 -> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs) -> Ordering)
-> NonEmpty (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)
-> GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs) -> Ordering
forall {a} {e}.
GenLocated (SrcSpanAnn' a) e
-> GenLocated (SrcSpanAnn' a) e -> Ordering
cmp_loc NonEmpty (LRoleAnnotDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
list
        ((L SrcSpanAnnA
_ RoleAnnotDecl GhcPs
first_decl) :| [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs)]
_) = NonEmpty (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcPs))
sorted_list

        pp_role_annot :: GenLocated (SrcSpanAnn' a) a -> SDoc
pp_role_annot (L SrcSpanAnn' a
loc a
decl) = SDoc -> Arity -> SDoc -> SDoc
hang (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
decl)
                                        Arity
4 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-- written at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc))

        cmp_loc :: GenLocated (SrcSpanAnn' a) e
-> GenLocated (SrcSpanAnn' a) e -> Ordering
cmp_loc = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> GenLocated (SrcSpanAnn' a) e
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA
    TcRnDuplicateKindSig NonEmpty (LStandaloneKindSig GhcPs)
list -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate standalone kind signatures for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (RdrName -> SDoc) -> RdrName -> SDoc
forall a b. (a -> b) -> a -> b
$ StandaloneKindSig GhcPs -> IdP GhcPs
forall (p :: Pass).
StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
standaloneKindSigName StandaloneKindSig GhcPs
first_decl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
        Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs) -> SDoc)
-> [GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs) -> SDoc
forall {a} {a}.
Outputable a =>
GenLocated (SrcSpanAnn' a) a -> SDoc
pp_kisig ([GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)] -> [SDoc])
-> [GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
-> [GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
sorted_list)
      where
        sorted_list :: NonEmpty (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
sorted_list = (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
 -> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs) -> Ordering)
-> NonEmpty (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)
-> GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs) -> Ordering
forall {a} {e}.
GenLocated (SrcSpanAnn' a) e
-> GenLocated (SrcSpanAnn' a) e -> Ordering
cmp_loc NonEmpty (LStandaloneKindSig GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
list
        ((L SrcSpanAnnA
_ StandaloneKindSig GhcPs
first_decl) :| [GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs)]
_) = NonEmpty (GenLocated SrcSpanAnnA (StandaloneKindSig GhcPs))
sorted_list

        pp_kisig :: GenLocated (SrcSpanAnn' a) a -> SDoc
pp_kisig (L SrcSpanAnn' a
loc a
decl) =
          SDoc -> Arity -> SDoc -> SDoc
hang (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
decl) Arity
4 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-- written at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc))

        cmp_loc :: GenLocated (SrcSpanAnn' a) e
-> GenLocated (SrcSpanAnn' a) e -> Ordering
cmp_loc = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> GenLocated (SrcSpanAnn' a) e
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA
    TcRnIllegalDerivStrategy DerivStrategy GhcPs
ds -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal deriving strategy" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DerivStrategy GhcPs -> SDoc
forall a. DerivStrategy a -> SDoc
derivStrategyName DerivStrategy GhcPs
ds
    TcRnMessage
TcRnIllegalMultipleDerivClauses -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal use of multiple, consecutive deriving clauses"
    TcRnNoDerivStratSpecified{} -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text
      String
"No deriving strategy specified. Did you want stock, newtype, or anyclass?"
    TcRnStupidThetaInGadt{} -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No context is allowed on a GADT-style data declaration",
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(You can put a context on each constructor, though.)"]
    TcRnShadowedTyVarNameInFamResult IdP GhcPs
resName -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type variable", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdP GhcPs
RdrName
resName) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"naming a type family result,"
            ] SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"shadows an already bound type variable"
    TcRnIncorrectTyVarOnLhsOfInjCond IdP (GhcPass 'Renamed)
resName LIdP GhcPs
injFrom -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
"Incorrect type variable on the LHS of "
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"injectivity condition"
      , Arity -> SDoc -> SDoc
nest Arity
5
      ( [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected :" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdP (GhcPass 'Renamed)
Name
resName
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Actual   :" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP GhcPs
LocatedN RdrName
injFrom ])]
    TcRnUnknownTyVarsOnRhsOfInjCond [Name]
errorVars -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unknown type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Name] -> SDoc
forall a. [a] -> SDoc
plural [Name]
errorVars
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"on the RHS of injectivity condition:"
           , [Name] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [Name]
errorVars ]
    TcRnBadlyStaged StageCheckReason
reason Arity
bind_lvl Arity
use_lvl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Stage error:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StageCheckReason -> SDoc
pprStageCheckReason StageCheckReason
reason SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is bound at stage" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
bind_lvl,
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but used at stage" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
use_lvl]
    TcRnStageRestriction StageCheckReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC stage restriction:"
             , Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ StageCheckReason -> SDoc
pprStageCheckReason StageCheckReason
reason SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is used in a top-level splice, quasi-quote, or annotation,"
                            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and must be imported, not defined locally"])]
    TcRnTyThingUsedWrong WrongThingSort
sort TcTyThing
thing Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         WrongThingSort -> TcTyThing -> Name -> SDoc
pprTyThingUsedWrong WrongThingSort
sort TcTyThing
thing Name
name
    TcRnCannotDefaultKindVar TyVar
var Type
knd ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot default kind variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
var)
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
knd
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Perhaps enable PolyKinds or add a kind signature" ])
    TcRnUninferrableTyVar [TyVar]
tidied_tvs UninferrableTyVarCtx
context ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
True (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Uninferrable type variable"
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
tidied_tvs
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (TyVar -> SDoc) -> [TyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyVar -> SDoc
pprTyVar [TyVar]
tidied_tvs
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in"
            , UninferrableTyVarCtx -> SDoc
pprUninferrableTyVarCtx UninferrableTyVarCtx
context ]
    TcRnSkolemEscape [TyVar]
escapees TyVar
tv Type
orig_ty ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
True (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot generalise type; skolem" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
escapees
                , SDoc -> SDoc
quotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [TyVar] -> SDoc
pprTyVars [TyVar]
escapees
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"would escape" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
itsOrTheir [TyVar]
escapees SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"scope"
                ]
          , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"if I tried to quantify"
                , TyVar -> SDoc
pprTyVar TyVar
tv
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in this type:"
                ]
          , Arity -> SDoc -> SDoc
nest Arity
2 (Type -> SDoc
pprTidiedType Type
orig_ty)
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(Indeed, I sometimes struggle even printing this correctly,"
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" due to its ill-scoped nature.)"
          ]
    TcRnPatSynEscapedCoercion TyVar
arg NonEmpty TyVar
bad_co_ne -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Iceland Jack!  Iceland Jack! Stop torturing me!"
           , SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern-bound variable")
                Arity
2 (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
arg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyVar -> Type
idType TyVar
arg))
           , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
             SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has a type that mentions pattern-bound coercion"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
bad_co_list SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
                Arity
2 ((TyVar -> SDoc) -> [TyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
bad_co_list)
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Hint: use -fprint-explicit-coercions to see the coercions"
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Probable fix: add a pattern signature" ]
      where
        bad_co_list :: [TyVar]
bad_co_list = NonEmpty TyVar -> [TyVar]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TyVar
bad_co_ne
    TcRnPatSynExistentialInResult Name
name Type
pat_ty [TyVar]
bad_tvs -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The result type of the signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"namely" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pat_ty) ])
        Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"mentions existential type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
bad_tvs
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TyVar]
bad_tvs)
    TcRnPatSynArityMismatch Name
name Arity
decl_arity Arity
missing -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has"
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc -> SDoc
speakNOf Arity
decl_arity (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"argument"))
         Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but its type signature has" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall doc. IsLine doc => Arity -> doc
int Arity
missing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fewer arrows")
    TcRnPatSynInvalidRhs Name
ps_name LPat (GhcPass 'Renamed)
lpat [LIdP (GhcPass 'Renamed)]
_ PatSynInvalidRhsReason
reason -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid right-hand side of bidirectional pattern synonym"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
ps_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
                Arity
2 (PatSynInvalidRhsReason -> SDoc
pprPatSynInvalidRhsReason PatSynInvalidRhsReason
reason)
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RHS pattern:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
lpat ]
    TcRnMessage
TcRnTyFamDepsDisabled -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal injectivity annotation"
    TcRnMessage
TcRnAbstractClosedTyFamDecl -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You may define an abstract closed type family" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"only in a .hs-boot file"
    TcRnPartialFieldSelector FieldLabel
fld -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Use of partial record field selector" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon,
           Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> OccName
forall name. HasOccName name => name -> OccName
occName FieldLabel
fld))]
    TcRnBadFieldAnnotation Arity
n DataCon
con BadFieldAnnotationReason
reason -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (BadFieldAnnotationReason -> SDoc
pprBadFieldAnnotationReason BadFieldAnnotationReason
reason)
         Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"on the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
speakNth Arity
n
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"argument of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con))
    TcRnSuperclassCycle (MkSuperclassCycle Class
cls Bool
definite [SuperclassCycleDetail]
details) ->
      let herald :: SDoc
herald | Bool
definite  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Superclass cycle for"
                 | Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Potential superclass cycle for"
      in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls), Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SuperclassCycleDetail -> SDoc
pprSuperclassCycleDetail (SuperclassCycleDetail -> SDoc)
-> [SuperclassCycleDetail] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SuperclassCycleDetail]
details))]
    TcRnDefaultSigMismatch TyVar
sel_id Type
dm_ty -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The default type signature for"
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
sel_id SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
         Arity
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
dm_ty)
      SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not match its corresponding"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"non-default type signature")
    TcRnTyFamsDisabled TyFamsDisabledReason
reason -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
sort SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
name
      where
        (String
sort, SDoc
name) = case TyFamsDisabledReason
reason of
          TyFamsDisabledFamily Name
n -> (String
"declaration", Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
          TyFamsDisabledInstance TyCon
n -> (String
"instance", TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
n)
    TcRnBadTyConTelescope TyCon
tc -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The kind of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is ill-scoped")
                Arity
2 SDoc
pp_tc_kind
           , SDoc
extra
           , SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Perhaps try this order instead:")
                Arity
2 ([TyVar] -> SDoc
pprTyVars [TyVar]
sorted_tvs) ]
      where
        pp_tc_kind :: SDoc
pp_tc_kind = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Inferred kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
ppr_untidy (TyCon -> Type
tyConKind TyCon
tc)
        ppr_untidy :: Type -> SDoc
ppr_untidy Type
ty = IfaceType -> SDoc
pprIfaceType (Type -> IfaceType
toIfaceType Type
ty)
          -- We need ppr_untidy here because pprType will tidy the type, which
          -- will turn the bogus kind we are trying to report
          --     T :: forall (a::k) k (b::k) -> blah
          -- into a misleadingly sanitised version
          --     T :: forall (a::k) k1 (b::k1) -> blah

        tcbs :: [TyConBinder]
tcbs = TyCon -> [TyConBinder]
tyConBinders TyCon
tc
        tvs :: [TyVar]
tvs  = [TyConBinder] -> [TyVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tcbs
        sorted_tvs :: [TyVar]
sorted_tvs = [TyVar] -> [TyVar]
scopedSort [TyVar]
tvs

        inferred_tvs :: [TyVar]
inferred_tvs  = [ TyConBinder -> TyVar
forall tv argf. VarBndr tv argf -> tv
binderVar TyConBinder
tcb
                        | TyConBinder
tcb <- [TyConBinder]
tcbs, ForAllTyFlag
Inferred ForAllTyFlag -> ForAllTyFlag -> Bool
forall a. Eq a => a -> a -> Bool
== TyConBinder -> ForAllTyFlag
tyConBinderForAllTyFlag TyConBinder
tcb ]
        specified_tvs :: [TyVar]
specified_tvs = [ TyConBinder -> TyVar
forall tv argf. VarBndr tv argf -> tv
binderVar TyConBinder
tcb
                        | TyConBinder
tcb <- [TyConBinder]
tcbs, ForAllTyFlag
Specified ForAllTyFlag -> ForAllTyFlag -> Bool
forall a. Eq a => a -> a -> Bool
== TyConBinder -> ForAllTyFlag
tyConBinderForAllTyFlag TyConBinder
tcb ]

        extra :: SDoc
extra
          | [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
inferred_tvs Bool -> Bool -> Bool
&& [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
specified_tvs
          = SDoc
forall doc. IsOutput doc => doc
empty
          | [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
inferred_tvs
          = SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: Specified variables")
               Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
pp_spec, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"always come first"])
          | [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
specified_tvs
          = SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: Inferred variables")
               Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
pp_inf, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"always come first"])
          | Bool
otherwise
          = SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: Inferred variables")
               Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
pp_inf, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"always come first"]
                       , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"then Specified variables", SDoc
pp_spec]])

        pp_inf :: SDoc
pp_inf  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"namely:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
pprTyVars [TyVar]
inferred_tvs)
        pp_spec :: SDoc
pp_spec = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"namely:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
pprTyVars [TyVar]
specified_tvs)
    TcRnTyFamResultDisabled Name
tc_name LHsTyVarBndr () (GhcPass 'Renamed)
tvb -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal result type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsTyVarBndr () (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Renamed))
tvb SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    TcRnRoleValidationFailed Role
role RoleValidationFailedReason
reason -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Internal error in role inference:",
            Role -> RoleValidationFailedReason -> SDoc
pprRoleValidationFailedReason Role
role RoleValidationFailedReason
reason,
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug"]
    TcRnCommonFieldResultTypeMismatch DataCon
con1 DataCon
con2 FieldLabelString
field_name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructors" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con2,
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"have a common field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
field_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma],
            Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but have different result types"]
    TcRnCommonFieldTypeMismatch DataCon
con1 DataCon
con2 FieldLabelString
field_name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructors" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con2,
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"give different types for field", SDoc -> SDoc
quotes (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
field_name)]
    TcRnClassExtensionDisabled Class
cls DisabledClassExtension
reason -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      Class -> DisabledClassExtension -> SDoc
pprDisabledClassExtension Class
cls DisabledClassExtension
reason
    TcRnDataConParentTypeMismatch DataCon
data_con Type
res_ty_tmpl -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
data_con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"returns type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
actual_res_ty))
         Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instead of an instance of its parent type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
res_ty_tmpl))
      where
        actual_res_ty :: Type
actual_res_ty = DataCon -> Type
dataConOrigResTy DataCon
data_con
    TcRnGADTsDisabled Name
tc_name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal generalised algebraic data declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    TcRnExistentialQuantificationDisabled DataCon
con -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes (\Bool
show_linear_types ->
        SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has existential type variables, a context, or a specialised result type")
           Arity
2 (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con)))
    TcRnGADTDataContext Name
tc_name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A data type declared in GADT style cannot have a context:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    TcRnMultipleConForNewtype Name
tycon Arity
n -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype must have exactly one constructor,",
           Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tycon) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
speakN Arity
n]
    TcRnKindSignaturesDisabled Either (HsType GhcPs) (Name, HsType (GhcPass 'Renamed))
thing -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal kind signature" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ((HsType GhcPs -> SDoc)
-> ((Name, HsType (GhcPass 'Renamed)) -> SDoc)
-> Either (HsType GhcPs) (Name, HsType (GhcPass 'Renamed))
-> SDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name, HsType (GhcPass 'Renamed)) -> SDoc
forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
with_sig Either (HsType GhcPs) (Name, HsType (GhcPass 'Renamed))
thing)
      where
        with_sig :: (a, a) -> SDoc
with_sig (a
tc_name, a
ksig) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
tc_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ksig
    TcRnEmptyDataDeclsDisabled Name
tycon -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tycon) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has no constructors"
    TcRnRoleMismatch Name
var Role
annot Role
inferred -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Role mismatch on variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
var SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
         Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Annotation says", Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
annot
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but role", Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
inferred
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is required" ])
    TcRnRoleCountMismatch Arity
tyvars d :: LRoleAnnotDecl (GhcPass 'Renamed)
d@(L SrcSpanAnnA
_ (RoleAnnotDecl XCRoleAnnotDecl (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
_ [XRec (GhcPass 'Renamed) (Maybe Role)]
annots)) -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Wrong number of roles listed in role annotation;" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
tyvars) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"got" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Arity -> SDoc) -> Arity -> SDoc
forall a b. (a -> b) -> a -> b
$ [GenLocated (SrcAnn NoEpAnns) (Maybe Role)] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [XRec (GhcPass 'Renamed) (Maybe Role)]
[GenLocated (SrcAnn NoEpAnns) (Maybe Role)]
annots) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
         Arity
2 (GenLocated SrcSpanAnnA (RoleAnnotDecl (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LRoleAnnotDecl (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (RoleAnnotDecl (GhcPass 'Renamed))
d)
    TcRnIllegalRoleAnnotation (RoleAnnotDecl XCRoleAnnotDecl (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
tycon [XRec (GhcPass 'Renamed) (Maybe Role)]
_) -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal role annotation for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> LocatedN Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass 'Renamed)
LocatedN Name
tycon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
';' SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"they are allowed only for datatypes and classes.")
    TcRnRoleAnnotationsDisabled  TyCon
tc -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal role annotation for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc
    TcRnIncoherentRoles TyCon
_ -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Roles other than" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"nominal") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for class parameters can lead to incoherence.")
    TcRnBindVarAlreadyInScope [LocatedN RdrName]
tv_names_in_scope
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
          [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [LocatedN RdrName] -> SDoc
forall a. [a] -> SDoc
plural [LocatedN RdrName]
tv_names_in_scope
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
",") ((LocatedN RdrName -> SDoc) -> [LocatedN RdrName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes (SDoc -> SDoc)
-> (LocatedN RdrName -> SDoc) -> LocatedN RdrName -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [LocatedN RdrName]
tv_names_in_scope))
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [LocatedN RdrName] -> SDoc
forall a. [a] -> SDoc
isOrAre [LocatedN RdrName]
tv_names_in_scope
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"already in scope."
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type applications in patterns must bind fresh variables, without shadowing."
          ]

    TcRnBindMultipleVariables HsDocContext
ctx LocatedN RdrName
tv_name_w_loc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"`" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
tv_name_w_loc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"'" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"would be bound multiple times by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsDocContext -> SDoc
pprHsDocContext HsDocContext
ctx SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"."

    TcRnUnexpectedKindVar RdrName
tv_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected kind variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
tv_name)

    TcRnNegativeNumTypeLiteral HsType GhcPs
tyLit
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal literal in type (type literals must not be negative):" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
tyLit

    TcRnIllegalKind HsTypeOrSigType GhcPs
ty_thing Bool
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (HsTypeOrSigType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTypeOrSigType GhcPs
ty_thing)

    TcRnPrecedenceParsingError (OpName, Fixity)
op1 (OpName, Fixity)
op2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Precedence parsing error")
           Arity
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot mix", (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op1, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and",
           (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op2,
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the same infix expression"])

    TcRnSectionPrecedenceError (OpName, Fixity)
op (OpName, Fixity)
arg_op HsExpr GhcPs
section
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The operator" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of a section",
             Arity -> SDoc -> SDoc
nest Arity
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must have lower precedence than that of the operand,",
                          Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"namely" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
arg_op)]),
             Arity -> SDoc -> SDoc
nest Arity
4 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the section:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
section))]

    TcRnUnexpectedPatSigType HsPatSigType GhcPs
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal type signature:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (HsPatSigType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType GhcPs
ty))
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type signatures are only allowed in patterns with ScopedTypeVariables")

    TcRnIllegalKindSignature HsType GhcPs
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal kind signature:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
ty)

    TcRnUnusedQuantifiedTypeVar HsDocContext
doc HsTyVarBndrExistentialFlag
tyVar
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unused quantified type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (HsTyVarBndrExistentialFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyVarBndrExistentialFlag
tyVar)
                , HsDocContext -> SDoc
inHsDocContext HsDocContext
doc ]

    TcRnDataKindsError TypeOrKind
typeOrKind HsType GhcPs
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ TypeOrKind -> String
levelString TypeOrKind
typeOrKind) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
thing)

    TcRnTypeSynonymCycle TySynCycleTyCons
decl_or_tcs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cycle in type synonym declarations:"
               , Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Either
   TyCon (GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed)))
 -> SDoc)
-> [Either
      TyCon (GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed)))]
-> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Either TyCon (GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed)))
-> SDoc
forall {a}.
Either
  TyCon (GenLocated (SrcSpanAnn' a) (TyClDecl (GhcPass 'Renamed)))
-> SDoc
ppr_decl TySynCycleTyCons
[Either
   TyCon (GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed)))]
decl_or_tcs)) ]
      where
        ppr_decl :: Either
  TyCon (GenLocated (SrcSpanAnn' a) (TyClDecl (GhcPass 'Renamed)))
-> SDoc
ppr_decl = \case
          Right (L SrcSpanAnn' a
loc TyClDecl (GhcPass 'Renamed)
decl) -> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyClDecl (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyClDecl (GhcPass 'Renamed)
decl
          Left TyCon
tc ->
            let n :: Name
n = TyCon -> Name
tyConName TyCon
tc
            in SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> Name
tyConName TyCon
tc)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"from external module"
    TcRnZonkerMessage ZonkerMessage
err
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ ZonkerMessage -> SDoc
pprZonkerMessage ZonkerMessage
err
    TcRnInterfaceError IfaceMessage
reason
      -> DiagnosticOpts IfaceMessage -> IfaceMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (TcRnMessageOpts -> IfaceMessageOpts
tcOptsIfaceOpts DiagnosticOpts TcRnMessage
TcRnMessageOpts
opts) IfaceMessage
reason
    TcRnSelfImport ModuleName
imp_mod_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A module cannot import itself:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod_name
    TcRnNoExplicitImportList ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have an explicit import list"
    TcRnSafeImportsDisabled ModuleName
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"safe import can't be used as Safe Haskell isn't on!"
    TcRnDeprecatedModule ModuleName
mod WarningTxt (GhcPass 'Renamed)
txt
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
extra SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon,
               Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenLocated
   SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
 -> SDoc)
-> [GenLocated
      SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
-> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (StringLiteral -> SDoc
forall a. Outputable a => a -> SDoc
ppr (StringLiteral -> SDoc)
-> (GenLocated
      SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
    -> StringLiteral)
-> GenLocated
     SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed)
-> StringLiteral
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed)
 -> StringLiteral)
-> (GenLocated
      SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
    -> WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
-> GenLocated
     SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
-> WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc) [GenLocated
   SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg)) ]
         where
          (String
extra, [GenLocated
   SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg) = case WarningTxt (GhcPass 'Renamed)
txt of
            WarningTxt Maybe (Located InWarningCategory)
_ Located SourceText
_ [GenLocated
   SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg -> (String
"", [GenLocated
   SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg)
            DeprecatedTxt Located SourceText
_ [GenLocated
   SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg -> (String
" is deprecated", [GenLocated
   SrcSpan (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg)
    TcRnCompatUnqualifiedImport ImportDecl GhcPs
decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
         [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To ensure compatibility with future core libraries changes"
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"imports to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
decl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"should be"
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"either qualified or have an explicit import list."
         ]
    TcRnRedundantSourceImport ModuleName
mod_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unnecessary {-# SOURCE #-} in the import of module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
    TcRnImportLookup ImportLookupReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         ImportLookupReason -> SDoc
pprImportLookup ImportLookupReason
reason
    TcRnUnusedImport ImportDecl (GhcPass 'Renamed)
decl UnusedImportReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         ImportDecl (GhcPass 'Renamed) -> UnusedImportReason -> SDoc
pprUnusedImport ImportDecl (GhcPass 'Renamed)
decl UnusedImportReason
reason
    TcRnDuplicateDecls OccName
name NonEmpty Name
sorted_names
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple declarations of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
               SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name),
                -- NB. print the OccName, not the Name, because the
                -- latter might not be in scope in the RdrEnv and so will
                -- be printed qualified.
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Declared at:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
               [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (NonEmpty SDoc -> [SDoc]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty SDoc -> [SDoc]) -> NonEmpty SDoc -> [SDoc]
forall a b. (a -> b) -> a -> b
$ SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcLoc -> SDoc) -> (Name -> SrcLoc) -> Name -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SrcLoc
nameSrcLoc (Name -> SDoc) -> NonEmpty Name -> NonEmpty SDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Name
sorted_names)]
    TcRnMessage
TcRnPackageImportsDisabled
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Package-qualified imports are not enabled"
    TcRnIllegalDataCon RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal data constructor name", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)]
    TcRnNestedForallsContexts NestedForallsContextsIn
entity
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot contain nested"
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
forAllLit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"s or contexts"
         where
           what :: SDoc
what = case NestedForallsContextsIn
entity of
             NestedForallsContextsIn
NFC_Specialize -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SPECIALISE instance type"
             NestedForallsContextsIn
NFC_ViaType -> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"via") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type"
             NestedForallsContextsIn
NFC_GadtConSig -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GADT constructor type signature"
             NestedForallsContextsIn
NFC_InstanceHead -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Instance head"
             NestedForallsContextsIn
NFC_StandaloneDerivedInstanceHead -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Standalone-derived instance head"
             NestedForallsContextsIn
NFC_DerivedClassType -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Derived class type"
    TcRnMessage
TcRnRedundantRecordWildcard
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record wildcard does not bind any new variables"
    TcRnUnusedRecordWildcard [Name]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No variables bound in the record wildcard match are used"
    TcRnUnusedName OccName
name UnusedNameProv
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         OccName -> UnusedNameProv -> SDoc
pprUnusedName OccName
name UnusedNameProv
reason
    TcRnQualifiedBinder RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Qualified name in binding position:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name
    TcRnTypeApplicationsDisabled TypeApplication
ty_app
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal visible" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"application" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ctx SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SDoc
arg
         where
           arg :: SDoc
arg = case TypeApplication
ty_app of
            TypeApplication HsType GhcPs
ty TypeOrKind
_ -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> HsType GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcPs
ty
            TypeApplicationInPattern HsConPatTyArg GhcPs
ty_app -> HsConPatTyArg GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsConPatTyArg GhcPs
ty_app
           what :: SDoc
what = case TypeApplication
ty_app of
             TypeApplication HsType GhcPs
_ TypeOrKind
ty_or_ki ->
              case TypeOrKind
ty_or_ki of
                TypeOrKind
TypeLevel -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type"
                TypeOrKind
KindLevel -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"kind"
             TypeApplicationInPattern HsConPatTyArg GhcPs
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type"
           ctx :: SDoc
ctx = case TypeApplication
ty_app of
            TypeApplicationInPattern HsConPatTyArg GhcPs
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a pattern"
            TypeApplication
_                          -> SDoc
forall doc. IsOutput doc => doc
empty
    TcRnInvalidRecordField Name
con FieldLabelString
field
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con),
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have field", SDoc -> SDoc
quotes (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
field)]
    TcRnTupleTooLarge Arity
tup_size
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall doc. IsLine doc => Arity -> doc
int Arity
tup_size SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-tuple is too large for GHC",
              Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"max size is" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall doc. IsLine doc => Arity -> doc
int Arity
mAX_TUPLE_SIZE)),
              Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Workaround: use nested tuples or define a data type")]
    TcRnCTupleTooLarge Arity
tup_size
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constraint tuple arity too large:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall doc. IsLine doc => Arity -> doc
int Arity
tup_size
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"max arity =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall doc. IsLine doc => Arity -> doc
int Arity
mAX_CTUPLE_SIZE))
            Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Instead, use a nested tuple")
    TcRnIllegalInferredTyVars NonEmpty (HsTyVarBndr Specificity GhcPs)
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Inferred type variables are not allowed"
    TcRnAmbiguousName GlobalRdrEnv
gre_env RdrName
name NonEmpty GlobalRdrElt
gres
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous occurrence" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"It could refer to"
              , Arity -> SDoc -> SDoc
nest Arity
3 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
msgs) ]
         where
           GlobalRdrElt
np1 NE.:| [GlobalRdrElt]
nps = NonEmpty GlobalRdrElt
gres
           msgs :: [SDoc]
msgs = SDoc -> SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> doc -> [doc] -> [doc]
punctuateFinal SDoc
forall doc. IsLine doc => doc
comma SDoc
forall doc. IsLine doc => doc
dot ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"either" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
ppr_gre GlobalRdrElt
np1
                 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"    or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
ppr_gre GlobalRdrElt
np | GlobalRdrElt
np <- [GlobalRdrElt]
nps]

           ppr_gre :: GlobalRdrElt -> SDoc
ppr_gre GlobalRdrElt
gre = GlobalRdrEnv -> GlobalRdrElt -> SDoc
pprAmbiguousGreName GlobalRdrEnv
gre_env GlobalRdrElt
gre

    TcRnBindingNameConflict RdrName
name NonEmpty SrcSpan
locs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Conflicting definitions for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name),
               SDoc
locations]
         where
           locations :: SDoc
locations =
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bound at:"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((SrcSpan -> SrcSpan -> Ordering) -> [SrcSpan] -> [SrcSpan]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (NonEmpty SrcSpan -> [SrcSpan]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty SrcSpan
locs)))
    TcRnNonCanonicalDefinition NonCanonicalDefinition
reason LHsSigType (GhcPass 'Renamed)
inst_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         LHsSigType (GhcPass 'Renamed) -> NonCanonicalDefinition -> SDoc
pprNonCanonicalDefinition LHsSigType (GhcPass 'Renamed)
inst_ty NonCanonicalDefinition
reason
    TcRnMessage
TcRnImplicitImportOfPrelude
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Prelude") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"implicitly imported."
    TcRnMissingMain Bool
explicit_export_list Module
main_mod OccName
main_occ
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
ppMainFn OccName
main_occ
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
defOrExp SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
main_mod)
      where
        defOrExp :: SDoc
        defOrExp :: SDoc
defOrExp | Bool
explicit_export_list = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exported by"
                 | Bool
otherwise            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"defined in"
    TcRnGhciUnliftedBind TyVar
id
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHCi can't bind a variable of unlifted type:"
             , Arity -> SDoc -> SDoc
nest Arity
2 (TyVar -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc TyVar
id SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyVar -> Type
idType TyVar
id)) ]
    TcRnGhciMonadLookupFail String
ty Maybe [GlobalRdrElt]
lookups
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't find type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
ambig_msg)
           Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When checking that" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a monad that can execute GHCi statements.")
      where
        pp_ty :: SDoc
pp_ty = SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
ty)
        ambig_msg :: SDoc
ambig_msg = case Maybe [GlobalRdrElt]
lookups of
          Just (GlobalRdrElt
_:GlobalRdrElt
_:[GlobalRdrElt]
_) -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type is ambiguous."
          Maybe [GlobalRdrElt]
_            -> SDoc
forall doc. IsOutput doc => doc
empty
    TcRnMessage
TcRnIllegalQuasiQuotes -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Quasi-quotes are not permitted without QuasiQuotes"
    TcRnTHError THError
err -> THError -> DecoratedSDoc
pprTHError THError
err
    TcRnPatersonCondFailure PatersonCondFailure
reason PatersonCondFailureContext
ctxt Type
lhs Type
rhs ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ PatersonCondFailure
-> PatersonCondFailureContext -> Type -> Type -> SDoc
pprPatersonCondFailure PatersonCondFailure
reason PatersonCondFailureContext
ctxt Type
lhs Type
rhs
    TcRnIllegalInvisTyVarBndr LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)
bndr ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal invisible type variable binder:")
           Arity
2 (GenLocated
  SrcSpanAnnA
  (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)
GenLocated
  SrcSpanAnnA
  (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
bndr)

    TcRnInvalidInvisTyVarBndr Name
name LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)
hs_bndr ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid invisible type variable binder:")
                  Arity
2 (GenLocated
  SrcSpanAnnA
  (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)
GenLocated
  SrcSpanAnnA
  (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
hs_bndr)
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"There is no matching forall-bound variable"
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the standalone kind signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB." SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Only" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"forall a.") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-quantification matches invisible binders,",
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"whereas" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"forall {a}.") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"forall a ->") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"do not."
             ]]

    TcRnMessage
TcRnDeprecatedInvisTyArgInConPat ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
cat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type applications in constructor patterns will require"
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the TypeAbstractions extension starting from GHC 9.12." ]

    TcRnInvisBndrWithoutSig Name
_ LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)
hs_bndr ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid invisible type variable binder:")
                  Arity
2 (GenLocated
  SrcSpanAnnA
  (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)
GenLocated
  SrcSpanAnnA
  (HsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed))
hs_bndr)
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Either a standalone kind signature (SAKS)"
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or a complete user-supplied kind (CUSK, legacy feature)"
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is required to use invisible binders." ]

    TcRnImplicitRhsQuantification LocatedN RdrName
kv -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
kv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"occurs free on the RHS of the type declaration"
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the future GHC will no longer implicitly quantify over such variables"
           ]

  diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
    TcRnUnknownMessage UnknownDiagnostic (DiagnosticOpts TcRnMessage)
m
      -> UnknownDiagnostic TcRnMessageOpts -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason UnknownDiagnostic (DiagnosticOpts TcRnMessage)
UnknownDiagnostic TcRnMessageOpts
m
    TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
      -> case TcRnMessageDetailed
msg_with_info of
           TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> TcRnMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason TcRnMessage
m
    TcRnWithHsDocContext HsDocContext
_ TcRnMessage
msg
      -> TcRnMessage -> DiagnosticReason
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
    TcRnSolverDepthError {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRedundantConstraints {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantConstraints
    TcRnInaccessibleCode {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnInaccessibleCode
    TcRnInaccessibleCoAxBranch {}
      -> 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
    TcRnInvalidWarningCategory{}
      -> DiagnosticReason
ErrorWithoutFlag
    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
    TcRnIllegalHsBootOrSigDecl {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBootMismatch {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRecursivePatternSynonym{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPartialTypeSigTyVarMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPartialTypeSigBadQuantifier{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMissingSignature MissingSignature
what Exported
exported
      -> NonEmpty WarningFlag -> DiagnosticReason
WarningWithFlags (NonEmpty WarningFlag -> DiagnosticReason)
-> NonEmpty WarningFlag -> DiagnosticReason
forall a b. (a -> b) -> a -> b
$ MissingSignature -> Exported -> NonEmpty WarningFlag
missingSignatureWarningFlags MissingSignature
what Exported
exported
    TcRnPolymorphicBinderMissingSig{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingLocalSignatures
    TcRnOverloadedSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTupleConstraintInst{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUserTypeError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnConstraintInKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnboxedTupleOrSumTypeFuncArg{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLinearFuncInKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnForAllEscapeError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSimplifiableConstraint{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnSimplifiableClassConstraints
    TcRnArityMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalInstance IllegalInstanceReason
rea
      -> IllegalInstanceReason -> DiagnosticReason
illegalInstanceReason IllegalInstanceReason
rea
    TcRnVDQInTermType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadQuantPredHead{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTupleConstraint{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNonTypeVarArgInConstraint{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalImplicitParam{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalConstraintSynonymOfKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnOversaturatedVisibleKindArg{}
      -> 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
    TcRnDuplicateFieldExport {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAmbiguousFieldInUpdate {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAmbiguousRecordUpdate{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnAmbiguousFields
    TcRnMissingFields{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingFields
    TcRnFieldUpdateInvalidType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMissingStrictFields{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadRecordUpdate{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalStaticExpression {}
      -> 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
    TcRnLookupInstance Class
_ [Type]
_ LookupInstanceErrReason
_
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnLazyGADTPattern
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnArrowProcGADTPattern
      -> 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
    TcRnTermNameInType {}
      -> 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 (GhcPass 'Renamed))
  (ForeignImport (GhcPass 'Renamed))
_ 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
    TcRnRecSelectorEscapedTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynNotBidirectional{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalDerivingItem{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedAnnotation{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalRecordSyntax{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidVisibleKindArgument{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTooManyBinders{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDifferentNamesForTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDisconnectedTyVar{}
      -> 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
    TcRnPragmaWarning{WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: TcRnMessage -> WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: WarningTxt (GhcPass 'Renamed)
pragma_warning_msg}
      -> WarningCategory -> DiagnosticReason
WarningWithCategory (WarningTxt (GhcPass 'Renamed) -> WarningCategory
forall pass. WarningTxt pass -> WarningCategory
warningTxtCategory WarningTxt (GhcPass 'Renamed)
pragma_warning_msg)
    TcRnDifferentExportWarnings Name
_ NonEmpty SrcSpan
_
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIncompleteExportWarnings Name
_ NonEmpty SrcSpan
_
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnIncompleteExportWarnings
    TcRnIllegalHsigDefaultMethods{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnHsigFixityMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnHsigShapeMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnHsigMissingModuleExport{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadGenericMethod{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnWarningMinimalDefIncomplete{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnDefaultMethodForPragmaLacksBinding{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIgnoreSpecialisePragmaOnDefMethod{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnBadMethodErr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnIllegalTypeData
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalQuasiQuotes{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTHError THError
err
      -> THError -> DiagnosticReason
thErrorReason THError
err
    TcRnTypeDataForbids{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalNewtype{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnsatisfiedMinimalDef{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag
Opt_WarnMissingMethods)
    TcRnMisplacedInstSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoRebindableSyntaxRecordDot{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoFieldPunsRecordDot{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnListComprehensionDuplicateBinding{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnEmptyStmtsGroup{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLastStmtNotExpr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedStatementInContext{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSectionWithoutParentheses{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalImplicitParameterBindings{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTupleSection{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCapturedTermName{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTermVariableCapture
    TcRnBindingOfExistingName{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMultipleFixityDecls{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalPatternSynonymDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalClassBinding{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnOrphanCompletePragma{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnEmptyCase{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNonStdGuards{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnDuplicateSigDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMisplacedSigDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedDefaultSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDuplicateMinimalSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLoopySuperclassSolve{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnLoopySuperclassSolve
    TcRnUnexpectedStandaloneDerivingDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnusedVariableInRuleDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedStandaloneKindSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalRuleLhs{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDuplicateRoleAnnot{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDuplicateKindSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalDerivStrategy{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalMultipleDerivClauses{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoDerivStratSpecified{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingDerivingStrategies
    TcRnStupidThetaInGadt{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnShadowedTyVarNameInFamResult{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIncorrectTyVarOnLhsOfInjCond{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnknownTyVarsOnRhsOfInjCond{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadlyStaged{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnStageRestriction{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTyThingUsedWrong{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotDefaultKindVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUninferrableTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSkolemEscape{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynEscapedCoercion{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynExistentialInResult{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynArityMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynInvalidRhs{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTyFamDepsDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAbstractClosedTyFamDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPartialFieldSelector{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnPartialFields
    TcRnBadFieldAnnotation Arity
_ DataCon
_ BadFieldAnnotationReason
LazyFieldsDisabled
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadFieldAnnotation{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnSuperclassCycle{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDefaultSigMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTyFamsDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadTyConTelescope {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTyFamResultDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRoleValidationFailed{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCommonFieldResultTypeMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCommonFieldTypeMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnClassExtensionDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDataConParentTypeMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnGADTsDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnExistentialQuantificationDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnGADTDataContext{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMultipleConForNewtype{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnKindSignaturesDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnEmptyDataDeclsDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRoleMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRoleCountMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalRoleAnnotation{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRoleAnnotationsDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIncoherentRoles{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBindVarAlreadyInScope{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBindMultipleVariables{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedKindVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNegativeNumTypeLiteral{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPrecedenceParsingError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSectionPrecedenceError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedPatSigType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalKindSignature{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnusedQuantifiedTypeVar{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedForalls
    TcRnDataKindsError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTypeSynonymCycle{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnZonkerMessage ZonkerMessage
msg
      -> ZonkerMessage -> DiagnosticReason
zonkerMessageReason ZonkerMessage
msg
    TcRnInterfaceError IfaceMessage
err
      -> IfaceMessage -> DiagnosticReason
interfaceErrorReason IfaceMessage
err
    TcRnSelfImport{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoExplicitImportList{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingImportList
    TcRnSafeImportsDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDeprecatedModule ModuleName
_ WarningTxt (GhcPass 'Renamed)
txt
      -> WarningCategory -> DiagnosticReason
WarningWithCategory (WarningTxt (GhcPass 'Renamed) -> WarningCategory
forall pass. WarningTxt pass -> WarningCategory
warningTxtCategory WarningTxt (GhcPass 'Renamed)
txt)
    TcRnCompatUnqualifiedImport{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnCompatUnqualifiedImports
    TcRnRedundantSourceImport{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnImportLookup{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnusedImport{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedImports
    TcRnDuplicateDecls{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnPackageImportsDisabled
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalDataCon{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNestedForallsContexts{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnRedundantRecordWildcard
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantRecordWildcards
    TcRnUnusedRecordWildcard{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedRecordWildcards
    TcRnUnusedName OccName
_ UnusedNameProv
prov
      -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag -> DiagnosticReason)
-> WarningFlag -> DiagnosticReason
forall a b. (a -> b) -> a -> b
$ case UnusedNameProv
prov of
        UnusedNameProv
UnusedNameTopDecl -> WarningFlag
Opt_WarnUnusedTopBinds
        UnusedNameImported ModuleName
_ -> WarningFlag
Opt_WarnUnusedTopBinds
        UnusedNameProv
UnusedNameTypePattern -> WarningFlag
Opt_WarnUnusedTypePatterns
        UnusedNameProv
UnusedNameMatch -> WarningFlag
Opt_WarnUnusedMatches
        UnusedNameProv
UnusedNameLocalBind -> WarningFlag
Opt_WarnUnusedLocalBinds
    TcRnQualifiedBinder{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTypeApplicationsDisabled{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidRecordField{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTupleTooLarge{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCTupleTooLarge{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalInferredTyVars{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAmbiguousName{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBindingNameConflict{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNonCanonicalDefinition (NonCanonicalMonoid NonCanonical_Monoid
_) LHsSigType (GhcPass 'Renamed)
_
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnNonCanonicalMonoidInstances
    TcRnNonCanonicalDefinition (NonCanonicalMonad NonCanonical_Monad
_) LHsSigType (GhcPass 'Renamed)
_
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnNonCanonicalMonadInstances
    TcRnImplicitImportOfPrelude {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnImplicitPrelude
    TcRnMissingMain {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnGhciUnliftedBind {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnGhciMonadLookupFail {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMissingRoleAnnotation{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingRoleAnnotations
    TcRnIllegalInvisTyVarBndr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDeprecatedInvisTyArgInConPat {}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnInvalidInvisTyVarBndr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvisBndrWithoutSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnImplicitRhsQuantification{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnImplicitRhsQuantification
    TcRnPatersonCondFailure{}
      -> DiagnosticReason
ErrorWithoutFlag

  diagnosticHints :: TcRnMessage -> [GhcHint]
diagnosticHints = \case
    TcRnUnknownMessage UnknownDiagnostic (DiagnosticOpts TcRnMessage)
m
      -> UnknownDiagnostic TcRnMessageOpts -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic (DiagnosticOpts TcRnMessage)
UnknownDiagnostic TcRnMessageOpts
m
    TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
      -> case TcRnMessageDetailed
msg_with_info of
           TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> TcRnMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
m
    TcRnWithHsDocContext HsDocContext
_ TcRnMessage
msg
      -> TcRnMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
msg
    TcRnSolverReport SolverReportWithCtxt
_ DiagnosticReason
_ [GhcHint]
hints
      -> [GhcHint]
hints
    TcRnSolverDepthError {}
      -> [GhcHint
SuggestIncreaseReductionDepth]
    TcRnRedundantConstraints{}
      -> [GhcHint]
noHints
    TcRnInaccessibleCode{}
      -> [GhcHint]
noHints
    TcRnInaccessibleCoAxBranch{}
      -> [GhcHint]
noHints
    TcRnTypeDoesNotHaveFixedRuntimeRep{}
      -> [GhcHint]
noHints
    TcRnImplicitLift{}
      -> [GhcHint]
noHints
    TcRnUnusedPatternBinds{}
      -> [GhcHint]
noHints
    TcRnDodgyImports{}
      -> [GhcHint]
noHints
    TcRnDodgyExports{}
      -> [GhcHint]
noHints
    TcRnMissingImportList{}
      -> [GhcHint]
noHints
    TcRnUnsafeDueToPlugin{}
      -> [GhcHint]
noHints
    TcRnModMissingRealSrcSpan{}
      -> [GhcHint]
noHints
    TcRnIdNotExportedFromModuleSig Name
name Module
mod
      -> [Name -> Maybe Module -> GhcHint
SuggestAddToHSigExportList Name
name (Maybe Module -> GhcHint) -> Maybe Module -> GhcHint
forall a b. (a -> b) -> a -> b
$ Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod]
    TcRnIdNotExportedFromLocalSig Name
name
      -> [Name -> Maybe Module -> GhcHint
SuggestAddToHSigExportList Name
name Maybe Module
forall a. Maybe a
Nothing]
    TcRnShadowedName{}
      -> [GhcHint]
noHints
    TcRnInvalidWarningCategory{}
      -> [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
    TcRnIllegalHsBootOrSigDecl {}
      -> [GhcHint]
noHints
    TcRnBootMismatch HsBootOrSig
boot_or_sig BootMismatch
err
      | HsBootOrSig
Hsig <- HsBootOrSig
boot_or_sig
      , BootMismatch TyThing
_ TyThing
_ (BootMismatchedTyCons TyCon
_boot_tc TyCon
real_tc NonEmpty BootTyConMismatch
tc_errs) <- BootMismatch
err
      , (BootTyConMismatch -> Bool) -> [BootTyConMismatch] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BootTyConMismatch -> Bool
is_synAbsData_etaReduce (NonEmpty BootTyConMismatch -> [BootTyConMismatch]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty BootTyConMismatch
tc_errs)
      -> [TyCon -> GhcHint
SuggestEtaReduceAbsDataTySyn TyCon
real_tc]
      | Bool
otherwise
      -> [GhcHint]
noHints
      where
        is_synAbsData_etaReduce :: BootTyConMismatch -> Bool
is_synAbsData_etaReduce (SynAbstractData SynAbstractDataError
SynAbsDataTySynNotNullary) = Bool
True
        is_synAbsData_etaReduce BootTyConMismatch
_ = Bool
False
    TcRnRecursivePatternSynonym{}
      -> [GhcHint]
noHints
    TcRnPartialTypeSigTyVarMismatch{}
      -> [GhcHint]
noHints
    TcRnPartialTypeSigBadQuantifier{}
      -> [GhcHint]
noHints
    TcRnMissingSignature {}
      -> [GhcHint]
noHints
    TcRnPolymorphicBinderMissingSig{}
      -> [GhcHint]
noHints
    TcRnOverloadedSig{}
      -> [GhcHint]
noHints
    TcRnTupleConstraintInst{}
      -> [GhcHint]
noHints
    TcRnUserTypeError{}
      -> [GhcHint]
noHints
    TcRnConstraintInKind{}
      -> [GhcHint]
noHints
    TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
tuple_or_sum Type
_
      -> [Extension -> GhcHint
suggestExtension (Extension -> GhcHint) -> Extension -> GhcHint
forall a b. (a -> b) -> a -> b
$ UnboxedTupleOrSum -> Extension
unboxedTupleOrSumExtension UnboxedTupleOrSum
tuple_or_sum]
    TcRnLinearFuncInKind{}
      -> [GhcHint]
noHints
    TcRnForAllEscapeError{}
      -> [GhcHint]
noHints
    TcRnVDQInTermType{}
      -> [GhcHint]
noHints
    TcRnBadQuantPredHead{}
      -> [GhcHint]
noHints
    TcRnIllegalTupleConstraint{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ConstraintKinds]
    TcRnNonTypeVarArgInConstraint{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.FlexibleContexts]
    TcRnIllegalImplicitParam{}
      -> [GhcHint]
noHints
    TcRnIllegalConstraintSynonymOfKind{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ConstraintKinds]
    TcRnOversaturatedVisibleKindArg{}
      -> [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
    TcRnSimplifiableConstraint{}
      -> [GhcHint]
noHints
    TcRnArityMismatch{}
      -> [GhcHint]
noHints
    TcRnIllegalInstance IllegalInstanceReason
rea
      -> IllegalInstanceReason -> [GhcHint]
illegalInstanceHints IllegalInstanceReason
rea
    TcRnMonomorphicBindings [Name]
bindings
      -> case [Name]
bindings of
          []     -> [GhcHint]
noHints
          (Name
x:[Name]
xs) -> [AvailableBindings -> GhcHint
SuggestAddTypeSignatures (AvailableBindings -> GhcHint) -> AvailableBindings -> GhcHint
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> AvailableBindings
NamedBindings (Name
x Name -> [Name] -> NonEmpty Name
forall a. a -> [a] -> NonEmpty a
NE.:| [Name]
xs)]
    TcRnOrphanInstance Either ClsInst FamInst
clsOrFamInst
      -> [SuggestFixOrphanInst { isFamilyInstance :: Maybe FamFlavor
isFamilyInstance = Maybe FamFlavor
isFam }]
        where
          isFam :: Maybe FamFlavor
isFam = case Either ClsInst FamInst
clsOrFamInst :: Either ClsInst FamInst of
            Left  ClsInst
_clsInst -> Maybe FamFlavor
forall a. Maybe a
Nothing
            Right FamInst
famInst  -> FamFlavor -> Maybe FamFlavor
forall a. a -> Maybe a
Just (FamFlavor -> Maybe FamFlavor) -> FamFlavor -> Maybe FamFlavor
forall a b. (a -> b) -> a -> b
$ FamInst -> FamFlavor
fi_flavor FamInst
famInst
    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 VarSet
_ 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
    TcRnDuplicateFieldExport {}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DuplicateRecordFields]
    TcRnAmbiguousFieldInUpdate {}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DisambiguateRecordFields]
    TcRnAmbiguousRecordUpdate{}
      -> [GhcHint]
noHints
    TcRnMissingFields{}
      -> [GhcHint]
noHints
    TcRnFieldUpdateInvalidType{}
      -> [GhcHint]
noHints
    TcRnMissingStrictFields{}
      -> [GhcHint]
noHints
    TcRnBadRecordUpdate{}
      -> [GhcHint]
noHints
    TcRnIllegalStaticExpression {}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.StaticPointers]
    TcRnStaticFormNotClosed{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnUselessTypeable
      -> [GhcHint]
noHints
    TcRnDerivingDefaults{}
      -> [GhcHint
useDerivingStrategies]
    TcRnNonUnaryTypeclassConstraint{}
      -> [GhcHint]
noHints
    TcRnPartialTypeSignatures SuggestPartialTypeSignatures
suggestParSig [Type]
_
      -> case SuggestPartialTypeSignatures
suggestParSig of
           SuggestPartialTypeSignatures
YesSuggestPartialTypeSignatures
             -> let info :: SDoc
info = String -> SDoc
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
    TcRnLookupInstance Class
_ [Type]
_ LookupInstanceErrReason
_
      -> [GhcHint]
noHints
    TcRnMessage
TcRnLazyGADTPattern
      -> [GhcHint]
noHints
    TcRnMessage
TcRnArrowProcGADTPattern
      -> [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 (NameSpace -> GhcHint) -> NameSpace -> GhcHint
forall a b. (a -> b) -> a -> b
$ Name -> NameSpace
nameNameSpace Name
nm]
      | Bool
otherwise
      -> [GhcHint]
noHints
    TcRnNotInScope NotInScopeError
err RdrName
_ [ImportError]
_ [GhcHint]
hints
      -> NotInScopeError -> [GhcHint]
scopeErrorHints NotInScopeError
err [GhcHint] -> [GhcHint] -> [GhcHint]
forall a. [a] -> [a] -> [a]
++ [GhcHint]
hints
    TcRnTermNameInType RdrName
_ [GhcHint]
hints
      -> [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 TyCon
tc [Type]
_ <- TypeCannotBeMarshaledReason
why
             -> let tc_nm :: Name
tc_nm = TyCon -> Name
tyConName TyCon
tc
                    dc :: Name
dc = DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ [DataCon] -> DataCon
forall a. HasCallStack => [a] -> a
head ([DataCon] -> DataCon) -> [DataCon] -> DataCon
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
tc
                in [ OccName -> ImportSuggestion -> GhcHint
ImportSuggestion (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
dc)
                   (ImportSuggestion -> GhcHint) -> ImportSuggestion -> GhcHint
forall a b. (a -> b) -> a -> b
$ Maybe (ModuleName, Bool) -> OccName -> ImportSuggestion
ImportDataCon Maybe (ModuleName, Bool)
forall a. Maybe a
Nothing (Name -> OccName
nameOccName Name
tc_nm) ]
             | TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded <- TypeCannotBeMarshaledReason
why
             -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UnliftedFFITypes]
           IllegalForeignTypeReason
_ -> [GhcHint]
noHints
    TcRnInvalidCIdentifier{}
      -> [GhcHint]
noHints
    TcRnExpectedValueId{}
      -> [GhcHint]
noHints
    TcRnRecSelectorEscapedTyVar{}
      -> [GhcHint
SuggestPatternMatchingSyntax]
    TcRnPatSynNotBidirectional{}
      -> [GhcHint]
noHints
    TcRnIllegalDerivingItem{}
      -> [GhcHint]
noHints
    TcRnUnexpectedAnnotation{}
      -> [GhcHint]
noHints
    TcRnIllegalRecordSyntax{}
      -> [GhcHint]
noHints
    TcRnInvalidVisibleKindArgument{}
      -> [GhcHint]
noHints
    TcRnTooManyBinders{}
      -> [GhcHint]
noHints
    TcRnDifferentNamesForTyVar{}
      -> [GhcHint]
noHints
    TcRnDisconnectedTyVar Name
n
      -> [Name -> GhcHint
SuggestBindTyVarExplicitly Name
n]
    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]
    TcRnPragmaWarning{}
      -> [GhcHint]
noHints
    TcRnDifferentExportWarnings Name
_ NonEmpty SrcSpan
_
      -> [GhcHint]
noHints
    TcRnIncompleteExportWarnings Name
_ NonEmpty SrcSpan
_
      -> [GhcHint]
noHints
    TcRnIllegalHsigDefaultMethods{}
      -> [GhcHint]
noHints
    TcRnIllegalQuasiQuotes{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.QuasiQuotes]
    TcRnTHError THError
err
      -> THError -> [GhcHint]
thErrorHints THError
err
    TcRnHsigFixityMismatch{}
      -> [GhcHint]
noHints
    TcRnHsigShapeMismatch{}
      -> [GhcHint]
noHints
    TcRnHsigMissingModuleExport{}
      -> [GhcHint]
noHints
    TcRnBadGenericMethod{}
      -> [GhcHint]
noHints
    TcRnWarningMinimalDefIncomplete{}
      -> [GhcHint]
noHints
    TcRnDefaultMethodForPragmaLacksBinding{}
      -> [GhcHint]
noHints
    TcRnIgnoreSpecialisePragmaOnDefMethod{}
      -> [GhcHint]
noHints
    TcRnBadMethodErr{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnIllegalTypeData
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeData]
    TcRnTypeDataForbids{}
      -> [GhcHint]
noHints
    TcRnIllegalNewtype{}
      -> [GhcHint]
noHints
    TcRnUnsatisfiedMinimalDef{}
      -> [GhcHint]
noHints
    TcRnMisplacedInstSig{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.InstanceSigs]
    TcRnNoRebindableSyntaxRecordDot{}
      -> [GhcHint]
noHints
    TcRnNoFieldPunsRecordDot{}
      -> [GhcHint]
noHints
    TcRnListComprehensionDuplicateBinding{}
      -> [GhcHint]
noHints
    TcRnEmptyStmtsGroup EmptyStmtsGroupInDoNotation{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.NondecreasingIndentation]
    TcRnEmptyStmtsGroup{}
      -> [GhcHint]
noHints
    TcRnLastStmtNotExpr{}
      -> [GhcHint]
noHints
    TcRnUnexpectedStatementInContext HsStmtContext (GhcPass 'Renamed)
_ 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]
    TcRnCapturedTermName{}
      -> [GhcHint
SuggestRenameTypeVariable]
    TcRnBindingOfExistingName{}
      -> [GhcHint]
noHints
    TcRnMultipleFixityDecls{}
      -> [GhcHint]
noHints
    TcRnIllegalPatternSynonymDecl{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternSynonyms]
    TcRnIllegalClassBinding{}
      -> [GhcHint]
noHints
    TcRnOrphanCompletePragma{}
      -> [GhcHint]
noHints
    TcRnEmptyCase HsMatchContext (GhcPass 'Renamed)
ctxt -> case HsMatchContext (GhcPass 'Renamed)
ctxt of
      LamCaseAlt LamCaseVariant
LamCases -> [GhcHint]
noHints -- cases syntax doesn't support empty case.
      ArrowMatchCtxt (ArrowLamCaseAlt LamCaseVariant
LamCases) -> [GhcHint]
noHints
      HsMatchContext (GhcPass 'Renamed)
_ -> [Extension -> GhcHint
suggestExtension Extension
LangExt.EmptyCase]
    TcRnNonStdGuards{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PatternGuards]
    TcRnDuplicateSigDecl{}
      -> [GhcHint]
noHints
    TcRnMisplacedSigDecl{}
      -> [GhcHint]
noHints
    TcRnUnexpectedDefaultSig{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DefaultSignatures]
    TcRnDuplicateMinimalSig{}
      -> [GhcHint]
noHints
    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
    TcRnUnexpectedStandaloneDerivingDecl{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.StandaloneDeriving]
    TcRnUnusedVariableInRuleDecl{}
      -> [GhcHint]
noHints
    TcRnUnexpectedStandaloneKindSig{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.StandaloneKindSignatures]
    TcRnIllegalRuleLhs{}
      -> [GhcHint]
noHints
    TcRnDuplicateRoleAnnot{}
      -> [GhcHint]
noHints
    TcRnDuplicateKindSig{}
      -> [GhcHint]
noHints
    TcRnIllegalDerivStrategy DerivStrategy GhcPs
ds -> case DerivStrategy GhcPs
ds of
      ViaStrategy{} -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DerivingVia]
      DerivStrategy GhcPs
_ -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DerivingStrategies]
    TcRnIllegalMultipleDerivClauses{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DerivingStrategies]
    TcRnNoDerivStratSpecified Bool
isDSEnabled -> if Bool
isDSEnabled
      then [GhcHint]
noHints
      else [Extension -> GhcHint
suggestExtension Extension
LangExt.DerivingStrategies]
    TcRnStupidThetaInGadt{}
      -> [GhcHint]
noHints
    TcRnShadowedTyVarNameInFamResult{}
      -> [GhcHint]
noHints
    TcRnIncorrectTyVarOnLhsOfInjCond{}
      -> [GhcHint]
noHints
    TcRnUnknownTyVarsOnRhsOfInjCond{}
      -> [GhcHint]
noHints
    TcRnBadlyStaged{}
      -> [GhcHint]
noHints
    TcRnStageRestriction{}
      -> [GhcHint]
noHints
    TcRnTyThingUsedWrong{}
      -> [GhcHint]
noHints
    TcRnCannotDefaultKindVar{}
      -> [GhcHint]
noHints
    TcRnUninferrableTyVar{}
      -> [GhcHint]
noHints
    TcRnSkolemEscape{}
      -> [GhcHint]
noHints
    TcRnPatSynEscapedCoercion{}
      -> [GhcHint]
noHints
    TcRnPatSynExistentialInResult{}
      -> [GhcHint]
noHints
    TcRnPatSynArityMismatch{}
      -> [GhcHint]
noHints
    TcRnPatSynInvalidRhs Name
name LPat (GhcPass 'Renamed)
pat [LIdP (GhcPass 'Renamed)]
args (PatSynNotInvertible Pat (GhcPass 'Renamed)
_)
      -> [Name
-> LPat (GhcPass 'Renamed) -> [LIdP (GhcPass 'Renamed)] -> GhcHint
SuggestExplicitBidiPatSyn Name
name LPat (GhcPass 'Renamed)
pat [LIdP (GhcPass 'Renamed)]
args]
    TcRnPatSynInvalidRhs{}
      -> [GhcHint]
noHints
    TcRnTyFamDepsDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeFamilyDependencies]
    TcRnAbstractClosedTyFamDecl{}
      -> [GhcHint]
noHints
    TcRnPartialFieldSelector{}
      -> [GhcHint]
noHints
    TcRnBadFieldAnnotation Arity
_ DataCon
_ BadFieldAnnotationReason
LazyFieldsDisabled
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.StrictData]
    TcRnBadFieldAnnotation{}
      -> [GhcHint]
noHints
    TcRnSuperclassCycle{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UndecidableSuperClasses]
    TcRnDefaultSigMismatch{}
      -> [GhcHint]
noHints
    TcRnTyFamsDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeFamilies]
    TcRnBadTyConTelescope{}
      -> [GhcHint]
noHints
    TcRnTyFamResultDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeFamilyDependencies]
    TcRnRoleValidationFailed{}
      -> [GhcHint]
noHints
    TcRnCommonFieldResultTypeMismatch{}
      -> [GhcHint]
noHints
    TcRnCommonFieldTypeMismatch{}
      -> [GhcHint]
noHints
    TcRnClassExtensionDisabled Class
_ MultiParamDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.MultiParamTypeClasses]
    TcRnClassExtensionDisabled Class
_ FunDepsDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.FunctionalDependencies]
    TcRnClassExtensionDisabled Class
_ ConstrainedClassMethodsDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ConstrainedClassMethods]
    TcRnDataConParentTypeMismatch{}
      -> [GhcHint]
noHints
    TcRnGADTsDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.GADTs]
    TcRnExistentialQuantificationDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ExistentialQuantification,
          Extension -> GhcHint
suggestExtension Extension
LangExt.GADTs]
    TcRnGADTDataContext{}
      -> [GhcHint]
noHints
    TcRnMultipleConForNewtype{}
      -> [GhcHint]
noHints
    TcRnKindSignaturesDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.KindSignatures]
    TcRnEmptyDataDeclsDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.EmptyDataDecls]
    TcRnRoleMismatch{}
      -> [GhcHint]
noHints
    TcRnRoleCountMismatch{}
      -> [GhcHint]
noHints
    TcRnIllegalRoleAnnotation{}
      -> [GhcHint]
noHints
    TcRnRoleAnnotationsDisabled{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RoleAnnotations]
    TcRnIncoherentRoles{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.IncoherentInstances]
    TcRnBindVarAlreadyInScope{}
      -> [GhcHint]
noHints
    TcRnBindMultipleVariables{}
      -> [GhcHint]
noHints
    TcRnUnexpectedKindVar{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PolyKinds]
    TcRnNegativeNumTypeLiteral{}
      -> [GhcHint]
noHints
    TcRnIllegalKind HsTypeOrSigType GhcPs
_ Bool
suggest_polyKinds
      -> if Bool
suggest_polyKinds
         then [Extension -> GhcHint
suggestExtension Extension
LangExt.PolyKinds]
         else [GhcHint]
noHints
    TcRnPrecedenceParsingError{}
      -> [GhcHint]
noHints
    TcRnSectionPrecedenceError{}
      -> [GhcHint]
noHints
    TcRnUnexpectedPatSigType{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ScopedTypeVariables]
    TcRnIllegalKindSignature{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.KindSignatures]
    TcRnUnusedQuantifiedTypeVar{}
      -> [GhcHint]
noHints
    TcRnDataKindsError{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DataKinds]
    TcRnTypeSynonymCycle{}
      -> [GhcHint]
noHints
    TcRnZonkerMessage ZonkerMessage
msg
      -> ZonkerMessage -> [GhcHint]
zonkerMessageHints ZonkerMessage
msg
    TcRnInterfaceError IfaceMessage
reason
      -> IfaceMessage -> [GhcHint]
interfaceErrorHints IfaceMessage
reason
    TcRnSelfImport{}
      -> [GhcHint]
noHints
    TcRnNoExplicitImportList{}
      -> [GhcHint]
noHints
    TcRnSafeImportsDisabled{}
      -> [GhcHint
SuggestSafeHaskell]
    TcRnDeprecatedModule{}
      -> [GhcHint]
noHints
    TcRnCompatUnqualifiedImport{}
      -> [GhcHint]
noHints
    TcRnRedundantSourceImport{}
      -> [GhcHint]
noHints
    TcRnImportLookup (ImportLookupBad BadImportKind
k ModIface
_ ImpDeclSpec
is IE GhcPs
ie Bool
patsyns_enabled) ->
      let mod_name :: ModuleName
mod_name = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> Module
is_mod ImpDeclSpec
is
          occ :: OccName
occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
      in case BadImportKind
k of
        BadImportKind
BadImportAvailVar         -> [OccName -> ImportSuggestion -> GhcHint
ImportSuggestion OccName
occ (ImportSuggestion -> GhcHint) -> ImportSuggestion -> GhcHint
forall a b. (a -> b) -> a -> b
$ ModuleName -> ImportSuggestion
CouldRemoveTypeKeyword ModuleName
mod_name]
        BadImportNotExported [GhcHint]
suggs -> [GhcHint]
suggs
        BadImportKind
BadImportAvailTyCon       -> [OccName -> ImportSuggestion -> GhcHint
ImportSuggestion OccName
occ (ImportSuggestion -> GhcHint) -> ImportSuggestion -> GhcHint
forall a b. (a -> b) -> a -> b
$ ModuleName -> ImportSuggestion
CouldAddTypeKeyword ModuleName
mod_name]
        BadImportAvailDataCon OccName
par -> [OccName -> ImportSuggestion -> GhcHint
ImportSuggestion OccName
occ (ImportSuggestion -> GhcHint) -> ImportSuggestion -> GhcHint
forall a b. (a -> b) -> a -> b
$ Maybe (ModuleName, Bool) -> OccName -> ImportSuggestion
ImportDataCon ((ModuleName, Bool) -> Maybe (ModuleName, Bool)
forall a. a -> Maybe a
Just (ModuleName
mod_name, Bool
patsyns_enabled)) OccName
par]
        BadImportNotExportedSubordinates{} -> [GhcHint]
noHints
    TcRnImportLookup{}
      -> [GhcHint]
noHints
    TcRnUnusedImport{}
      -> [GhcHint]
noHints
    TcRnDuplicateDecls{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnPackageImportsDisabled
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PackageImports]
    TcRnIllegalDataCon{}
      -> [GhcHint]
noHints
    TcRnNestedForallsContexts{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnRedundantRecordWildcard
      -> [GhcHint
SuggestRemoveRecordWildcard]
    TcRnUnusedRecordWildcard{}
      -> [GhcHint
SuggestRemoveRecordWildcard]
    TcRnUnusedName{}
      -> [GhcHint]
noHints
    TcRnQualifiedBinder{}
      -> [GhcHint]
noHints
    TcRnTypeApplicationsDisabled TypeApplication
ty_app
      -> case TypeApplication
ty_app of
          TypeApplication {}
            -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeApplications]
          TypeApplicationInPattern {}
            -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeAbstractions]
    TcRnInvalidRecordField{}
      -> [GhcHint]
noHints
    TcRnTupleTooLarge{}
      -> [GhcHint]
noHints
    TcRnCTupleTooLarge{}
      -> [GhcHint]
noHints
    TcRnIllegalInferredTyVars{}
      -> [GhcHint]
noHints
    TcRnAmbiguousName{}
      -> [GhcHint]
noHints
    TcRnBindingNameConflict{}
      -> [GhcHint]
noHints
    TcRnNonCanonicalDefinition NonCanonicalDefinition
reason LHsSigType (GhcPass 'Renamed)
_
      -> NonCanonicalDefinition -> [GhcHint]
suggestNonCanonicalDefinition NonCanonicalDefinition
reason
    TcRnImplicitImportOfPrelude {}
      -> [GhcHint]
noHints
    TcRnMissingMain {}
      -> [GhcHint]
noHints
    TcRnGhciUnliftedBind {}
      -> [GhcHint]
noHints
    TcRnGhciMonadLookupFail {}
      -> [GhcHint]
noHints
    TcRnMissingRoleAnnotation{}
      -> [GhcHint]
noHints
    TcRnIllegalInvisTyVarBndr{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeAbstractions]
    TcRnDeprecatedInvisTyArgInConPat{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeAbstractions]
    TcRnInvalidInvisTyVarBndr{}
      -> [GhcHint]
noHints
    TcRnInvisBndrWithoutSig Name
name LHsTyVarBndr (HsBndrVis (GhcPass 'Renamed)) (GhcPass 'Renamed)
_
      -> [Name -> GhcHint
SuggestAddStandaloneKindSignature Name
name]
    TcRnImplicitRhsQuantification LocatedN RdrName
kv
      -> [RdrName -> GhcHint
SuggestBindTyVarOnLhs (LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LocatedN RdrName
kv)]
    TcRnPatersonCondFailure{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UndecidableInstances]

  diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode
  diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode
diagnosticCode = TcRnMessage -> Maybe 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 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
conjunction SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
y]
commafyWith SDoc
conjunction [SDoc]
xs = [SDoc] -> [SDoc]
addConjunction ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
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 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc] -> [SDoc]
addConjunction [SDoc]
xs
          addConjunction [SDoc]
_ = String -> [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
_ Arity
n_args_to_keep
    | Class
cls Class -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
gen1ClassKey Bool -> Bool -> Bool
&& Arity
n_args_to_keep Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
>= Arity
0
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PolyKinds]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst  -> [GhcHint]
noHints
  DerivErrDerivingViaWrongKind{}  -> [GhcHint]
noHints
  DerivErrNoEtaReduce{}           -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrBootFileFound           -> [GhcHint]
noHints
  DerivErrDataConsNotAllInScope{} -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrGNDUsedOnData           -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrNullaryClasses          -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrLastArgMustBeApp        -> [GhcHint]
noHints
  DerivErrNoFamilyInstance{}      -> [GhcHint]
noHints
  DerivErrNotStockDeriveable DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrHasAssociatedDatatypes{}
    -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrNewtypeNonDeriveableClass
    | UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrCannotEtaReduceEnough{}
    | UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrOnlyAnyClassDeriveable TyCon
_ DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrNotDeriveable DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrNotAClass{}
    -> [GhcHint]
noHints
  DerivErrNoConstructors{}
    -> let info :: SDoc
info = String -> SDoc
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 UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving Bool -> Bool -> Bool
&& TyCon -> Bool
isNewTyCon TyCon
rep_tc
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrMustHaveExactlyOneConstructor{}
    -> [GhcHint]
noHints
  DerivErrMustHaveSomeParameters{}
    -> [GhcHint]
noHints
  DerivErrMustNotHaveClassContext{}
    -> [GhcHint]
noHints
  DerivErrBadConstructor Maybe HasWildcard
wcard [DeriveInstanceBadConstructor]
_
    -> case Maybe HasWildcard
wcard of
         Maybe HasWildcard
Nothing        -> [GhcHint]
noHints
         Just HasWildcard
YesHasWildcard -> [GhcHint
SuggestFillInWildcardConstraint]
         Just HasWildcard
NoHasWildcard  -> [GhcHint
SuggestAddStandaloneDerivation]
  DerivErrGenerics{}
    -> [GhcHint]
noHints
  DerivErrEnumOrProduct{}
    -> [GhcHint]
noHints

messageWithInfoDiagnosticMessage :: UnitState
                                 -> ErrInfo
                                 -> Bool
                                 -> DecoratedSDoc
                                 -> DecoratedSDoc
messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo -> Bool -> DecoratedSDoc -> DecoratedSDoc
messageWithInfoDiagnosticMessage UnitState
unit_state ErrInfo{SDoc
errInfoSupplementary :: ErrInfo -> SDoc
errInfoContext :: ErrInfo -> SDoc
errInfoContext :: SDoc
errInfoSupplementary :: SDoc
..} Bool
show_ctxt DecoratedSDoc
important =
  let err_info' :: [SDoc]
err_info' = (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state) ([SDoc
errInfoContext | Bool
show_ctxt] [SDoc] -> [SDoc] -> [SDoc]
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'

messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc
messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc
messageWithHsDocContext TcRnMessageOpts
opts HsDocContext
ctxt DecoratedSDoc
main_msg = do
      if TcRnMessageOpts -> Bool
tcOptsShowContext TcRnMessageOpts
opts
         then DecoratedSDoc
main_msg DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
`unionDecoratedSDoc` DecoratedSDoc
ctxt_msg
         else DecoratedSDoc
main_msg
      where
        ctxt_msg :: DecoratedSDoc
ctxt_msg = SDoc -> DecoratedSDoc
mkSimpleDecorated (HsDocContext -> SDoc
inHsDocContext HsDocContext
ctxt)

dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc
dodgy_msg :: forall ie. Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc
dodgy_msg SDoc
kind GlobalRdrElt
tc ie
ie
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
kind SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"item" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ie -> SDoc
forall a. Outputable a => a -> SDoc
ppr ie
ie) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"suggests that"
         , SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc]
rest ]
  where
    rest :: [SDoc]
    rest :: [SDoc]
rest =
      case GlobalRdrElt -> GREInfo
greInfo GlobalRdrElt
tc of
        IAmTyCon TyConFlavour Name
ClassFlavour
          -> [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(in-scope) class methods or associated types" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but it has none" ]
        IAmTyCon TyConFlavour Name
_
          -> [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(in-scope) constructors or record fields" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but it has none" ]
        GREInfo
_ -> [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"children" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but it is not a type constructor or a class" ]

dodgy_msg_insert :: GlobalRdrElt -> IE GhcRn
dodgy_msg_insert :: GlobalRdrElt -> IE (GhcPass 'Renamed)
dodgy_msg_insert GlobalRdrElt
tc_gre = XIEThingAll (GhcPass 'Renamed)
-> LIEWrappedName (GhcPass 'Renamed) -> IE (GhcPass 'Renamed)
forall pass. XIEThingAll pass -> LIEWrappedName pass -> IE pass
IEThingAll (Maybe (LocatedP (WarningTxt (GhcPass 'Renamed)))
forall a. Maybe a
Nothing, EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) LIEWrappedName (GhcPass 'Renamed)
LocatedAn AnnListItem (IEWrappedName (GhcPass 'Renamed))
ii
  where
    ii :: LocatedAn AnnListItem (IEWrappedName (GhcPass 'Renamed))
ii = IEWrappedName (GhcPass 'Renamed)
-> LocatedAn AnnListItem (IEWrappedName (GhcPass 'Renamed))
forall a an. a -> LocatedAn an a
noLocA (XIEName (GhcPass 'Renamed)
-> LIdP (GhcPass 'Renamed) -> IEWrappedName (GhcPass 'Renamed)
forall p. XIEName p -> LIdP p -> IEWrappedName p
IEName XIEName (GhcPass 'Renamed)
NoExtField
noExtField (LIdP (GhcPass 'Renamed) -> IEWrappedName (GhcPass 'Renamed))
-> LIdP (GhcPass 'Renamed) -> IEWrappedName (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Name -> LocatedN Name
forall a an. a -> LocatedAn an a
noLocA (Name -> LocatedN Name) -> Name -> LocatedN Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
tc_gre)

pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep Type
ty FixedRuntimeRepProvenance
prov =
  let what :: SDoc
what = FixedRuntimeRepProvenance -> SDoc
pprFixedRuntimeRepProvenance FixedRuntimeRepProvenance
prov
  in String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have a fixed runtime representation:"
  SDoc -> SDoc -> SDoc
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 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tidy_ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
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
Type -> Type
typeKind Type
ty)

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

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

ppr_opfix :: (OpName, Fixity) -> SDoc
ppr_opfix :: (OpName, Fixity) -> SDoc
ppr_opfix (OpName
op, Fixity
fixity) = SDoc
pp_op SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fixity)
   where
     pp_op :: SDoc
pp_op | OpName
NegateOp <- OpName
op = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"prefix `-'"
           | Bool
otherwise      = SDoc -> SDoc
quotes (OpName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OpName
op)

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


injectivityErrorHerald :: SDoc
injectivityErrorHerald :: SDoc
injectivityErrorHerald =
  String -> SDoc
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 =
  [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The export item"
       , SDoc -> SDoc
quotes SDoc
exportedThing
       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
reason ]

-- | What warning flags are associated with the given missing signature?
missingSignatureWarningFlags :: MissingSignature -> Exported -> NonEmpty WarningFlag
missingSignatureWarningFlags :: MissingSignature -> Exported -> NonEmpty WarningFlag
missingSignatureWarningFlags (MissingTopLevelBindingSig {}) Exported
exported
  -- We prefer "bigger" warnings first: #14794
  --
  -- See Note [Warnings controlled by multiple flags]
  = WarningFlag
Opt_WarnMissingSignatures WarningFlag -> [WarningFlag] -> NonEmpty WarningFlag
forall a. a -> [a] -> NonEmpty a
:|
    [ WarningFlag
Opt_WarnMissingExportedSignatures | Exported
IsExported Exported -> Exported -> Bool
forall a. Eq a => a -> a -> Bool
== Exported
exported ]
missingSignatureWarningFlags (MissingPatSynSig {}) Exported
exported
  = WarningFlag
Opt_WarnMissingPatternSynonymSignatures WarningFlag -> [WarningFlag] -> NonEmpty WarningFlag
forall a. a -> [a] -> NonEmpty a
:|
    [ WarningFlag
Opt_WarnMissingExportedPatternSynonymSignatures | Exported
IsExported  Exported -> Exported -> Bool
forall a. Eq a => a -> a -> Bool
== Exported
exported ]
missingSignatureWarningFlags (MissingTyConKindSig TyCon
ty_con Bool
_) Exported
_
  = WarningFlag
Opt_WarnMissingKindSignatures WarningFlag -> [WarningFlag] -> NonEmpty WarningFlag
forall a. a -> [a] -> NonEmpty a
:| [WarningFlag
Opt_WarnMissingPolyKindSignatures | Type -> Bool
isForAllTy_invis_ty (TyCon -> Type
tyConKind TyCon
ty_con) ]

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

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

         adfs_msg :: SDoc
adfs_msg  = String -> SDoc
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 -> Arity -> SDoc -> SDoc
hang
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the associated type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not parameterized over the last type variable")
           Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of the class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls))

         at_last_cls_tv_in_kinds_msg :: TyCon -> SDoc
at_last_cls_tv_in_kinds_msg TyCon
at_tc = SDoc -> Arity -> SDoc -> SDoc
hang
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the associated type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"contains the last type variable")
          Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of the class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
eta_ok SDoc
eta_msg
           eta_msg :: SDoc
eta_msg = String -> SDoc
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 (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a type class,"
                          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and can only have a derived instance"
                          SDoc -> SDoc -> SDoc
$+$ String -> 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 SDoc
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 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
predType) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You need " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Extension -> SDoc
forall a. Outputable a => a -> SDoc
ppr Extension
ext
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Don't know how to derive" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls))
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)))
  DerivErrMustBeEnumType TyCon
rep_tc
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be an enumeration type"
              , String -> SDoc
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) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have a class context:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
pprTheta [Type]
bad_stupid_theta)
  DerivErrBadConstructor Maybe HasWildcard
_ [DeriveInstanceBadConstructor]
reasons
    -> let why :: SDoc
why = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DeriveInstanceBadConstructor -> SDoc)
-> [DeriveInstanceBadConstructor] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map DeriveInstanceBadConstructor -> SDoc
renderReason [DeriveInstanceBadConstructor]
reasons
       in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why
         where
           renderReason :: DeriveInstanceBadConstructor -> SDoc
renderReason = \case
                 DerivErrBadConExistential DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
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 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
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 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not contain function types"
                 DerivErrBadConWrongArg DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
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 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a GADT"
                 DerivErrBadConHasExistentials DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has existential type variables in its type"
                 DerivErrBadConHasConstraints DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has constraints in its type"
                 DerivErrBadConHasHigherRankType DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has a higher-rank type"
  DerivErrGenerics [DeriveGenericsErrReason]
reasons
    -> let why :: SDoc
why = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DeriveGenericsErrReason -> SDoc)
-> [DeriveGenericsErrReason] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map DeriveGenericsErrReason -> SDoc
renderReason [DeriveGenericsErrReason]
reasons
       in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why
         where
           renderReason :: DeriveGenericsErrReason -> SDoc
renderReason = \case
             DerivErrGenericsMustNotHaveDatatypeContext TyCon
tc_name
                -> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have a datatype context"
             DerivErrGenericsMustNotHaveExoticArgs DataCon
dc
                -> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have exotic unlifted or polymorphic arguments"
             DerivErrGenericsMustBeVanillaDataCon DataCon
dc
                -> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be a vanilla data constructor"
             DerivErrGenericsMustHaveSomeTypeParams TyCon
rep_tc
                ->     String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must have some type parameters"
             DerivErrGenericsMustNotHaveExistentials DataCon
con
               -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have existential arguments"
             DerivErrGenericsWrongArgKind DataCon
con
               -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"applies a type to an argument involving the last parameter"
                 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
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 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  or" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
ppr2)

lookupInstanceErrDiagnosticMessage :: Class
                                   -> [Type]
                                   -> LookupInstanceErrReason
                                   -> SDoc
lookupInstanceErrDiagnosticMessage :: Class -> [Type] -> LookupInstanceErrReason -> SDoc
lookupInstanceErrDiagnosticMessage Class
cls [Type]
tys = \case
  LookupInstanceErrReason
LookupInstErrNotExact
    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Not an exact match (i.e., some variables get instantiated)"
  LookupInstanceErrReason
LookupInstErrFlexiVar
    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"flexible type variable:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> Type
mkTyConApp (Class -> TyCon
classTyCon Class
cls) [Type]
tys)
  LookupInstanceErrReason
LookupInstErrNotFound
    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance not found" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> Type
mkTyConApp (Class -> TyCon
classTyCon Class
cls) [Type]
tys)

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

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

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

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

-- | Pretty-print a 'TcSolverReportMsg', with its enclosing 'SolverReportErrCtxt'.
pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
_ (BadTelescope TyVarBndrs
telescope [TyVar]
skols) =
  SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"These kind and type variables:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVarBndrs -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVarBndrs
telescope SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are out of dependency order. Perhaps try this ordering:")
    Arity
2 ([TyVar] -> SDoc
pprTyVars [TyVar]
sorted_tvs)
  where
    sorted_tvs :: [TyVar]
sorted_tvs = [TyVar] -> [TyVar]
scopedSort [TyVar]
skols
pprTcSolverReportMsg SolverReportErrCtxt
_ (UserTypeError Type
ty) =
  Type -> SDoc
pprUserTypeErrorTy Type
ty
pprTcSolverReportMsg SolverReportErrCtxt
_ (UnsatisfiableError 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
  SDoc -> SDoc -> SDoc
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] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([ SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_msg
          , SDoc -> (TyVarInfo -> SDoc) -> Maybe TyVarInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt) Maybe TyVarInfo
tv_info
          , SDoc -> (CoercibleMsg -> SDoc) -> Maybe CoercibleMsg -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty CoercibleMsg -> SDoc
pprCoercibleMsg Maybe CoercibleMsg
coercible_info ]
          [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ ((AmbiguityInfo -> SDoc) -> [AmbiguityInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map AmbiguityInfo -> SDoc
pprAmbiguityInfo [AmbiguityInfo]
ambig_infos))
pprTcSolverReportMsg SolverReportErrCtxt
_ (FixedRuntimeRepError [FixedRuntimeRepErrorInfo]
frr_origs) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FixedRuntimeRepErrorInfo -> SDoc)
-> [FixedRuntimeRepErrorInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FixedRuntimeRepErrorInfo -> SDoc
make_msg [FixedRuntimeRepErrorInfo]
frr_origs)
  where
    -- Assemble the error message: pair up each origin with the corresponding type, e.g.
    --   • FixedRuntimeRep origin msg 1 ...
    --       a :: TYPE r1
    --   • FixedRuntimeRep origin msg 2 ...
    --       b :: TYPE r2
    make_msg :: FixedRuntimeRepErrorInfo -> SDoc
    make_msg :: FixedRuntimeRepErrorInfo -> SDoc
make_msg (FRR_Info { frr_info_origin :: FixedRuntimeRepErrorInfo -> FixedRuntimeRepOrigin
frr_info_origin =
                           FixedRuntimeRepOrigin
                             { frr_type :: FixedRuntimeRepOrigin -> Type
frr_type    = Type
ty
                             , frr_context :: FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context = FixedRuntimeRepContext
frr_ctxt }
                       , frr_info_not_concrete :: FixedRuntimeRepErrorInfo -> Maybe (TyVar, Type)
frr_info_not_concrete =
                         Maybe (TyVar, Type)
mb_not_conc }) =
      -- Add bullet points if there is more than one error.
      (if [FixedRuntimeRepErrorInfo] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [FixedRuntimeRepErrorInfo]
frr_origs Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
1 then (SDoc
bullet SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>) else SDoc -> SDoc
forall a. a -> a
id) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext FixedRuntimeRepContext
frr_ctxt
                   , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have a fixed runtime representation." ]
             , Type -> SDoc
type_printout Type
ty
             , case Maybe (TyVar, Type)
mb_not_conc of
                Maybe (TyVar, Type)
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
                Just (TyVar
conc_tv, Type
not_conc) ->
                  TyVar -> Type -> SDoc
unsolved_concrete_eq_explanation TyVar
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 Coercion
_
          -- A confusing cast is one that is responsible
          -- for a representation-polymorphism error.
          -> Type -> Bool
isConcreteType (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
inner_ty)
        Type
_ -> Bool
False

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

    unsolved_concrete_eq_explanation :: TcTyVar -> Type -> SDoc
    unsolved_concrete_eq_explanation :: TyVar -> Type -> SDoc
unsolved_concrete_eq_explanation TyVar
tv Type
not_conc =
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot unify" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
not_conc)
      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with the type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv)
      SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because it is not a concrete" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
      where
        ki :: Type
ki = TyVar -> Type
tyVarKind TyVar
tv
        what :: SDoc
        what :: SDoc
what
          | Type -> Bool
isRuntimeRepTy Type
ki
          = SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RuntimeRep")
          | Type -> Bool
isLevityTy Type
ki
          = SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Levity")
          | Bool
otherwise
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type"
pprTcSolverReportMsg SolverReportErrCtxt
_ (BlockedEquality ErrorItem
item) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot use equality for substitution:")
           Arity
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ErrorItem -> Type
errorItemPred ErrorItem
item))
       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Doing so would be ill-kinded." ]
pprTcSolverReportMsg SolverReportErrCtxt
_ (ExpectingMoreArguments Arity
n TypedThing
thing) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expecting" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
speakN (Arity -> Arity
forall a. Num a => a -> a
abs Arity
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    SDoc
more SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing)
  where
    more :: SDoc
more
     | Arity
n Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"more argument to"
     | Bool
otherwise = String -> SDoc
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 [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
givens
     then CtLoc -> SDoc -> SDoc
addArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unbound implicit parameter" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Type] -> SDoc
forall a. [a] -> SDoc
plural [Type]
preds
                , Arity -> SDoc -> SDoc
nest Arity
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 ErrorItem -> [ErrorItem] -> NonEmpty ErrorItem
forall a. a -> [a] -> NonEmpty a
:| [ErrorItem]
items) Maybe CND_Extra
forall a. Maybe a
Nothing)
  where
    preds :: [Type]
preds = (ErrorItem -> Type) -> [ErrorItem] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map ErrorItem -> Type
errorItemPred (ErrorItem
item ErrorItem -> [ErrorItem] -> [ErrorItem]
forall a. a -> [a] -> [a]
: [ErrorItem]
items)
pprTcSolverReportMsg SolverReportErrCtxt
_ (AmbiguityPreventsSolvingCt ErrorItem
item ([TyVar], [TyVar])
ambigs) =
  AmbiguityInfo -> SDoc
pprAmbiguityInfo (Bool -> ([TyVar], [TyVar]) -> AmbiguityInfo
Ambiguity Bool
True ([TyVar], [TyVar])
ambigs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
  CtLoc -> SDoc
pprArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"prevents the constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprParendType (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ ErrorItem -> Type
errorItemPred ErrorItem
item)
  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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)
  =
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
      [ SDoc
no_inst_msg
      , Arity -> SDoc -> SDoc
nest Arity
2 SDoc
extra_note
      , Maybe SDoc
mb_patsyn_prov Maybe SDoc -> SDoc -> SDoc
forall a. Maybe a -> a -> a
`orElse` SDoc
forall doc. IsOutput doc => doc
empty
      , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool
has_ambigs Bool -> Bool -> Bool
&& Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers Bool -> Bool -> Bool
&& [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens))
        ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
lead_with_ambig (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  AmbiguityInfo -> SDoc
pprAmbiguityInfo (Bool -> ([TyVar], [TyVar]) -> AmbiguityInfo
Ambiguity Bool
False ([TyVar]
ambig_kvs, [TyVar]
ambig_tvs))
              , RelevantBindings -> SDoc
pprRelevantBindings RelevantBindings
binds
              , SDoc
potential_msg ])
      , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Maybe SDoc -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SDoc
mb_patsyn_prov) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            -- Don't suggest fixes for the provided context of a pattern
            -- synonym; the right fix is to bind more in the pattern
        [SDoc] -> SDoc
show_fixes (Bool -> Type -> [Implication] -> [SDoc]
ctxtFixes Bool
has_ambigs Type
pred [Implication]
implics
                    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
drv_fixes [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
naked_sc_fixes)
      , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
candidates))
        (SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"There are instances for similar types:")
            Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ClsInst]
candidates)))
            -- See Note [Report candidate instances]
      , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (ImportError -> SDoc) -> [ImportError] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ImportError -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs
      , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GhcHint -> SDoc) -> [GhcHint] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GhcHint -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GhcHint]
suggs ]
  where
    orig :: CtOrigin
orig          = ErrorItem -> CtOrigin
errorItemOrigin ErrorItem
item
    pred :: Type
pred          = ErrorItem -> Type
errorItemPred ErrorItem
item
    (Class
clas, [Type]
tys)   = HasDebugCallStack => Type -> (Class, [Type])
Type -> (Class, [Type])
getClassPredTys Type
pred
    -- See Note [Highlighting ambiguous type variables] in GHC.Tc.Errors
    ([TyVar]
ambig_kvs, [TyVar]
ambig_tvs) = Type -> ([TyVar], [TyVar])
ambigTkvsOfTy Type
pred
    ambigs :: [TyVar]
ambigs = [TyVar]
ambig_kvs [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
ambig_tvs
    has_ambigs :: Bool
has_ambigs = Bool -> Bool
not ([TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
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 ([TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
ambigs)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not ((TyVar -> Bool) -> [TyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TyVar -> Bool
isRuntimeUnkSkol [TyVar]
ambigs)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers)
                   Bool -> Bool -> Bool
&& [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens

    no_inst_msg :: SDoc
    no_inst_msg :: SDoc
no_inst_msg
      | Bool
lead_with_ambig
      = SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (TcSolverReportMsg -> SDoc) -> TcSolverReportMsg -> SDoc
forall a b. (a -> b) -> a -> b
$ ErrorItem -> ([TyVar], [TyVar]) -> TcSolverReportMsg
AmbiguityPreventsSolvingCt ErrorItem
item ([TyVar]
ambig_kvs, [TyVar]
ambig_tvs)
      | Bool
otherwise
      = SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt (MismatchMsg -> SDoc) -> MismatchMsg -> SDoc
forall a b. (a -> b) -> a -> b
$ [Implication]
-> NonEmpty ErrorItem -> Maybe CND_Extra -> MismatchMsg
CouldNotDeduce [Implication]
useful_givens (ErrorItem
item ErrorItem -> [ErrorItem] -> NonEmpty ErrorItem
forall a. a -> [a] -> NonEmpty a
:| []) Maybe CND_Extra
forall a. Maybe a
Nothing

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

    potential_msg :: SDoc
potential_msg
      = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) Bool -> Bool -> Bool
&& CtOrigin -> Bool
want_potential CtOrigin
orig) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
          SDoc
potential_hdr SDoc -> SDoc -> SDoc
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
      = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
lead_with_ambig (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Probable fix: use a type annotation to specify what"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TyVar]
ambig_tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 (GhcPass 'Renamed)
pat } <- CtOrigin
orig
      = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In other words, a successful match on the pattern"
                   , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Pat (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat (GhcPass 'Renamed)
pat
                   , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not provide the constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
pred ])
      | Bool
otherwise = Maybe SDoc
forall a. Maybe a
Nothing

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

    drv_fix :: Bool -> SDoc
drv_fix Bool
standalone_wildcard
      | Bool
standalone_wildcard
      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fill in the wildcard constraint yourself"
      | Bool
otherwise
      = SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"use a standalone 'deriving instance' declaration,")
           Arity
2 (String -> SDoc
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
      , (Implication -> Bool) -> [Implication] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Implication -> Bool
non_tyvar_preds [Implication]
useful_givens  -- Some non-tyvar givens
      = [[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"If the constraint looks soluble from a superclass of the instance context,"
              , String -> SDoc
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 = (TyVar -> Bool) -> [TyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TyVar -> Bool
non_tyvar_pred ([TyVar] -> Bool)
-> (Implication -> [TyVar]) -> Implication -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Implication -> [TyVar]
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 :: TyVar -> Bool
non_tyvar_pred TyVar
given = case Type -> Maybe (Class, [Type])
getClassPredTys_maybe (TyVar -> Type
idType TyVar
given) of
                             Just (Class
_, [Type]
tys) -> Bool -> Bool
not ((Type -> Bool) -> [Type] -> Bool
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) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
    [ CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Overlapping instances for"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType (Class -> [Type] -> Type
mkClassPred Class
clas [Type]
tys))
    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless ([SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
matching_givens) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Matching givens (or their superclasses):"
                      , Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
matching_givens)]
    ,  PotentialInstances -> SDoc
potentialInstancesErrMsg
        (PotentialInstances { matches :: [ClsInst]
matches = NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
matches, [ClsInst]
unifiers :: [ClsInst]
unifiers :: [ClsInst]
unifiers })
    ,  Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ([SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
matching_givens Bool -> Bool -> Bool
&& [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty ClsInst
matches) Bool -> Bool -> Bool
&& [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       -- Intuitively, some given matched the wanted in their
       -- flattened or rewritten (from given equalities) form
       -- but the matcher can't figure that out because the
       -- constraints are non-flat and non-rewritten so we
       -- simply report back the whole given
       -- context. Accelerate Smart.hs showed this problem.
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"There exists a (perhaps superclass) match:"
             , Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([Implication] -> [SDoc]
pp_givens [Implication]
useful_givens))]

    ,  Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClsInst] -> Bool) -> [ClsInst] -> Bool
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty ClsInst
matches) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless ([TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
tyCoVars) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The choice depends on the instantiation of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                          SDoc -> SDoc
quotes ((TyVar -> SDoc) -> [TyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
tyCoVars)
                    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless ([TyCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyCon]
famTyCons) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                        if ([TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
tyCoVars)
                          then
                            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The choice depends on the result of evaluating" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                              SDoc -> SDoc
quotes ((TyCon -> SDoc) -> [TyCon] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCon]
famTyCons)
                          else
                            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and the result of evaluating" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                              SDoc -> SDoc
quotes ((TyCon -> SDoc) -> [TyCon] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCon]
famTyCons)
                    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ([SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SDoc]
matching_givens)) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To pick the first instance above, use IncoherentInstances"
                           , String -> SDoc
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])
Type -> (Class, [Type])
getClassPredTys Type
pred
    tyCoVars :: [TyVar]
tyCoVars        = [Type] -> [TyVar]
tyCoVarsOfTypesList [Type]
tys
    famTyCons :: [TyCon]
famTyCons       = (TyCon -> Bool) -> [TyCon] -> [TyCon]
forall a. (a -> Bool) -> [a] -> [a]
filter TyCon -> Bool
isFamilyTyCon ([TyCon] -> [TyCon]) -> [TyCon] -> [TyCon]
forall a b. (a -> b) -> a -> b
$ (Type -> [TyCon]) -> [Type] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UniqSet TyCon -> [TyCon]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (UniqSet TyCon -> [TyCon])
-> (Type -> UniqSet TyCon) -> Type -> [TyCon]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> UniqSet TyCon
tyConsOfType) [Type]
tys
    useful_givens :: [Implication]
useful_givens   = CtOrigin -> [Implication] -> [Implication]
discardProvCtxtGivens CtOrigin
orig ([Implication] -> [Implication]
getUserGivensFromImplics [Implication]
implics)
    matching_givens :: [SDoc]
matching_givens = (Implication -> Maybe SDoc) -> [Implication] -> [SDoc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Implication -> Maybe SDoc
matchable [Implication]
useful_givens
    matchable :: Implication -> Maybe SDoc
matchable implic :: Implication
implic@(Implic { ic_given :: Implication -> [TyVar]
ic_given = [TyVar]
evvars, ic_info :: Implication -> SkolemInfoAnon
ic_info = SkolemInfoAnon
skol_info })
      = case [Type]
ev_vars_matching of
             [] -> Maybe SDoc
forall a. Maybe a
Nothing
             [Type]
_  -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Arity -> SDoc -> SDoc
hang ([Type] -> SDoc
pprTheta [Type]
ev_vars_matching)
                            Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                                   , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                                     RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CtLocEnv -> RealSrcSpan
getCtLocEnvLoc (Implication -> CtLocEnv
ic_env Implication
implic)) ])
        where ev_vars_matching :: [Type]
ev_vars_matching = [ Type
pred
                                 | TyVar
ev_var <- [TyVar]
evvars
                                 , let pred :: Type
pred = TyVar -> Type
evVarPred TyVar
ev_var
                                 , (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Type -> Bool
can_match (Type
pred Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
transSuperClasses Type
pred) ]
              can_match :: Type -> Bool
can_match Type
pred
                 = case Type -> Maybe (Class, [Type])
getClassPredTys_maybe Type
pred of
                     Just (Class
clas', [Type]
tys') -> Class
clas' Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
clas
                                          Bool -> Bool -> Bool
&& Maybe Subst -> 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) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unsafe overlapping instances for"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType (Class -> [Type] -> Type
mkClassPred Class
clas [Type]
tys))
       , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The matching instance is:",
              Arity -> SDoc -> SDoc
nest Arity
2 (ClsInst -> SDoc
pprInstance ClsInst
match)]
       , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"It is compiled in a Safe module and as such can only"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"overlap instances from the same module, however it"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"overlaps the following instances from different" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"modules:"
              , Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [[ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
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])
Type -> (Class, [Type])
getClassPredTys Type
pred

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

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

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

pprUntouchableVariable :: TcTyVar -> Implication -> SDoc
pprUntouchableVariable :: TyVar -> Implication -> SDoc
pprUntouchableVariable TyVar
tv (Implic { ic_given :: Implication -> [TyVar]
ic_given = [TyVar]
given, ic_info :: Implication -> SkolemInfoAnon
ic_info = SkolemInfoAnon
skol_info, ic_env :: Implication -> CtLocEnv
ic_env = CtLocEnv
env })
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is untouchable"
        , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"inside the constraints:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
pprEvVarTheta [TyVar]
given
        , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
        , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CtLocEnv -> RealSrcSpan
getCtLocEnvLoc CtLocEnv
env) ]

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 })
  =  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ CtLoc -> SDoc -> SDoc
addArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) SDoc
msg
          , SDoc
ea_extra
          , SDoc -> (WhenMatching -> SDoc) -> Maybe WhenMatching -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> WhenMatching -> SDoc
pprWhenMatching SolverReportErrCtxt
ctxt) Maybe WhenMatching
mb_match_txt
          , SDoc -> (SameOccInfo -> SDoc) -> Maybe SameOccInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
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)
      = String -> SDoc
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
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
herald1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty1)
            , Arity -> SDoc -> SDoc
nest Arity
padding (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
herald2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty2) ]

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

    herald1 :: String
herald1 = [String] -> String
conc [ String
"Couldn't match"
                   , if Bool
is_repr then String
"representation of" else String
""
                   , if Bool
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what) else String
"" ]

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

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

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

    add_space :: String -> String -> String
    add_space :: String -> String -> String
add_space String
s1 String
s2 | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s1   = String
s2
                    | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s2   = String
s1
                    | Bool
otherwise = String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s2)
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 -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
kind_desc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma)
      Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
        SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
act))
  where
    kind_desc :: SDoc
kind_desc | Type -> Bool
isConstraintLikeKind Type
exp = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a constraint"
              | Just Type
arg <- HasDebugCallStack => Type -> Maybe Type
Type -> Maybe Type
kindRep_maybe Type
exp  -- TYPE t0
              , Type -> Bool
tcIsTyVarTy Type
arg = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
                                   Bool
True  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp)
                                   Bool
False -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type"
              | Bool
otherwise       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
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 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
ppr_explicit_kinds SDoc
msg
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc -> (SameOccInfo -> SDoc) -> Maybe SameOccInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
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 (ErrorItem -> Maybe ErrorItem
forall a. a -> Maybe a
Just ErrorItem
item) TypeOrKind
level CtOrigin
orig
        = SDoc
nargs_msg SDoc -> SDoc -> SDoc
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 (ErrorItem -> Maybe ErrorItem
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 = [SDoc] -> SDoc
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 Maybe ErrorItem
forall a. Maybe a
Nothing TypeOrKind
level CtOrigin
orig of
                  Left [ExpectedActualInfo]
ea_info -> SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_err
                                SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (ExpectedActualInfo -> SDoc) -> [ExpectedActualInfo] -> [SDoc]
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 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                Maybe TypedThing
Nothing    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"found something with kind"
                Just TypedThing
thing -> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 TypeOrConstraint -> TypeOrConstraint -> Bool
forall a. Eq a => a -> a -> Bool
== TypeOrConstraint
act_torc
          = TypeOrConstraint -> Type -> SDoc
msg_same_torc TypeOrConstraint
act_torc Type
act_rep
          | Bool
otherwise
          = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                     Maybe TypedThing
Nothing    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"found a"
                     Just TypedThing
thing -> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
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
          = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
exp_doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                     Just TypedThing
thing -> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is"
                     Maybe TypedThing
Nothing    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"got"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
act_doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
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 Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
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 :: Arity
n_act = Type -> Arity
count_args Type
act
               n_exp :: Arity
n_exp = Type -> Arity
count_args Type
exp in
           case Arity
n_act Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- Arity
n_exp of
             Arity
n | Arity
n Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
0   -- we don't know how many args there are, so don't
                         -- recommend removing args that aren't
               , Just TypedThing
thing <- Maybe TypedThing
mb_thing
               -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (Arity -> TypedThing -> TcSolverReportMsg
ExpectingMoreArguments Arity
n TypedThing
thing)
             Arity
_ -> Maybe SDoc
forall a. Maybe a
Nothing

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

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

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

    ppr_torc :: TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
TypeLike       = String -> doc
forall doc. IsLine doc => String -> doc
text String
"type";
    ppr_torc TypeOrConstraint
ConstraintLike = String -> doc
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 TyCon -> Unique -> Bool
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   -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a lifted")
                      Levity
Unlifted -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a boxed unlifted")
          [] | TyCon
rr_tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
tupleRepDataConTyConKey -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a zero-bit")
             | String -> Bool
starts_with_vowel String
rr_occ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
rr_occ)
             | Bool
otherwise                -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
rr_occ)
             where
               rr_occ :: String
rr_occ = OccName -> String
occNameString (TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
rr_tc)

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

    starts_with_vowel :: String -> Bool
starts_with_vowel (Char
c:String
_) = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     case Either [ExpectedActualInfo] MismatchMsg
supplementary of
      Left [ExpectedActualInfo]
infos
        -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ExpectedActualInfo -> SDoc) -> [ExpectedActualInfo] -> [SDoc]
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
      | [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens
      = CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc
no_instance_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
missing)
      | Bool
otherwise
      = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc
no_deduce_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
missing)
              SDoc -> [SDoc] -> [SDoc]
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
        -> [ExpectedActualInfo] -> Either [ExpectedActualInfo] MismatchMsg
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 = (ErrorItem -> Type) -> [ErrorItem] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map ErrorItem -> Type
errorItemPred (ErrorItem
itemErrorItem -> [ErrorItem] -> [ErrorItem]
forall a. a -> [a] -> [a]
:[ErrorItem]
others)

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

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

    missing :: SDoc
missing =
      case [Type]
wanteds of
        [Type
wanted] -> SDoc -> SDoc
quotes (Type -> SDoc
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 :: PotentialInstances -> [ClsInst]
matches :: [ClsInst]
matches, [ClsInst]
unifiers :: PotentialInstances -> [ClsInst]
unifiers :: [ClsInst]
unifiers }) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
    [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
matches) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Matching instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [ClsInst] -> SDoc
forall a. [a] -> SDoc
plural [ClsInst]
matches SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
ppr_inst [ClsInst]
matches))
    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Potentially matching instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [ClsInst] -> SDoc
forall a. [a] -> SDoc
plural [ClsInst]
unifiers SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
ppr_inst [ClsInst]
unifiers))
    ]

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

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

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

  | Bool
otherwise
  = [SDoc] -> SDoc
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
         , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Arity
n_in_scope_hidden Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
0) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...plus"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc -> SDoc
speakNOf Arity
n_in_scope_hidden (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"other")
           , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Arity
not_in_scopes Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
0) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> SDoc
not_in_scope_msg (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...plus")
           , SDoc
flag_hint ] ]
  where
    n_show_matches, n_show_unifiers :: Int
    n_show_matches :: Arity
n_show_matches  = Arity
3
    n_show_unifiers :: Arity
n_show_unifiers = Arity
2

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

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

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

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

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

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

    flag_hint :: SDoc
flag_hint = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Bool
show_all_potentials
                         Bool -> Bool -> Bool
|| ([ClsInst] -> [ClsInst] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [ClsInst]
show_these_matches [ClsInst]
matches
                             Bool -> Bool -> Bool
&& [ClsInst] -> [ClsInst] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [ClsInst]
show_these_unifiers [ClsInst]
unifiers)) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                String -> SDoc
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 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (ClsInst, ClsInst) -> SDoc
ppr_overlapping (ClsInst, ClsInst)
overlap
  | Bool
otherwise
  = SDoc
forall doc. IsOutput doc => doc
empty
    where
      overlap_header :: SDoc
      overlap_header :: SDoc
overlap_header
        | [(ClsInst, ClsInst)
_] <- [(ClsInst, ClsInst)]
overlapping_but_not_more_specific
        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"An overlapping instance can only be chosen when it is strictly more specific."
        | Bool
otherwise
        = String -> SDoc
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
        = ((ClsInst, ClsInst) -> (ClsInst, ClsInst) -> Ordering)
-> [(ClsInst, ClsInst)] -> [(ClsInst, ClsInst)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (((ClsInst, ClsInst) -> TyVar)
-> (ClsInst, ClsInst) -> (ClsInst, ClsInst) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ClsInst -> TyVar
is_dfun (ClsInst -> TyVar)
-> ((ClsInst, ClsInst) -> ClsInst) -> (ClsInst, ClsInst) -> TyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClsInst, ClsInst) -> ClsInst
forall a b. (a, b) -> a
fst))
          [ (ClsInst
overlapper, ClsInst
overlappee)
          | [ClsInst]
these <- (ClsInst -> ClsInst -> Bool) -> [ClsInst] -> [[ClsInst]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Name -> Name -> Bool)
-> (ClsInst -> Name) -> ClsInst -> ClsInst -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ClsInst -> Name
is_cls_nm) [ClsInst]
insts
          -- Take all pairs of distinct instances...
          , ClsInst
one:[ClsInst]
others <- [ClsInst] -> [[ClsInst]]
forall a. [a] -> [[a]]
tails [ClsInst]
these -- if `these = [inst_1, inst_2, ...]`
          , ClsInst
other <- [ClsInst]
others           -- then we get pairs `(one, other) = (inst_i, inst_j)` with `i < j`
          -- ... such that one instance in the pair overlaps the other...
          , let mb_overlapping :: [(ClsInst, ClsInst)]
mb_overlapping
                  | OverlapMode -> Bool
hasOverlappingFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
one)
                  Bool -> Bool -> Bool
|| OverlapMode -> Bool
hasOverlappableFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
other)
                  = [(ClsInst
one, ClsInst
other)]
                  | OverlapMode -> Bool
hasOverlappingFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
other)
                  Bool -> Bool -> Bool
|| OverlapMode -> Bool
hasOverlappableFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
one)
                  = [(ClsInst
other, ClsInst
one)]
                  | Bool
otherwise
                  = []
          , (ClsInst
overlapper, ClsInst
overlappee) <- [(ClsInst, ClsInst)]
mb_overlapping
          -- ... but the overlapper is not more specific than the overlappee.
          , Bool -> Bool
not (ClsInst
overlapper ClsInst -> ClsInst -> Bool
`more_specific_than` ClsInst
overlappee)
          ]
      more_specific_than :: ClsInst -> ClsInst -> Bool
      ClsInst
is1 more_specific_than :: ClsInst -> ClsInst -> Bool
`more_specific_than` ClsInst
is2
        = Maybe Subst -> Bool
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)
        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The first instance that follows overlaps the second, but is not more specific than it:"
        SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
pprInstanceHdr [ClsInst
overlapper, ClsInst
overlappee])

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

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

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

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

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

{- *********************************************************************
*                                                                      *
             Outputting 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 }) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
    [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp
    , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
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 } )
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
      [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type synonyms expanded:"
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
act ]

pprCoercibleMsg :: CoercibleMsg -> SDoc
pprCoercibleMsg :: CoercibleMsg -> SDoc
pprCoercibleMsg (UnknownRoles Type
ty) =
  SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: We cannot know what roles the parameters to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"have;")
       Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"we must assume that the role is nominal")
pprCoercibleMsg (TyConIsAbstract TyCon
tc) =
  [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: The type constructor"
       , SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
tc)
       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is abstract" ]
pprCoercibleMsg (OutOfScopeNewtypeConstructor TyCon
tc DataCon
dc) =
  SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName DataCon
dc))
    Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of newtype" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
tc)
           , String -> SDoc
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) =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
printExplicitCoercions ->
    if Bool
printExplicitCoercions
       Bool -> Bool -> Bool
|| Bool -> Bool
not (Type
cty1 Type -> Type -> Bool
`pickyEqType` Type
cty2)
      then [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When matching" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
sub_whats)
                      Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
cty1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                               Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
cty1)
                             , Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
cty2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                               Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
cty2) ])
                , SDoc
supplementary ]
      else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When matching the kind of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
cty1)
  where
    sub_t_or_k :: TypeOrKind
sub_t_or_k = Maybe TypeOrKind
mb_sub_t_or_k Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel
    sub_whats :: SDoc
sub_whats  = String -> SDoc
forall doc. IsLine doc => String -> doc
text (TypeOrKind -> String
levelString TypeOrKind
sub_t_or_k) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
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 -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (ExpectedActualInfo -> SDoc) -> [ExpectedActualInfo] -> [SDoc]
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 -> TyVar
thisTyVar = TyVar
tv1, otherTy :: TyVarInfo -> Maybe TyVar
otherTy = Maybe TyVar
mb_tv2, thisTyVarIsUntouchable :: TyVarInfo -> Maybe Implication
thisTyVarIsUntouchable = Maybe Implication
mb_implic })
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ TyVar -> SDoc
mk_msg TyVar
tv1
         , SDoc -> (Implication -> SDoc) -> Maybe Implication -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (TyVar -> Implication -> SDoc
pprUntouchableVariable TyVar
tv1) Maybe Implication
mb_implic
         , case Maybe TyVar
mb_tv2 of { Maybe TyVar
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty; Just TyVar
tv2 -> TyVar -> SDoc
mk_msg TyVar
tv2 } ]
  where
    mk_msg :: TyVar -> SDoc
mk_msg TyVar
tv = case TyVar -> TcTyVarDetails
tcTyVarDetails TyVar
tv of
      SkolemTv SkolemInfo
sk_info TcLevel
_ Bool
_ -> SolverReportErrCtxt -> [(SkolemInfoAnon, [TyVar])] -> SDoc
pprSkols SolverReportErrCtxt
ctxt [(SkolemInfo -> SkolemInfoAnon
getSkolemInfo SkolemInfo
sk_info, [TyVar
tv])]
      RuntimeUnk {} -> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is an interactive-debugger skolem"
      MetaTv {}     -> SDoc
forall doc. IsOutput doc => doc
empty

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

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

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

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

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

      | Bool
otherwise -- "The type variable 't0' is ambiguous"
      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
tkvs
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TyVar]
tkvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
isOrAre [TyVar]
tkvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ambiguous"
pprAmbiguityInfo (NonInjectiveTyFam TyCon
tc) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Bool -> Name -> SDoc
ppr_from Bool
same_pkg Name
n1 SDoc -> SDoc -> SDoc
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 -> Arity -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is defined at")
           Arity
2 (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc)
      | Bool
otherwise  -- Imported things have an UnhelpfulSrcSpan
      = SDoc -> Arity -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm))
           Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is defined in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod))
                  , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Bool
same_pkg Bool -> Bool -> Bool
|| Unit
pkg Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
mainUnit) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    Arity -> SDoc -> SDoc
nest Arity
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
pkg) ])
      where
        pkg :: Unit
pkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod
        mod :: Module
mod = HasDebugCallStack => Name -> Module
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 :: Type
hole_ty :: Hole -> Type
hole_ty, hole_occ :: Hole -> RdrName
hole_occ = RdrName
rdr }) (OutOfScopeHole [ImportError]
imp_errs)
  = SDoc
out_of_scope_msg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ImportError -> SDoc) -> [ImportError] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ImportError -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs)
  where
    herald :: SDoc
herald | OccName -> Bool
isDataOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data constructor not in scope:"
           | Bool
otherwise     = String -> SDoc
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 -> Arity -> SDoc -> SDoc
hang SDoc
herald Arity
2 (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
      | Bool
otherwise   = SDoc -> Arity -> SDoc -> SDoc
hang SDoc
herald Arity
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 :: Hole -> Type
hole_ty :: Type
hole_ty, RdrName
hole_occ :: Hole -> RdrName
hole_occ :: RdrName
hole_occ}) (HoleError HoleSort
sort [TyVar]
other_tvs [(SkolemInfoAnon, [TyVar])]
hole_skol_info) =
  [SDoc] -> SDoc
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 -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found hole:")
          Arity
2 (RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
hole_occ Type
hole_ty)
      HoleSort
TypeHole ->
        SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found type wildcard" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
hole_occ))
          Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"standing for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_hole_type_with_kind)
      HoleSort
ConstraintHole ->
        SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found extra-constraints wildcard standing for")
          Arity
2 (SDoc -> SDoc
quotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprType Type
hole_ty)  -- always kind Constraint

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

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

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

    loc_msg :: TyVar -> SDoc
loc_msg TyVar
tv
       | TyVar -> Bool
isTyVar TyVar
tv
       = case TyVar -> TcTyVarDetails
tcTyVarDetails TyVar
tv of
           MetaTv {} -> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is an ambiguous type variable"
           TcTyVarDetails
_         -> SDoc
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 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
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 -> Arity -> SDoc -> SDoc
hang (RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc RdrName
occ) Arity
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
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
    NotInScopeError
NotInScope ->
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Not in scope:")
        Arity
2 (SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name))
    NotInScopeError
NotARecordField ->
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Not in scope:")
        Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"record field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name))
    NoExactName Name
name ->
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The Name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope."
    SameName [GlobalRdrElt]
gres ->
      Bool -> SDoc -> SDoc -> SDoc
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ([GlobalRdrElt] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [GlobalRdrElt]
gres Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
>= Arity
2) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pprScopeError SameName: fewer than 2 elements" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Arity -> SDoc -> SDoc
nest Arity
2 ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
gres))
      (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Same Name in multiple name-spaces:")
           Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
pp_one [Name]
sorted_names))
      where
        sorted_names :: [Name]
sorted_names = (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
nameSrcSpan)
                     ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName [GlobalRdrElt]
gres
        pp_one :: Name -> SDoc
pp_one Name
name
          = SDoc -> Arity -> SDoc -> SDoc
hang (NameSpace -> SDoc
pprNameSpace (OccName -> NameSpace
occNameSpace (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
name))
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma)
               Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"declared at:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
name))
    MissingBinding SDoc
thing [GhcHint]
_ ->
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
thing
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
          , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lacks an accompanying binding" ]
    NotInScopeError
NoTopLevelBinding ->
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No top-level binding for")
        Arity
2 (SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in this module")
    UnknownSubordinate SDoc
doc ->
      SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a (visible)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
    NotInScopeTc NameEnv TcTyThing
env ->
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat[String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC internal error:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope during type checking, but it passed the renamer",
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"tcl_env of environment:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameEnv TcTyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameEnv TcTyThing
env]
  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
    NotInScopeError
NotARecordField        -> [GhcHint]
noHints
    NoExactName {}         -> [GhcHint
SuggestDumpSlices]
    SameName {}            -> [GhcHint
SuggestDumpSlices]
    MissingBinding SDoc
_ [GhcHint]
hints -> [GhcHint]
hints
    NotInScopeError
NoTopLevelBinding      -> [GhcHint]
noHints
    UnknownSubordinate {}  -> [GhcHint]
noHints
    NotInScopeTc NameEnv TcTyThing
_         -> [GhcHint]
noHints

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

instance Outputable ImportError where
  ppr :: ImportError -> SDoc
ppr (MissingModule ModuleName
mod_name) =
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
      [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: no module named"
      , SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is imported."
      ]
  ppr  (ModulesDoNotExport NonEmpty Module
mods OccName
occ_name)
    | Module
mod NE.:| [] <- NonEmpty Module
mods
    = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
        [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: the module"
        , SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not export"
        , SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot ]
    | Bool
otherwise
    = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
        [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: neither"
        , [SDoc] -> SDoc
quotedListWithNor ((Module -> SDoc) -> [Module] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([Module] -> [SDoc]) -> [Module] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ NonEmpty Module -> [Module]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Module
mods)
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"export"
        , SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
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 []     = SDoc
forall doc. IsOutput doc => doc
empty
show_fixes (SDoc
f:[SDoc]
fs) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Possible fix:"
                        , Arity -> SDoc -> SDoc
nest Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc
f SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
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 | [SkolemInfoAnon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SkolemInfoAnon]
skols
             , SigSkol (PatSynCtxt {}) Type
_ [(Name, TyVar)]
_ <- SkolemInfoAnon
skol
             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\"required\""
             | Bool
otherwise
             = SDoc
forall doc. IsOutput doc => doc
empty
  = [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"add" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
pred
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"context of"
         , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SkolemInfoAnon -> SDoc
ppr_skol SkolemInfoAnon
skol SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
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
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc)
    ppr_skol (PatSkol (PatSynCon PatSyn
ps)   HsMatchContext GhcTc
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the pattern synonym"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (PatSyn -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSyn
ps)
    ppr_skol SkolemInfoAnon
skol_info = SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info

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

    implausible :: Implication -> Bool
implausible Implication
ic
      | [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Implication -> [TyVar]
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, TyVar)]
_) = Bool
True
    implausible_info SkolemInfoAnon
_                             = Bool
False
    -- Do not suggest adding constraints to an *inferred* type signature

pp_givens :: [Implication] -> [SDoc]
pp_givens :: [Implication] -> [SDoc]
pp_givens [Implication]
givens
   = case [Implication]
givens of
         []     -> []
         (Implication
g:[Implication]
gs) ->      SDoc -> Implication -> SDoc
ppr_given (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"from the context:") Implication
g
                 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (Implication -> SDoc) -> [Implication] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> Implication -> SDoc
ppr_given (String -> SDoc
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 -> [TyVar]
ic_given = [TyVar]
gs, ic_info :: Implication -> SkolemInfoAnon
ic_info = SkolemInfoAnon
skol_info })
           = SDoc -> Arity -> SDoc -> SDoc
hang (SDoc
herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
pprEvVarTheta ((TyVar -> Type) -> [TyVar] -> [TyVar]
forall a. (a -> Type) -> [a] -> [a]
mkMinimalBySCs TyVar -> Type
evVarPred [TyVar]
gs))
             -- See Note [Suppress redundant givens during error reporting]
             -- for why we use mkMinimalBySCs above.
                Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CtLocEnv -> RealSrcSpan
getCtLocEnvLoc (Implication -> CtLocEnv
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 = SDoc
forall doc. IsOutput doc => doc
empty  -- See Note ["Arising from" messages in generated code]
  | Bool
suppress_origin   = SDoc
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 = CtLocEnv -> Bool
ctLocEnvInGeneratedCode (CtLoc -> CtLocEnv
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 -> Arity -> SDoc -> SDoc
hang SDoc
msg Arity
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 []
  = String -> SDoc
forall a. HasCallStack => String -> a
panic String
"pprWithArising"
pprWithArising (Ct
ct:[Ct]
cts)
  | [Ct] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ct]
cts
  = CtLoc -> SDoc -> SDoc
addArising CtLoc
loc ([Type] -> SDoc
pprTheta [Ct -> Type
ctPred Ct
ct])
  | Bool
otherwise
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Ct -> SDoc) -> [Ct] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Ct -> SDoc
ppr_one (Ct
ctCt -> [Ct] -> [Ct]
forall a. a -> [a] -> [a]
:[Ct]
cts))
  where
    loc :: CtLoc
loc = Ct -> CtLoc
ctLoc Ct
ct
    ppr_one :: Ct -> SDoc
ppr_one Ct
ct' = SDoc -> Arity -> SDoc -> SDoc
hang (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Type -> SDoc
pprType (Ct -> Type
ctPred Ct
ct')))
                     Arity
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, TyVar)]
tv_prs) = TidyEnv
-> UserTypeCtxt -> Type -> [(Name, TyVar)] -> SkolemInfoAnon
tidySigSkol TidyEnv
env UserTypeCtxt
cx Type
ty [(Name, TyVar)]
tv_prs
tidySkolemInfoAnon TidyEnv
env (InferSkol [(Name, Type)]
ids)        = [(Name, Type)] -> SkolemInfoAnon
InferSkol ((Type -> Type) -> [(Name, Type)] -> [(Name, Type)]
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, TyVar)] -> SkolemInfoAnon
tidySigSkol TidyEnv
env UserTypeCtxt
cx Type
ty [(Name, TyVar)]
tv_prs
  = UserTypeCtxt -> Type -> [(Name, TyVar)] -> SkolemInfoAnon
SigSkol UserTypeCtxt
cx (TidyEnv -> Type -> Type
tidy_ty TidyEnv
env Type
ty) [(Name, TyVar)]
tv_prs'
  where
    tv_prs' :: [(Name, TyVar)]
tv_prs' = (TyVar -> TyVar) -> [(Name, TyVar)] -> [(Name, TyVar)]
forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a, b) -> f (a, c)
mapSnd (TidyEnv -> TyVar -> TyVar
tidyTyCoVarOcc TidyEnv
env) [(Name, TyVar)]
tv_prs
    inst_env :: NameEnv TyVar
inst_env = [(Name, TyVar)] -> NameEnv TyVar
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyVar)]
tv_prs'

    tidy_ty :: TidyEnv -> Type -> Type
tidy_ty TidyEnv
env (ForAllTy (Bndr TyVar
tv ForAllTyFlag
vis) Type
ty)
      = VarBndr TyVar ForAllTyFlag -> Type -> Type
ForAllTy (TyVar -> ForAllTyFlag -> VarBndr TyVar ForAllTyFlag
forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv' ForAllTyFlag
vis) (TidyEnv -> Type -> Type
tidy_ty TidyEnv
env' Type
ty)
      where
        (TidyEnv
env', TyVar
tv') = TidyEnv -> TyVar -> (TidyEnv, TyVar)
tidy_tv_bndr TidyEnv
env TyVar
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 = tidy_ty env w
           , ft_arg  = tidyType env arg
           , ft_res  = tidy_ty env 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 -> TyVar -> (TidyEnv, TyVar)
tidy_tv_bndr env :: TidyEnv
env@(TidyOccEnv
occ_env, VarEnv TyVar
subst) TyVar
tv
      | Just TyVar
tv' <- NameEnv TyVar -> Name -> Maybe TyVar
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv TyVar
inst_env (TyVar -> Name
tyVarName TyVar
tv)
      = ((TidyOccEnv
occ_env, VarEnv TyVar -> TyVar -> TyVar -> VarEnv TyVar
forall a. VarEnv a -> TyVar -> a -> VarEnv a
extendVarEnv VarEnv TyVar
subst TyVar
tv TyVar
tv'), TyVar
tv')

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    go (TyConApp TyCon
tc1 [Type]
tys1) (TyConApp TyCon
tc2 [Type]
tys2)
      | TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2
      , [Type]
tys1 [Type] -> [Type] -> Bool
forall a b. [a] -> [b] -> Bool
`equalLength` [Type]
tys2 =
        -- Type constructors are same. They may be synonyms, but we don't
        -- expand further. The lengths of tys1 and tys2 must be equal;
        -- for example, with type S a = a, we don't want
        -- to zip (S Monad Int) and (S Bool).
        let ([Type]
tys1', [Type]
tys2') =
              [(Type, Type)] -> ([Type], [Type])
forall a b. [(a, b)] -> ([a], [b])
unzip (String
-> (Type -> Type -> (Type, Type))
-> [Type]
-> [Type]
-> [(Type, Type)]
forall a b c.
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 = t1_1', ft_res = t1_2' }
          , Type
ty2 { ft_arg = t2_1', ft_res = t2_2' })

    go (ForAllTy VarBndr TyVar ForAllTyFlag
b1 Type
t1) (ForAllTy VarBndr TyVar 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 TyVar ForAllTyFlag -> Type -> Type
ForAllTy VarBndr TyVar ForAllTyFlag
b1 Type
t1', VarBndr TyVar ForAllTyFlag -> Type -> Type
ForAllTy VarBndr TyVar ForAllTyFlag
b2 Type
t2')

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

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

    -- Expand the top layer type synonyms repeatedly, collect expansions in a
    -- list. The list does not include the original type.
    --
    -- Example, if you have:
    --
    --   type T10 = T9
    --   type T9  = T8
    --   ...
    --   type T0  = Int
    --
    -- `tyExpansions T10` returns [T9, T8, T7, ..., Int]
    --
    -- This only expands the top layer, so if you have:
    --
    --   type M a = Maybe a
    --
    -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded)
    tyExpansions :: Type -> [Type]
    tyExpansions :: Type -> [Type]
tyExpansions = (Type -> Maybe (Type, Type)) -> Type -> [Type]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\Type
t -> (\Type
x -> (Type
x, Type
x)) (Type -> (Type, Type)) -> Maybe Type -> Maybe (Type, Type)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Type -> Maybe Type
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 [] = String -> SDoc -> (Type, Type)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"followExpansions" SDoc
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 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2
    sameShapes (FunTy {})       (FunTy {})       = Bool
True
    sameShapes (ForAllTy {})    (ForAllTy {})    = Bool
True
    sameShapes (CastTy Type
ty1 Coercion
_)   Type
ty2              = Type -> Type -> Bool
sameShapes Type
ty1 Type
ty2
    sameShapes Type
ty1              (CastTy Type
ty2 Coercion
_)   = 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 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In" SDoc -> SDoc -> SDoc
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)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
pprHsDocContext (StandaloneKindSigCtx SDoc
doc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the standalone kind signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
pprHsDocContext HsDocContext
PatCtx                = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern type-signature"
pprHsDocContext HsDocContext
SpecInstSigCtx        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a SPECIALISE instance pragma"
pprHsDocContext HsDocContext
DefaultDeclCtx        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a `default' declaration"
pprHsDocContext HsDocContext
DerivDeclCtx          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a deriving declaration"
pprHsDocContext (RuleCtx FastString
name)        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the rewrite rule" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
name)
pprHsDocContext (TyDataCtx LocatedN RdrName
tycon)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the data type declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
tycon)
pprHsDocContext (FamPatCtx LocatedN RdrName
tycon)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type pattern of family instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
tycon)
pprHsDocContext (TySynCtx LocatedN RdrName
name)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the declaration for type synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
name)
pprHsDocContext (TyFamilyCtx LocatedN RdrName
name)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the declaration for type family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
name)
pprHsDocContext (ClassDeclCtx LocatedN RdrName
name)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the declaration for class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
name)
pprHsDocContext HsDocContext
ExprWithTySigCtx      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an expression type signature"
pprHsDocContext HsDocContext
TypBrCtx              = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a Template-Haskell quoted type"
pprHsDocContext HsDocContext
HsTypeCtx             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type argument"
pprHsDocContext HsDocContext
HsTypePatCtx          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type argument in a pattern"
pprHsDocContext HsDocContext
GHCiCtx               = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHCi input"
pprHsDocContext (SpliceTypeCtx LHsType GhcPs
hs_ty) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the spliced type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hs_ty)
pprHsDocContext HsDocContext
ClassInstanceCtx      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC.Tc.Gen.Splice.reifyInstances"

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

pprTyThingUsedWrong :: WrongThingSort -> TcTyThing -> Name -> SDoc
pprTyThingUsedWrong :: WrongThingSort -> TcTyThing -> Name -> SDoc
pprTyThingUsedWrong WrongThingSort
sort TcTyThing
thing Name
name =
  TcTyThing -> SDoc
pprTcTyThingCategory TcTyThing
thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used as a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WrongThingSort -> SDoc
pprWrongThingSort WrongThingSort
sort

pprWrongThingSort :: WrongThingSort -> SDoc
pprWrongThingSort :: WrongThingSort -> SDoc
pprWrongThingSort =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc)
-> (WrongThingSort -> String) -> WrongThingSort -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    WrongThingSort
WrongThingType -> String
"type"
    WrongThingSort
WrongThingDataCon -> String
"data constructor"
    WrongThingSort
WrongThingPatSyn -> String
"pattern synonym"
    WrongThingSort
WrongThingConLike -> String
"constructor-like thing"
    WrongThingSort
WrongThingClass -> String
"class"
    WrongThingSort
WrongThingTyCon -> String
"type constructor"
    WrongThingSort
WrongThingAxiom -> String
"axiom"

pprStageCheckReason :: StageCheckReason -> SDoc
pprStageCheckReason :: StageCheckReason -> SDoc
pprStageCheckReason = \case
  StageCheckInstance InstanceWhat
_ Type
t ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
t)
  StageCheckSplice Name
t ->
    SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
t)

pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc
pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc
pprUninferrableTyVarCtx = \case
  UninfTyCtx_ClassContext [Type]
theta ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the class context:", [Type] -> SDoc
pprTheta [Type]
theta ]
  UninfTyCtx_DataContext [Type]
theta ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the datatype context:", [Type] -> SDoc
pprTheta [Type]
theta ]
  UninfTyCtx_ProvidedContext [Type]
theta ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the provided context:" , [Type] -> SDoc
pprTheta [Type]
theta ]
  UninfTyCtx_TyFamRhs Type
rhs_ty ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type family equation right-hand side:" , Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs_ty ]
  UninfTyCtx_TySynRhs Type
rhs_ty ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type synonym right-hand side:" , Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs_ty ]
  UninfTyCtx_Sig Type
exp_kind LHsSigType (GhcPass 'Renamed)
full_hs_ty ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp_kind) Arity
2
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of the type signature:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
full_hs_ty)

pprPatSynInvalidRhsReason :: PatSynInvalidRhsReason -> SDoc
pprPatSynInvalidRhsReason :: PatSynInvalidRhsReason -> SDoc
pprPatSynInvalidRhsReason = \case
  PatSynNotInvertible Pat (GhcPass 'Renamed)
p ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Pat (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat (GhcPass 'Renamed)
p) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not invertible"
  PatSynUnboundVar Name
var ->
    SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
var) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not bound by the LHS of the pattern synonym"

pprBadFieldAnnotationReason :: BadFieldAnnotationReason -> SDoc
pprBadFieldAnnotationReason :: BadFieldAnnotationReason -> SDoc
pprBadFieldAnnotationReason = \case
  BadFieldAnnotationReason
LazyFieldsDisabled ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Lazy field annotations (~) are disabled"
  BadFieldAnnotationReason
UnpackWithoutStrictness ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UNPACK pragma lacks '!'"
  BadFieldAnnotationReason
BackpackUnpackAbstractType ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ignoring unusable UNPACK pragma"

pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc
pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc
pprSuperclassCycleDetail = \case
  SCD_HeadTyVar Type
pred ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"one of whose superclass constraints is headed by a type variable:")
       Arity
2 (SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pred))
  SCD_HeadTyFam Type
pred ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"one of whose superclass constraints is headed by a type family:")
       Arity
2 (SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pred))
  SCD_Superclass Class
cls ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"one of whose superclasses is" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)

pprRoleValidationFailedReason :: Role -> RoleValidationFailedReason -> SDoc
pprRoleValidationFailedReason :: Role -> RoleValidationFailedReason -> SDoc
pprRoleValidationFailedReason Role
role = \case
  TyVarRoleMismatch TyVar
tv Role
role' ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot have role" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
role SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because it was assigned role" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
role'
  TyVarMissingInEnv TyVar
tv ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"missing in environment"
  BadCoercionRole Coercion
co ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"coercion" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Coercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr Coercion
co SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has bad role" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
role

pprDisabledClassExtension :: Class -> DisabledClassExtension -> SDoc
pprDisabledClassExtension :: Class -> DisabledClassExtension -> SDoc
pprDisabledClassExtension Class
cls = \case
  MultiParamDisabled Arity
n ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
howMany SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"parameters for class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
    where
      howMany :: String
howMany | Arity
n Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0 = String
"No"
              | Bool
otherwise = String
"Too many"
  DisabledClassExtension
FunDepsDisabled ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Fundeps in class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
  ConstrainedClassMethodsDisabled TyVar
sel_id Type
pred ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pred)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the type of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
sel_id))
              Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"constrains only the class type variables")]

pprImportLookup :: ImportLookupReason -> SDoc
pprImportLookup :: ImportLookupReason -> SDoc
pprImportLookup = \case
  ImportLookupBad BadImportKind
k ModIface
iface ImpDeclSpec
decl_spec IE GhcPs
ie Bool
_ps ->
    let
      pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
      pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec =
        SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImpDeclSpec -> Module
is_mod ImpDeclSpec
decl_spec)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case ModIface -> IsBootInterface
mi_boot ModIface
iface of
            IsBootInterface
IsBoot  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(hi-boot interface)"
            IsBootInterface
NotBoot -> SDoc
forall doc. IsOutput doc => doc
empty
      withContext :: [SDoc] -> SDoc
withContext [SDoc]
msgs =
        SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the import of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
          Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
msgs)
    in case BadImportKind
k of
      BadImportNotExported [GhcHint]
_ ->
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
          [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec ModIface
iface ImpDeclSpec
decl_spec SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not export" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
          ]
      BadImportKind
BadImportAvailVar ->
        [SDoc] -> SDoc
withContext
          [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an item called"
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
val SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported, but it is not a type."
          ]
        where
          val_occ :: OccName
val_occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
          val :: SDoc
val = OccName -> SDoc -> SDoc
parenSymOcc OccName
val_occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
val_occ)
      BadImportAvailTyCon {} ->
        [SDoc] -> SDoc
withContext
          [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an item called"
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
tycon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported, but it is a type."
          ]
        where
          tycon_occ :: OccName
tycon_occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
          tycon :: SDoc
tycon = OccName -> SDoc -> SDoc
parenSymOcc OccName
tycon_occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
tycon_occ)
      BadImportNotExportedSubordinates [OccName]
ns ->
        [SDoc] -> SDoc
withContext
          [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an item called" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
sub SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported, but it does not export any children"
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(constructors, class methods or field names) called"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (OccName -> SDoc) -> [OccName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (OccName -> SDoc) -> OccName -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [OccName]
ns SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
          ]
          where
            sub_occ :: OccName
sub_occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
            sub :: SDoc
sub = OccName -> SDoc -> SDoc
parenSymOcc OccName
sub_occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
sub_occ)
      BadImportAvailDataCon OccName
dataType_occ ->
        [SDoc] -> SDoc
withContext
          [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an item called" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
datacon
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported, but it is a data constructor of"
          , SDoc -> SDoc
quotes SDoc
dataType SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
          ]
          where
            datacon_occ :: OccName
datacon_occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName IE GhcPs
ie
            datacon :: SDoc
datacon = OccName -> SDoc -> SDoc
parenSymOcc OccName
datacon_occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
datacon_occ)
            dataType :: SDoc
dataType = OccName -> SDoc -> SDoc
parenSymOcc OccName
dataType_occ (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
dataType_occ)
  ImportLookupQualified RdrName
rdr ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal qualified name in import item:")
       Arity
2 (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
  ImportLookupReason
ImportLookupIllegal ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal import item"
  ImportLookupAmbiguous RdrName
rdr [GlobalRdrElt]
gres ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in import item. It could refer to:")
       Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GlobalRdrElt -> SDoc) -> [GlobalRdrElt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccName -> SDoc)
-> (GlobalRdrElt -> OccName) -> GlobalRdrElt -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName) [GlobalRdrElt]
gres))

pprUnusedImport :: ImportDecl GhcRn -> UnusedImportReason -> SDoc
pprUnusedImport :: ImportDecl (GhcPass 'Renamed) -> UnusedImportReason -> SDoc
pprUnusedImport ImportDecl (GhcPass 'Renamed)
decl = \case
  UnusedImportReason
UnusedImportNone ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
pp_herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is redundant"
         , Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"except perhaps to import instances from"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_mod)
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To import instances alone, use:"
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
forall doc. IsOutput doc => doc
empty ]
  UnusedImportSome [UnusedImportName]
sort_unused ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
pp_herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ((UnusedImportName -> SDoc) -> [UnusedImportName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas UnusedImportName -> SDoc
pp_unused [UnusedImportName]
sort_unused)
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"from module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is redundant"]
  where
    pp_mod :: SDoc
pp_mod = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl (GhcPass 'Renamed) -> XRec (GhcPass 'Renamed) ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl (GhcPass 'Renamed)
decl))
    pp_herald :: SDoc
pp_herald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_qual SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import of"
    pp_qual :: SDoc
pp_qual
      | ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (ImportDecl (GhcPass 'Renamed) -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl (GhcPass 'Renamed)
decl) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"qualified"
      | Bool
otherwise                                   = SDoc
forall doc. IsOutput doc => doc
empty
    pp_unused :: UnusedImportName -> SDoc
pp_unused = \case
      UnusedImportNameRegular Name
n ->
        Name -> SDoc
pprNameUnqualified Name
n
      UnusedImportNameRecField Parent
par OccName
fld_occ ->
        case Parent
par of
          ParentIs Name
p -> Name -> SDoc
pprNameUnqualified Name
p SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
fld_occ)
          Parent
NoParent   -> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
fld_occ

pprUnusedName :: OccName -> UnusedNameProv -> SDoc
pprUnusedName :: OccName -> UnusedNameProv -> SDoc
pprUnusedName OccName
name UnusedNameProv
reason =
  [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
      , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
name)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name)]
  where
    msg :: SDoc
msg = case UnusedNameProv
reason of
      UnusedNameProv
UnusedNameTopDecl ->
        SDoc
defined
      UnusedNameImported ModuleName
mod ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Imported from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but not used"
      UnusedNameProv
UnusedNameTypePattern ->
        SDoc
defined SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"on the right hand side"
      UnusedNameProv
UnusedNameMatch ->
        SDoc
defined
      UnusedNameProv
UnusedNameLocalBind ->
        SDoc
defined
    defined :: SDoc
defined = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Defined but not used"

-- When printing the name, take care to qualify it in the same
-- way as the provenance reported by pprNameProvenance, namely
-- the head of 'gre_imp'.  Otherwise we get confusing reports like
--   Ambiguous occurrence ‘null’
--   It could refer to either ‘T15487a.null’,
--                            imported from ‘Prelude’ at T15487.hs:1:8-13
--                     or ...
-- See #15487
pprAmbiguousGreName :: GlobalRdrEnv -> GlobalRdrElt -> SDoc
pprAmbiguousGreName :: GlobalRdrEnv -> GlobalRdrElt -> SDoc
pprAmbiguousGreName GlobalRdrEnv
gre_env GlobalRdrElt
gre
  | IAmRecField RecFieldInfo
fld_info <- GlobalRdrElt -> GREInfo
greInfo GlobalRdrElt
gre
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RecFieldInfo -> SDoc
parent_info RecFieldInfo
fld_info SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
        , GlobalRdrElt -> SDoc
forall info. GlobalRdrEltX info -> SDoc
pprNameProvenance GlobalRdrElt
gre ]
  | Bool
otherwise
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (SDoc
pp_qual SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
        , GlobalRdrElt -> SDoc
forall info. GlobalRdrEltX info -> SDoc
pprNameProvenance GlobalRdrElt
gre ]

  where
    occ :: OccName
occ = GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre
    parent_info :: RecFieldInfo -> SDoc
parent_info RecFieldInfo
fld_info =
      case ConLikeName
first_con of
        PatSynName  Name
ps -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of pattern synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
ps)
        DataConName {} ->
          case GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
gre of
            ParentIs Name
par
              -- For a data family, only reporting the family TyCon can be
              -- unhelpful (see T23301). So we give a bit of additional
              -- info in that case.
              | Just GlobalRdrElt
par_gre <- GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
gre_env Name
par
              , IAmTyCon TyConFlavour Name
tc_flav <- GlobalRdrElt -> GREInfo
greInfo GlobalRdrElt
par_gre
              , OpenFamilyFlavour TypeOrData
IAmData Maybe Name
_ <- TyConFlavour Name
tc_flav
              -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
ppr_cons
                      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a data family instance of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
par) ]
              | Bool
otherwise
              -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of record" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
par)
            Parent
NoParent -> SDoc
ppr_cons
      where
        cons :: [ConLikeName]
        cons :: [ConLikeName]
cons = UniqSet ConLikeName -> [ConLikeName]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (UniqSet ConLikeName -> [ConLikeName])
-> UniqSet ConLikeName -> [ConLikeName]
forall a b. (a -> b) -> a -> b
$ RecFieldInfo -> UniqSet ConLikeName
recFieldCons RecFieldInfo
fld_info
        first_con :: ConLikeName
        first_con :: ConLikeName
first_con = [ConLikeName] -> ConLikeName
forall a. HasCallStack => [a] -> a
head [ConLikeName]
cons
        ppr_cons :: SDoc
        ppr_cons :: SDoc
ppr_cons = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"belonging to data constructor"
                        , SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccName -> SDoc) -> OccName -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName (Name -> OccName) -> Name -> OccName
forall a b. (a -> b) -> a -> b
$ ConLikeName -> Name
conLikeName_Name ConLikeName
first_con)
                        , if [ConLikeName] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [ConLikeName]
cons Arity -> Arity -> Bool
forall a. Ord a => a -> a -> Bool
> Arity
1 then SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"among others") else SDoc
forall doc. IsOutput doc => doc
empty
                        ]
    pp_qual :: SDoc
pp_qual
        | GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
gre_lcl GlobalRdrElt
gre
        = Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Name -> Module
Name -> Module
nameModule (Name -> Module) -> Name -> Module
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
        | Just ImportSpec
imp  <- Bag ImportSpec -> Maybe ImportSpec
forall a. Bag a -> Maybe a
headMaybe (Bag ImportSpec -> Maybe ImportSpec)
-> Bag ImportSpec -> Maybe ImportSpec
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Bag ImportSpec
forall info. GlobalRdrEltX info -> Bag ImportSpec
gre_imp GlobalRdrElt
gre
            -- This 'imp' is the one that
            -- pprNameProvenance chooses
        , ImpDeclSpec { is_as :: ImpDeclSpec -> ModuleName
is_as = ModuleName
mod } <- ImportSpec -> ImpDeclSpec
is_decl ImportSpec
imp
        = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod
        | Bool
otherwise
        = String -> SDoc -> SDoc
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"addNameClassErrRn" (GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre)
          -- Invariant: either 'lcl' is True or 'iss' is non-empty

pprNonCanonicalDefinition :: LHsSigType GhcRn
                          -> NonCanonicalDefinition
                          -> SDoc
pprNonCanonicalDefinition :: LHsSigType (GhcPass 'Renamed) -> NonCanonicalDefinition -> SDoc
pprNonCanonicalDefinition LHsSigType (GhcPass 'Renamed)
inst_ty = \case
  NonCanonicalMonoid NonCanonical_Monoid
sub -> case NonCanonical_Monoid
sub of
    NonCanonical_Monoid
NonCanonical_Sappend ->
      String -> String -> SDoc
msg1 String
"(<>)" String
"mappend"
    NonCanonical_Monoid
NonCanonical_Mappend ->
      String -> String -> SDoc
msg2 String
"mappend" String
"(<>)"
  NonCanonicalMonad NonCanonical_Monad
sub -> case NonCanonical_Monad
sub of
    NonCanonical_Monad
NonCanonical_Pure ->
      String -> String -> SDoc
msg1 String
"pure" String
"return"
    NonCanonical_Monad
NonCanonical_ThenA ->
      String -> String -> SDoc
msg1 String
"(*>)" String
"(>>)"
    NonCanonical_Monad
NonCanonical_Return ->
      String -> String -> SDoc
msg2 String
"return" String
"pure"
    NonCanonical_Monad
NonCanonical_ThenM ->
      String -> String -> SDoc
msg2 String
"(>>)" String
"(*>)"
  where
    msg1 :: String -> String -> SDoc
    msg1 :: String -> String -> SDoc
msg1 String
lhs String
rhs =
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Noncanonical" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
lhs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rhs)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"definition detected"
          , SDoc
inst
          ]

    msg2 :: String -> String -> SDoc
    msg2 :: String -> String -> SDoc
msg2 String
lhs String
rhs =
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Noncanonical" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
lhs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"definition detected"
          , SDoc
inst
          , SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
lhs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"will eventually be removed in favour of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
rhs)
          ]

    inst :: SDoc
inst = LHsSigType (GhcPass 'Renamed) -> SDoc
instDeclCtxt1 LHsSigType (GhcPass 'Renamed)
inst_ty

    -- stolen from GHC.Tc.TyCl.Instance
    instDeclCtxt1 :: LHsSigType GhcRn -> SDoc
    instDeclCtxt1 :: LHsSigType (GhcPass 'Renamed) -> SDoc
instDeclCtxt1 LHsSigType (GhcPass 'Renamed)
hs_inst_ty
      = SDoc -> SDoc
inst_decl_ctxt (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LHsSigType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
getLHsInstDeclHead LHsSigType (GhcPass 'Renamed)
hs_inst_ty))

    inst_decl_ctxt :: SDoc -> SDoc
    inst_decl_ctxt :: SDoc -> SDoc
inst_decl_ctxt SDoc
doc = SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the instance declaration for")
                         Arity
2 (SDoc -> SDoc
quotes SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
".")

suggestNonCanonicalDefinition :: NonCanonicalDefinition -> [GhcHint]
suggestNonCanonicalDefinition :: NonCanonicalDefinition -> [GhcHint]
suggestNonCanonicalDefinition NonCanonicalDefinition
reason =
  [String -> GhcHint
action String
doc]
  where
    action :: String -> GhcHint
action = case NonCanonicalDefinition
reason of
      NonCanonicalMonoid NonCanonical_Monoid
sub -> case NonCanonical_Monoid
sub of
        NonCanonical_Monoid
NonCanonical_Sappend -> Name -> Name -> String -> GhcHint
move Name
sappendName Name
mappendName
        NonCanonical_Monoid
NonCanonical_Mappend -> Name -> Name -> String -> GhcHint
remove Name
mappendName Name
sappendName
      NonCanonicalMonad NonCanonical_Monad
sub -> case NonCanonical_Monad
sub of
        NonCanonical_Monad
NonCanonical_Pure -> Name -> Name -> String -> GhcHint
move Name
pureAName Name
returnMName
        NonCanonical_Monad
NonCanonical_ThenA -> Name -> Name -> String -> GhcHint
move Name
thenAName Name
thenMName
        NonCanonical_Monad
NonCanonical_Return -> Name -> Name -> String -> GhcHint
remove Name
returnMName Name
pureAName
        NonCanonical_Monad
NonCanonical_ThenM -> Name -> Name -> String -> GhcHint
remove Name
thenMName Name
thenAName

    move :: Name -> Name -> String -> GhcHint
move = Name -> Name -> String -> GhcHint
SuggestMoveNonCanonicalDefinition
    remove :: Name -> Name -> String -> GhcHint
remove = Name -> Name -> String -> GhcHint
SuggestRemoveNonCanonicalDefinition

    doc :: String
doc = case NonCanonicalDefinition
reason of
      NonCanonicalMonoid NonCanonical_Monoid
_ -> String
doc_monoid
      NonCanonicalMonad NonCanonical_Monad
_ -> String
doc_monad

    doc_monoid :: String
doc_monoid =
      String
"https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid"
    doc_monad :: String
doc_monad =
      String
"https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return"

--------------------------------------------------------------------------------
-- hs-boot mismatch errors

pprBootMismatch :: HsBootOrSig -> BootMismatch -> SDoc
pprBootMismatch :: HsBootOrSig -> BootMismatch -> SDoc
pprBootMismatch HsBootOrSig
boot_or_sig = \case
  MissingBootThing Name
nm MissingBootThing
err ->
    let def_or_exp :: SDoc
def_or_exp = case MissingBootThing
err of
          MissingBootThing
MissingBootDefinition -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"defined in"
          MissingBootThing
MissingBootExport     -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exported by"
    in SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported by the"
       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ppr_boot_or_sig SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but not"
       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
def_or_exp SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the implementing module."
  MissingBootInstance TyVar
boot_dfun ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyVar -> Type
idType TyVar
boot_dfun))
       Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is defined in the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SDoc
ppr_boot_or_sig SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but not in the implementing module.")
  BadReexportedBootThing Name
name Name
name' ->
    NamePprCtx -> Depth -> SDoc -> SDoc
withUserStyle NamePprCtx
alwaysQualify Depth
AllTheWay (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
        [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ppr_boot_or_sig
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(re)exports" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but the implementing module exports a different identifier" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name')
        ]
  BootMismatch TyThing
boot_thing TyThing
real_thing BootMismatchWhat
err ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
      [ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
real_thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has conflicting definitions in the module"
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and its" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ppr_boot_or_sig SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot,
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Main module:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
real_doc
      , (case HsBootOrSig
boot_or_sig of
          HsBootOrSig
HsBoot -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Boot file:"
          HsBootOrSig
Hsig   -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Hsig file:") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
boot_doc
      , HsBootOrSig -> BootMismatchWhat -> SDoc
pprBootMismatchWhat HsBootOrSig
boot_or_sig BootMismatchWhat
err
      ]
      where
        to_doc :: TyThing -> SDoc
to_doc
          = ShowSub -> TyThing -> SDoc
pprTyThingInContext (ShowSub -> TyThing -> SDoc) -> ShowSub -> TyThing -> SDoc
forall a b. (a -> b) -> a -> b
$
            ShowSub
showToHeader
              { ss_forall =
                  case boot_or_sig of
                    HsBootOrSig
HsBoot -> ShowForAllFlag
ShowForAllMust
                    HsBootOrSig
Hsig   -> ShowForAllFlag
ShowForAllWhen }

        real_doc :: SDoc
real_doc = TyThing -> SDoc
to_doc TyThing
real_thing
        boot_doc :: SDoc
boot_doc = TyThing -> SDoc
to_doc TyThing
boot_thing

  where
    ppr_boot_or_sig :: SDoc
ppr_boot_or_sig = case HsBootOrSig
boot_or_sig of
      HsBootOrSig
HsBoot -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hs-boot file"
      HsBootOrSig
Hsig   -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hsig file"


pprBootMismatchWhat :: HsBootOrSig -> BootMismatchWhat -> SDoc
pprBootMismatchWhat :: HsBootOrSig -> BootMismatchWhat -> SDoc
pprBootMismatchWhat HsBootOrSig
boot_or_sig = \case
  BootMismatchedIdTypes {} ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The two types are different."
  BootMismatchedTyCons TyCon
tc1 TyCon
tc2 NonEmpty BootTyConMismatch
errs ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (BootTyConMismatch -> SDoc) -> [BootTyConMismatch] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (HsBootOrSig -> TyCon -> TyCon -> BootTyConMismatch -> SDoc
pprBootTyConMismatch HsBootOrSig
boot_or_sig TyCon
tc1 TyCon
tc2) (NonEmpty BootTyConMismatch -> [BootTyConMismatch]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty BootTyConMismatch
errs)

pprBootTyConMismatch :: HsBootOrSig -> TyCon -> TyCon
                     -> BootTyConMismatch -> SDoc
pprBootTyConMismatch :: HsBootOrSig -> TyCon -> TyCon -> BootTyConMismatch -> SDoc
pprBootTyConMismatch HsBootOrSig
boot_or_sig TyCon
tc1 TyCon
tc2 = \case
  BootTyConMismatch
TyConKindMismatch ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The types have different kinds."
  TyConRoleMismatch Bool
sub_type ->
    if Bool
sub_type
    then
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The roles are not compatible:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Main module:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Role] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> [Role]
tyConRoles TyCon
tc1) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Hsig file:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Role] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> [Role]
tyConRoles TyCon
tc2)
    else
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The roles do not match." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      if HsBootOrSig
boot_or_sig HsBootOrSig -> HsBootOrSig -> Bool
forall a. Eq a => a -> a -> Bool
== HsBootOrSig
HsBoot
      then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: roles on abstract types default to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"representational") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in hs-boot files."
      else SDoc
forall doc. IsOutput doc => doc
empty
  TyConSynonymMismatch {} -> SDoc
forall doc. IsOutput doc => doc
empty -- nothing interesting to say
  TyConFlavourMismatch FamTyConFlav
fam_flav1 FamTyConFlav
fam_flav2 ->
    SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Family flavours" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FamTyConFlav -> SDoc
forall a. Outputable a => a -> SDoc
ppr FamTyConFlav
fam_flav1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FamTyConFlav -> SDoc
forall a. Outputable a => a -> SDoc
ppr FamTyConFlav
fam_flav2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"do not match"
  TyConAxiomMismatch BootListMismatches CoAxBranch BootAxiomBranchMismatch
ax_errs ->
    SDoc
-> (BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc)
-> BootListMismatches CoAxBranch BootAxiomBranchMismatch
-> SDoc
forall item err.
SDoc
-> (BootListMismatch item err -> SDoc)
-> BootListMismatches item err
-> SDoc
pprBootListMismatches (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type family equations do not match:")
      BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc
pprTyConAxiomMismatch BootListMismatches CoAxBranch BootAxiomBranchMismatch
ax_errs
  TyConInjectivityMismatch {} ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Injectivity annotations do not match"
  TyConMismatchedClasses Class
_ Class
_ BootClassMismatch
err ->
    HsBootOrSig -> BootClassMismatch -> SDoc
pprBootClassMismatch HsBootOrSig
boot_or_sig BootClassMismatch
err
  TyConMismatchedData AlgTyConRhs
_rhs1 AlgTyConRhs
_rhs2 BootDataMismatch
err ->
    BootDataMismatch -> SDoc
pprBootDataMismatch BootDataMismatch
err
  SynAbstractData SynAbstractDataError
err ->
    SynAbstractDataError -> SDoc
pprSynAbstractDataError SynAbstractDataError
err
  BootTyConMismatch
TyConsVeryDifferent ->
    SDoc
forall doc. IsOutput doc => doc
empty -- should be obvious to the user what the problem is

pprSynAbstractDataError :: SynAbstractDataError -> SDoc
pprSynAbstractDataError :: SynAbstractDataError -> SDoc
pprSynAbstractDataError = \case
  SynAbstractDataError
SynAbsDataTySynNotNullary ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal parameterized type synonym in implementation of abstract data."
  SynAbstractDataInvalidRHS NonEmpty Type
bad_sub_tys ->
    let msgs :: [SDoc]
msgs = (Type -> Maybe SDoc) -> [Type] -> [SDoc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Type -> Maybe SDoc
pprInvalidAbstractSubTy (NonEmpty Type -> [Type]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Type
bad_sub_tys)
    in  case [SDoc]
msgs of
      []     -> SDoc
herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
      SDoc
msg:[] -> SDoc -> Arity -> SDoc -> SDoc
hang (SDoc
herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
                   Arity
2 SDoc
msg
      [SDoc]
_      -> SDoc -> Arity -> SDoc -> SDoc
hang (SDoc
herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
                   Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
bullet) [SDoc]
msgs)

  where
    herald :: SDoc
herald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal implementation of abstract data"
    pprInvalidAbstractSubTy :: Type -> Maybe SDoc
pprInvalidAbstractSubTy = \case
      TyConApp TyCon
tc [Type]
_
        -> Bool -> SDoc -> Maybe SDoc -> Maybe SDoc
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TyCon -> Bool
isTypeFamilyTyCon TyCon
tc) (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) (Maybe SDoc -> Maybe SDoc) -> Maybe SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid type family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
      ty :: Type
ty@(ForAllTy {})
        -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid polymorphic type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
      ty :: Type
ty@(FunTy FunTyFlag
af Type
_ Type
_ Type
_)
        | Bool -> Bool
not (FunTyFlag
af FunTyFlag -> FunTyFlag -> Bool
forall a. Eq a => a -> a -> Bool
== FunTyFlag
FTF_T_T)
        -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid qualified type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
      Type
_ -> Maybe SDoc
forall a. Maybe a
Nothing

pprTyConAxiomMismatch :: BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc
pprTyConAxiomMismatch :: BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc
pprTyConAxiomMismatch = \case
  BootListMismatch CoAxBranch BootAxiomBranchMismatch
MismatchedLength ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The number of equations differs."
  MismatchedThing Arity
i CoAxBranch
br1 CoAxBranch
br2 BootAxiomBranchMismatch
err ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
speakNth (Arity
iArity -> Arity -> Arity
forall a. Num a => a -> a -> a
+Arity
1) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"equations do not match.")
       Arity
2 (CoAxBranch -> CoAxBranch -> BootAxiomBranchMismatch -> SDoc
pprCoAxBranchMismatch CoAxBranch
br1 CoAxBranch
br2 BootAxiomBranchMismatch
err)

pprCoAxBranchMismatch :: CoAxBranch -> CoAxBranch -> BootAxiomBranchMismatch -> SDoc
pprCoAxBranchMismatch :: CoAxBranch -> CoAxBranch -> BootAxiomBranchMismatch -> SDoc
pprCoAxBranchMismatch CoAxBranch
_br1 CoAxBranch
_br2 BootAxiomBranchMismatch
err =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"don't match."
  where
    what :: SDoc
what = case BootAxiomBranchMismatch
err of
      BootAxiomBranchMismatch
MismatchedAxiomBinders -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variables bound in the equation"
      BootAxiomBranchMismatch
MismatchedAxiomLHS     -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"equation left-hand sides"
      BootAxiomBranchMismatch
MismatchedAxiomRHS     -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"equation right-hand sides"

pprBootListMismatches :: SDoc -- ^ herald
                      -> (BootListMismatch item err -> SDoc)
                      -> BootListMismatches item err -> SDoc
pprBootListMismatches :: forall item err.
SDoc
-> (BootListMismatch item err -> SDoc)
-> BootListMismatches item err
-> SDoc
pprBootListMismatches SDoc
herald BootListMismatch item err -> SDoc
ppr_one BootListMismatches item err
errs =
  SDoc -> Arity -> SDoc -> SDoc
hang SDoc
herald Arity
2 SDoc
msgs
  where
    msgs :: SDoc
msgs = case BootListMismatches item err
errs of
      BootListMismatch item err
err :| [] -> BootListMismatch item err -> SDoc
ppr_one BootListMismatch item err
err
      BootListMismatches item err
_         -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (BootListMismatch item err -> SDoc)
-> [BootListMismatch item err] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((SDoc
bullet SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>) (SDoc -> SDoc)
-> (BootListMismatch item err -> SDoc)
-> BootListMismatch item err
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BootListMismatch item err -> SDoc
ppr_one) ([BootListMismatch item err] -> [SDoc])
-> [BootListMismatch item err] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ BootListMismatches item err -> [BootListMismatch item err]
forall a. NonEmpty a -> [a]
NE.toList BootListMismatches item err
errs

pprBootClassMismatch :: HsBootOrSig -> BootClassMismatch -> SDoc
pprBootClassMismatch :: HsBootOrSig -> BootClassMismatch -> SDoc
pprBootClassMismatch HsBootOrSig
boot_or_sig = \case
  MismatchedMethods BootListMismatches ClassOpItem BootMethodMismatch
errs ->
    SDoc
-> (BootListMismatch ClassOpItem BootMethodMismatch -> SDoc)
-> BootListMismatches ClassOpItem BootMethodMismatch
-> SDoc
forall item err.
SDoc
-> (BootListMismatch item err -> SDoc)
-> BootListMismatches item err
-> SDoc
pprBootListMismatches (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The class methods do not match:")
      BootListMismatch ClassOpItem BootMethodMismatch -> SDoc
pprBootClassMethodListMismatch BootListMismatches ClassOpItem BootMethodMismatch
errs
  MismatchedATs BootListMismatches ClassATItem BootATMismatch
at_errs ->
    SDoc
-> (BootListMismatch ClassATItem BootATMismatch -> SDoc)
-> BootListMismatches ClassATItem BootATMismatch
-> SDoc
forall item err.
SDoc
-> (BootListMismatch item err -> SDoc)
-> BootListMismatches item err
-> SDoc
pprBootListMismatches (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The associated types do not match:")
      (HsBootOrSig -> BootListMismatch ClassATItem BootATMismatch -> SDoc
pprATMismatch HsBootOrSig
boot_or_sig) BootListMismatches ClassATItem BootATMismatch
at_errs
  BootClassMismatch
MismatchedFunDeps ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The functional dependencies do not match."
  BootClassMismatch
MismatchedSuperclasses ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The superclass constraints do not match."
  BootClassMismatch
MismatchedMinimalPragmas ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The MINIMAL pragmas are not compatible."

pprATMismatch :: HsBootOrSig -> BootListMismatch ClassATItem BootATMismatch -> SDoc
pprATMismatch :: HsBootOrSig -> BootListMismatch ClassATItem BootATMismatch -> SDoc
pprATMismatch HsBootOrSig
boot_or_sig = \case
  BootListMismatch ClassATItem BootATMismatch
MismatchedLength ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The number of associated type defaults differs."
  MismatchedThing Arity
i ClassATItem
at1 ClassATItem
at2 BootATMismatch
err ->
    HsBootOrSig
-> Arity -> ClassATItem -> ClassATItem -> BootATMismatch -> SDoc
pprATMismatchErr HsBootOrSig
boot_or_sig Arity
i ClassATItem
at1 ClassATItem
at2 BootATMismatch
err

pprATMismatchErr :: HsBootOrSig -> Int -> ClassATItem -> ClassATItem -> BootATMismatch -> SDoc
pprATMismatchErr :: HsBootOrSig
-> Arity -> ClassATItem -> ClassATItem -> BootATMismatch -> SDoc
pprATMismatchErr HsBootOrSig
boot_or_sig Arity
i (ATI TyCon
tc1 Maybe (Type, TyFamEqnValidityInfo)
_) (ATI TyCon
tc2 Maybe (Type, TyFamEqnValidityInfo)
_) = \case
  MismatchedTyConAT BootTyConMismatch
err ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The associated types differ:")
       Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ HsBootOrSig -> TyCon -> TyCon -> BootTyConMismatch -> SDoc
pprBootTyConMismatch HsBootOrSig
boot_or_sig TyCon
tc1 TyCon
tc2 BootTyConMismatch
err
  BootATMismatch
MismatchedATDefaultType ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The types of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
speakNth (Arity
iArity -> Arity -> Arity
forall a. Num a => a -> a -> a
+Arity
1) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"associated type default differ."

pprBootClassMethodListMismatch :: BootListMismatch ClassOpItem BootMethodMismatch -> SDoc
pprBootClassMethodListMismatch :: BootListMismatch ClassOpItem BootMethodMismatch -> SDoc
pprBootClassMethodListMismatch = \case
  BootListMismatch ClassOpItem BootMethodMismatch
MismatchedLength ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The number of class methods differs."
  MismatchedThing Arity
_ ClassOpItem
op1 ClassOpItem
op2 BootMethodMismatch
err ->
    ClassOpItem -> ClassOpItem -> BootMethodMismatch -> SDoc
pprBootClassMethodMismatch ClassOpItem
op1 ClassOpItem
op2 BootMethodMismatch
err

pprBootClassMethodMismatch :: ClassOpItem -> ClassOpItem -> BootMethodMismatch -> SDoc
pprBootClassMethodMismatch :: ClassOpItem -> ClassOpItem -> BootMethodMismatch -> SDoc
pprBootClassMethodMismatch (TyVar
op1, DefMethInfo
_) (TyVar
op2, DefMethInfo
_) = \case
  BootMethodMismatch
MismatchedMethodNames ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The method names" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and"
                            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pname2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"differ."
  MismatchedMethodTypes {} ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The types of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are different."
  MismatchedDefaultMethods Bool
subtype_check ->
    if Bool
subtype_check
    then
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The default methods associated with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are not compatible."
    else
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The default methods associated with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are different."
  where
    nm1 :: Name
nm1 = TyVar -> Name
idName TyVar
op1
    nm2 :: Name
nm2 = TyVar -> Name
idName TyVar
op2
    pname1 :: SDoc
pname1 = SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm1)
    pname2 :: SDoc
pname2 = SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm2)

pprBootDataMismatch :: BootDataMismatch -> SDoc
pprBootDataMismatch :: BootDataMismatch -> SDoc
pprBootDataMismatch = \case
  BootDataMismatch
MismatchedNewtypeVsData ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot match a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"definition with a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newtype") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"definition."
  MismatchedConstructors BootListMismatches DataCon BootDataConMismatch
dc_errs ->
    SDoc
-> (BootListMismatch DataCon BootDataConMismatch -> SDoc)
-> BootListMismatches DataCon BootDataConMismatch
-> SDoc
forall item err.
SDoc
-> (BootListMismatch item err -> SDoc)
-> BootListMismatches item err
-> SDoc
pprBootListMismatches (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The constructors do not match:")
      BootListMismatch DataCon BootDataConMismatch -> SDoc
pprBootDataConMismatch BootListMismatches DataCon BootDataConMismatch
dc_errs
  MismatchedDatatypeContexts {} ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The datatype contexts do not match."

pprBootDataConMismatch :: BootListMismatch DataCon BootDataConMismatch
                       -> SDoc
pprBootDataConMismatch :: BootListMismatch DataCon BootDataConMismatch -> SDoc
pprBootDataConMismatch = \case
  BootListMismatch DataCon BootDataConMismatch
MismatchedLength ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The number of constructors differs."
  MismatchedThing Arity
_ DataCon
dc1 DataCon
dc2 BootDataConMismatch
err ->
    DataCon -> DataCon -> BootDataConMismatch -> SDoc
pprBootDataConMismatchErr DataCon
dc1 DataCon
dc2 BootDataConMismatch
err

pprBootDataConMismatchErr :: DataCon -> DataCon -> BootDataConMismatch -> SDoc
pprBootDataConMismatchErr :: DataCon -> DataCon -> BootDataConMismatch -> SDoc
pprBootDataConMismatchErr DataCon
dc1 DataCon
dc2 = \case
  BootDataConMismatch
MismatchedDataConNames ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The names" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"differ."
  BootDataConMismatch
MismatchedDataConFixities ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The fixities of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"differ."
  BootDataConMismatch
MismatchedDataConBangs ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The strictness annotations for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"differ."
  BootDataConMismatch
MismatchedDataConFieldLabels ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The record label lists for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"differ."
  BootDataConMismatch
MismatchedDataConTypes ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The types for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"differ."
  where
     name1 :: Name
name1 = DataCon -> Name
dataConName DataCon
dc1
     name2 :: Name
name2 = DataCon -> Name
dataConName DataCon
dc2
     pname1 :: SDoc
pname1 = SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name1)
     pname2 :: SDoc
pname2 = SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name2)

--------------------------------------------------------------------------------
-- Illegal instance errors

pprIllegalInstance :: IllegalInstanceReason -> SDoc
pprIllegalInstance :: IllegalInstanceReason -> SDoc
pprIllegalInstance = \case
  IllegalClassInstance TypedThing
head_ty IllegalClassInstanceReason
reason ->
    TypedThing -> IllegalClassInstanceReason -> SDoc
pprIllegalClassInstanceReason TypedThing
head_ty IllegalClassInstanceReason
reason
  IllegalFamilyInstance IllegalFamilyInstanceReason
reason ->
    IllegalFamilyInstanceReason -> SDoc
pprIllegalFamilyInstance IllegalFamilyInstanceReason
reason
  IllegalFamilyApplicationInInstance Type
inst_ty Bool
invis_arg TyCon
tf_tc [Type]
tf_args ->
    Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
invis_arg (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal type synonym family application"
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tf_ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
         Arity
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
inst_ty)
      where
        tf_ty :: Type
tf_ty = TyCon -> [Type] -> Type
mkTyConApp TyCon
tf_tc [Type]
tf_args

pprIllegalClassInstanceReason :: TypedThing -> IllegalClassInstanceReason -> SDoc
pprIllegalClassInstanceReason :: TypedThing -> IllegalClassInstanceReason -> SDoc
pprIllegalClassInstanceReason TypedThing
head_ty = \case
  IllegalInstanceHead IllegalInstanceHeadReason
reason ->
    TypedThing -> IllegalInstanceHeadReason -> SDoc
pprIllegalInstanceHeadReason TypedThing
head_ty IllegalInstanceHeadReason
reason
  IllegalHasFieldInstance IllegalHasFieldInstance
has_field_err ->
    TypedThing -> SDoc -> SDoc
with_illegal_instance_header TypedThing
head_ty (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      IllegalHasFieldInstance -> SDoc
pprIllegalHasFieldInstance IllegalHasFieldInstance
has_field_err
  IllegalSpecialClassInstance Class
cls Bool
because_safeHaskell ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ Class -> Name
className Class
cls)
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not support user-specified instances"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
safeHaskell_msg
      where
        safeHaskell_msg :: SDoc
safeHaskell_msg
          | Bool
because_safeHaskell
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" when Safe Haskell is enabled."
          | Bool
otherwise
          = SDoc
forall doc. IsLine doc => doc
dot
  IllegalInstanceFailsCoverageCondition Class
cls CoverageProblem
coverage_failure ->
    TypedThing -> SDoc -> SDoc
with_illegal_instance_header TypedThing
head_ty (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      Class -> CoverageProblem -> SDoc
pprNotCovered Class
cls CoverageProblem
coverage_failure

pprIllegalInstanceHeadReason :: TypedThing
                             -> IllegalInstanceHeadReason -> SDoc
pprIllegalInstanceHeadReason :: TypedThing -> IllegalInstanceHeadReason -> SDoc
pprIllegalInstanceHeadReason TypedThing
head_ty = \case
  IllegalInstanceHeadReason
InstHeadTySynArgs -> TypedThing -> SDoc -> SDoc
with_illegal_instance_header TypedThing
head_ty (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"All instance types must be of the form (T t1 ... tn)" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where T is not a synonym."
  IllegalInstanceHeadReason
InstHeadNonTyVarArgs -> TypedThing -> SDoc -> SDoc
with_illegal_instance_header TypedThing
head_ty (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"All instance types must be of the form (T a1 ... an)",
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where a1 ... an are *distinct type variables*,",
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and each type variable appears at most once in the instance head."]
  IllegalInstanceHeadReason
InstHeadMultiParam -> TypedThing -> SDoc -> SDoc
with_illegal_instance_header TypedThing
head_ty (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Only one type can be given in an instance head."
  InstHeadAbstractClass Class
clas ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot define instance for abstract class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Class -> Name
className Class
clas))
  InstHeadNonClass Maybe TyCon
bad_head ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what_illegal SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Instance heads must be of the form"
         , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"C ty_1 ... ty_n"
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'C') SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a class."
         ]
    where
      what_illegal :: SDoc
what_illegal = case Maybe TyCon
bad_head of
        Just TyCon
tc ->
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyConFlavour TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> TyConFlavour TyCon
tyConFlavour TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
tyConName TyCon
tc)
        Maybe TyCon
Nothing ->
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"head of an instance declaration:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
head_ty)

with_illegal_instance_header :: TypedThing -> SDoc -> SDoc
with_illegal_instance_header :: TypedThing -> SDoc -> SDoc
with_illegal_instance_header TypedThing
head_ty SDoc
msg =
  SDoc -> Arity -> SDoc -> SDoc
hang (SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal instance declaration for")
           Arity
2 (SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
head_ty)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
      Arity
2 SDoc
msg

pprIllegalHasFieldInstance :: IllegalHasFieldInstance -> SDoc
pprIllegalHasFieldInstance :: IllegalHasFieldInstance -> SDoc
pprIllegalHasFieldInstance = \case
  IllegalHasFieldInstance
IllegalHasFieldInstanceNotATyCon
    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record data type must be specified."
  IllegalHasFieldInstance
IllegalHasFieldInstanceFamilyTyCon
    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record data type may not be a data family."
  IllegalHasFieldInstanceTyConHasField TyCon
tc FieldLabelString
lbl
    -> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"already has a field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
lbl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
  IllegalHasFieldInstanceTyConHasFields TyCon
tc Type
lbl
    -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
ppr_tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has fields, and the type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lbl)
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"could unify with one of the field labels of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ppr_tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot ]
    where ppr_tc :: SDoc
ppr_tc = SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)

pprNotCovered :: Class -> CoverageProblem -> SDoc
pprNotCovered :: Class -> CoverageProblem -> SDoc
pprNotCovered Class
clas
  CoverageProblem
  { not_covered_fundep :: CoverageProblem -> ([TyVar], [TyVar])
not_covered_fundep        = ([TyVar], [TyVar])
fd
  , not_covered_fundep_inst :: CoverageProblem -> ([Type], [Type])
not_covered_fundep_inst   = ([Type]
ls, [Type]
rs)
  , not_covered_invis_vis_tvs :: CoverageProblem -> Pair VarSet
not_covered_invis_vis_tvs = Pair VarSet
undetermined_tvs
  , not_covered_liberal :: CoverageProblem -> FailedCoverageCondition
not_covered_liberal       = FailedCoverageCondition
which_cc_failed
  } =
  Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen (VarSet -> Bool
isEmptyVarSet (VarSet -> Bool) -> VarSet -> Bool
forall a b. (a -> b) -> a -> b
$ Pair VarSet -> VarSet
forall a. Pair a -> a
pSnd Pair VarSet
undetermined_tvs) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
liberal (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"liberal")
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"coverage condition fails in class"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
clas)
                , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for functional dependency:"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (([TyVar], [TyVar]) -> SDoc
forall a. Outputable a => FunDep a -> SDoc
pprFunDep ([TyVar], [TyVar])
fd) ]
          , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reason: lhs type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Type] -> SDoc
forall a. [a] -> SDoc
plural [Type]
ls SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [Type]
ls
                , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  (if [Type] -> Bool
forall a. [a] -> Bool
isSingleton [Type]
ls
                  then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not"
                  else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"do not jointly")
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"determine rhs type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Type] -> SDoc
forall a. [a] -> SDoc
plural [Type]
rs
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [Type]
rs ]
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Un-determined variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> VarSet -> SDoc
pluralVarSet VarSet
undet_set SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> VarSet -> ([TyVar] -> SDoc) -> SDoc
pprVarSet VarSet
undet_set ((TyVar -> SDoc) -> [TyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr)
          ]
  where
    liberal :: Bool
liberal = case FailedCoverageCondition
which_cc_failed of
                   FailedCoverageCondition
FailedLICC   -> Bool
True
                   FailedICC {} -> Bool
False
    undet_set :: VarSet
undet_set = Pair VarSet -> VarSet
forall m. Monoid m => Pair m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Pair VarSet
undetermined_tvs

illegalInstanceHints :: IllegalInstanceReason -> [GhcHint]
illegalInstanceHints :: IllegalInstanceReason -> [GhcHint]
illegalInstanceHints = \case
  IllegalClassInstance TypedThing
_ IllegalClassInstanceReason
reason ->
    IllegalClassInstanceReason -> [GhcHint]
illegalClassInstanceHints IllegalClassInstanceReason
reason
  IllegalFamilyInstance IllegalFamilyInstanceReason
reason ->
    IllegalFamilyInstanceReason -> [GhcHint]
illegalFamilyInstanceHints IllegalFamilyInstanceReason
reason
  IllegalFamilyApplicationInInstance {} ->
    [GhcHint]
noHints

illegalInstanceReason :: IllegalInstanceReason -> DiagnosticReason
illegalInstanceReason :: IllegalInstanceReason -> DiagnosticReason
illegalInstanceReason = \case
  IllegalClassInstance TypedThing
_ IllegalClassInstanceReason
reason ->
    IllegalClassInstanceReason -> DiagnosticReason
illegalClassInstanceReason IllegalClassInstanceReason
reason
  IllegalFamilyInstance IllegalFamilyInstanceReason
reason ->
    IllegalFamilyInstanceReason -> DiagnosticReason
illegalFamilyInstanceReason IllegalFamilyInstanceReason
reason
  IllegalFamilyApplicationInInstance {} ->
    DiagnosticReason
ErrorWithoutFlag

illegalClassInstanceHints :: IllegalClassInstanceReason -> [GhcHint]
illegalClassInstanceHints :: IllegalClassInstanceReason -> [GhcHint]
illegalClassInstanceHints = \case
  IllegalInstanceHead IllegalInstanceHeadReason
reason ->
    IllegalInstanceHeadReason -> [GhcHint]
illegalInstanceHeadHints IllegalInstanceHeadReason
reason
  IllegalHasFieldInstance IllegalHasFieldInstance
has_field_err ->
    IllegalHasFieldInstance -> [GhcHint]
illegalHasFieldInstanceHints IllegalHasFieldInstance
has_field_err
  IllegalSpecialClassInstance {} -> [GhcHint]
noHints
  IllegalInstanceFailsCoverageCondition Class
_ CoverageProblem
coverage_failure ->
    CoverageProblem -> [GhcHint]
failedCoverageConditionHints CoverageProblem
coverage_failure


illegalClassInstanceReason :: IllegalClassInstanceReason -> DiagnosticReason
illegalClassInstanceReason :: IllegalClassInstanceReason -> DiagnosticReason
illegalClassInstanceReason = \case
  IllegalInstanceHead IllegalInstanceHeadReason
reason ->
    IllegalInstanceHeadReason -> DiagnosticReason
illegalInstanceHeadReason IllegalInstanceHeadReason
reason
  IllegalHasFieldInstance IllegalHasFieldInstance
has_field_err ->
    IllegalHasFieldInstance -> DiagnosticReason
illegalHasFieldInstanceReason IllegalHasFieldInstance
has_field_err
  IllegalSpecialClassInstance {} -> DiagnosticReason
ErrorWithoutFlag
  IllegalInstanceFailsCoverageCondition Class
_ CoverageProblem
coverage_failure ->
    CoverageProblem -> DiagnosticReason
failedCoverageConditionReason CoverageProblem
coverage_failure

illegalInstanceHeadHints :: IllegalInstanceHeadReason -> [GhcHint]
illegalInstanceHeadHints :: IllegalInstanceHeadReason -> [GhcHint]
illegalInstanceHeadHints = \case
  IllegalInstanceHeadReason
InstHeadTySynArgs ->
    [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeSynonymInstances]
  IllegalInstanceHeadReason
InstHeadNonTyVarArgs ->
    [Extension -> GhcHint
suggestExtension Extension
LangExt.FlexibleInstances]
  IllegalInstanceHeadReason
InstHeadMultiParam ->
    [Extension -> GhcHint
suggestExtension Extension
LangExt.MultiParamTypeClasses]
  InstHeadAbstractClass {} ->
    [GhcHint]
noHints
  InstHeadNonClass {} ->
    [GhcHint]
noHints

illegalInstanceHeadReason :: IllegalInstanceHeadReason -> DiagnosticReason
illegalInstanceHeadReason :: IllegalInstanceHeadReason -> DiagnosticReason
illegalInstanceHeadReason = \case
  -- These are serious
  InstHeadAbstractClass {} ->
    DiagnosticReason
ErrorWithoutFlag
  InstHeadNonClass {} ->
    DiagnosticReason
ErrorWithoutFlag

  -- These are less serious (enable an extension)
  IllegalInstanceHeadReason
InstHeadTySynArgs ->
    DiagnosticReason
ErrorWithoutFlag
  IllegalInstanceHeadReason
InstHeadNonTyVarArgs ->
    DiagnosticReason
ErrorWithoutFlag
  IllegalInstanceHeadReason
InstHeadMultiParam ->
    DiagnosticReason
ErrorWithoutFlag

illegalHasFieldInstanceHints :: IllegalHasFieldInstance -> [GhcHint]
illegalHasFieldInstanceHints :: IllegalHasFieldInstance -> [GhcHint]
illegalHasFieldInstanceHints = \case
  IllegalHasFieldInstance
IllegalHasFieldInstanceNotATyCon
    -> [GhcHint]
noHints
  IllegalHasFieldInstance
IllegalHasFieldInstanceFamilyTyCon
    -> [GhcHint]
noHints
  IllegalHasFieldInstanceTyConHasField {}
    -> [GhcHint]
noHints
  IllegalHasFieldInstanceTyConHasFields {}
    -> [GhcHint]
noHints

illegalHasFieldInstanceReason :: IllegalHasFieldInstance -> DiagnosticReason
illegalHasFieldInstanceReason :: IllegalHasFieldInstance -> DiagnosticReason
illegalHasFieldInstanceReason = \case
  IllegalHasFieldInstance
IllegalHasFieldInstanceNotATyCon
    -> DiagnosticReason
ErrorWithoutFlag
  IllegalHasFieldInstance
IllegalHasFieldInstanceFamilyTyCon
    -> DiagnosticReason
ErrorWithoutFlag
  IllegalHasFieldInstanceTyConHasField {}
    -> DiagnosticReason
ErrorWithoutFlag
  IllegalHasFieldInstanceTyConHasFields {}
    -> DiagnosticReason
ErrorWithoutFlag

failedCoverageConditionHints :: CoverageProblem -> [GhcHint]
failedCoverageConditionHints :: CoverageProblem -> [GhcHint]
failedCoverageConditionHints (CoverageProblem { not_covered_liberal :: CoverageProblem -> FailedCoverageCondition
not_covered_liberal = FailedCoverageCondition
failed_cc })
  = case FailedCoverageCondition
failed_cc of
      FailedCoverageCondition
FailedLICC -> [GhcHint]
noHints
      FailedICC { alsoFailedLICC :: FailedCoverageCondition -> Bool
alsoFailedLICC = Bool
failed_licc } ->
        -- Turning on UndecidableInstances makes the check liberal,
        -- so if the liberal check passes, suggest enabling UndecidableInstances.
        if Bool
failed_licc
        then [GhcHint]
noHints
        else [Extension -> GhcHint
suggestExtension Extension
LangExt.UndecidableInstances]

failedCoverageConditionReason :: CoverageProblem -> DiagnosticReason
failedCoverageConditionReason :: CoverageProblem -> DiagnosticReason
failedCoverageConditionReason CoverageProblem
_ = DiagnosticReason
ErrorWithoutFlag

pprIllegalFamilyInstance :: IllegalFamilyInstanceReason -> SDoc
pprIllegalFamilyInstance :: IllegalFamilyInstanceReason -> SDoc
pprIllegalFamilyInstance = \case
  InvalidAssoc InvalidAssoc
reason -> InvalidAssoc -> SDoc
pprInvalidAssoc InvalidAssoc
reason
  NotAFamilyTyCon TypeOrData
ty_or_data TyCon
tc ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal family instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
         , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what) ]
    where
      what :: SDoc
what = TypeOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeOrData
ty_or_data SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"family"
  NotAnOpenFamilyTyCon TyCon
tc ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal instance for closed family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
  FamilyCategoryMismatch TyCon
tc ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Wrong category of family instance; declaration was for a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
    where
      what :: SDoc
what = case TyCon -> TyConFlavour TyCon
tyConFlavour TyCon
tc of
        OpenFamilyFlavour TypeOrData
IAmData Maybe TyCon
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data family"
        TyConFlavour TyCon
_                           -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type family"
  FamilyArityMismatch TyCon
_ Arity
max_args ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Number of parameters must match family declaration; expected"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Arity
max_args SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
  TyFamNameMismatch Name
fam_tc_name Name
eqn_tc_name ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Mismatched type name in type family instance.")
       Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fam_tc_name
               , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
eqn_tc_name ])
  FamInstRHSOutOfScopeTyVars Maybe (TyCon, [Type], VarSet)
mb_dodgy (NonEmpty Name -> [Name]
forall a. NonEmpty a -> [a]
NE.toList -> [Name]
tvs) ->
    SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Out of scope type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Name] -> SDoc
forall a. [a] -> SDoc
plural [Name]
tvs
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (Name -> SDoc) -> Name -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [Name]
tvs
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the RHS of a family instance.")
       Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"All such variables must be bound on the LHS.")
    SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
mk_extra
    where
    -- mk_extra: #7536: give a decent error message for
    --         type T a = Int
    --         type instance F (T a) = a
    mk_extra :: SDoc
mk_extra = case Maybe (TyCon, [Type], VarSet)
mb_dodgy of
      Maybe (TyCon, [Type], VarSet)
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
      Just (TyCon
fam_tc, [Type]
pats, VarSet
dodgy_tvs) ->
        Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ((Unique -> Bool) -> [Unique] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Unique -> VarSet -> Bool
`elemVarSetByKey` VarSet
dodgy_tvs) ((Name -> Unique) -> [Name] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Unique
nameUnique [Name]
tvs)) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
          SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The real LHS (expanding synonyms) is:")
             Arity
2 (TyCon -> [Type] -> SDoc
pprTypeApp TyCon
fam_tc ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
expandTypeSynonyms [Type]
pats))
  FamInstLHSUnusedBoundTyVars (NonEmpty InvalidFamInstQTv -> [InvalidFamInstQTv]
forall a. NonEmpty a -> [a]
NE.toList -> [InvalidFamInstQTv]
bad_qtvs) ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
not_bound_msg, SDoc
not_used_msg, SDoc
dodgy_msg ]
    where

      -- Filter to only keep user-written variables,
      -- unless none were user-written in which case we report all of them
      -- (as we need to report an error).
      filter_user :: [InvalidFamInstQTv] -> [TyVar]
filter_user [InvalidFamInstQTv]
tvs
        = (InvalidFamInstQTv -> TyVar) -> [InvalidFamInstQTv] -> [TyVar]
forall a b. (a -> b) -> [a] -> [b]
map InvalidFamInstQTv -> TyVar
ifiqtv
        ([InvalidFamInstQTv] -> [TyVar]) -> [InvalidFamInstQTv] -> [TyVar]
forall a b. (a -> b) -> a -> b
$ case (InvalidFamInstQTv -> Bool)
-> [InvalidFamInstQTv] -> [InvalidFamInstQTv]
forall a. (a -> Bool) -> [a] -> [a]
filter InvalidFamInstQTv -> Bool
ifiqtv_user_written [InvalidFamInstQTv]
tvs of { [] -> [InvalidFamInstQTv]
tvs ; [InvalidFamInstQTv]
qvs -> [InvalidFamInstQTv]
qvs }

      ([TyVar]
not_bound, [TyVar]
not_used, [TyVar]
dodgy)
        = case (InvalidFamInstQTv
 -> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv])
 -> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv]))
-> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv])
-> [InvalidFamInstQTv]
-> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InvalidFamInstQTv
-> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv])
-> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv])
acc_tv ([], [], []) [InvalidFamInstQTv]
bad_qtvs of
            ([InvalidFamInstQTv]
nb, [InvalidFamInstQTv]
nu, [InvalidFamInstQTv]
d) -> ([InvalidFamInstQTv] -> [TyVar]
filter_user [InvalidFamInstQTv]
nb, [InvalidFamInstQTv] -> [TyVar]
filter_user [InvalidFamInstQTv]
nu, [InvalidFamInstQTv] -> [TyVar]
filter_user [InvalidFamInstQTv]
d)

      acc_tv :: InvalidFamInstQTv
-> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv])
-> ([InvalidFamInstQTv], [InvalidFamInstQTv], [InvalidFamInstQTv])
acc_tv InvalidFamInstQTv
tv ([InvalidFamInstQTv]
nb, [InvalidFamInstQTv]
nu, [InvalidFamInstQTv]
d) = case InvalidFamInstQTv -> InvalidFamInstQTvReason
ifiqtv_reason InvalidFamInstQTv
tv of
        InvalidFamInstQTvReason
InvalidFamInstQTvNotUsedInRHS   -> ([InvalidFamInstQTv]
nb, InvalidFamInstQTv
tv InvalidFamInstQTv -> [InvalidFamInstQTv] -> [InvalidFamInstQTv]
forall a. a -> [a] -> [a]
: [InvalidFamInstQTv]
nu, [InvalidFamInstQTv]
d)
        InvalidFamInstQTvReason
InvalidFamInstQTvNotBoundInPats -> (InvalidFamInstQTv
tv InvalidFamInstQTv -> [InvalidFamInstQTv] -> [InvalidFamInstQTv]
forall a. a -> [a] -> [a]
: [InvalidFamInstQTv]
nb, [InvalidFamInstQTv]
nu, [InvalidFamInstQTv]
d)
        InvalidFamInstQTvReason
InvalidFamInstQTvDodgy          -> ([InvalidFamInstQTv]
nb, [InvalidFamInstQTv]
nu, InvalidFamInstQTv
tv InvalidFamInstQTv -> [InvalidFamInstQTv] -> [InvalidFamInstQTv]
forall a. a -> [a] -> [a]
: [InvalidFamInstQTv]
d)

      -- Error message for type variables not bound in LHS patterns.
      not_bound_msg :: SDoc
not_bound_msg
        | [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
not_bound
        = SDoc
forall doc. IsOutput doc => doc
empty
        | Bool
otherwise
        = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
not_bound SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TyVar]
not_bound
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
isOrAre [TyVar]
not_bound SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by a forall,"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
doOrDoes [TyVar]
not_bound SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not appear in any of the LHS patterns of the family instance." ]

      -- Error message for type variables bound by a forall but not used
      -- in the RHS.
      not_used_msg :: SDoc
not_used_msg =
        if [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
not_used
        then SDoc
forall doc. IsOutput doc => doc
empty
        else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
not_used SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TyVar]
not_used
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
isOrAre [TyVar]
not_used SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by a forall," SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
itOrThey [TyVar]
not_used SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             [TyVar] -> SDoc
forall a. [a] -> SDoc
isOrAre [TyVar]
not_used SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"n't used in the family instance."

      -- Error message for dodgy type variables.
      -- See Note [Dodgy binding sites in type family instances] in GHC.Tc.Validity.
      dodgy_msg :: SDoc
dodgy_msg
        | [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
dodgy
        = SDoc
forall doc. IsOutput doc => doc
empty
        | Bool
otherwise
        = SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Dodgy type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
dodgy SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TyVar]
dodgy
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the LHS of a family instance:")
             Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
dodgy SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TyVar]
dodgy
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"syntactically appear" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
singular [TyVar]
dodgy SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in LHS patterns,"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
itOrThey [TyVar]
dodgy SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TyVar] -> SDoc
forall a. [a] -> SDoc
doOrDoes [TyVar]
dodgy SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"n't appear in an injective position.")


illegalFamilyInstanceHints :: IllegalFamilyInstanceReason -> [GhcHint]
illegalFamilyInstanceHints :: IllegalFamilyInstanceReason -> [GhcHint]
illegalFamilyInstanceHints = \case
  InvalidAssoc InvalidAssoc
rea -> InvalidAssoc -> [GhcHint]
invalidAssocHints InvalidAssoc
rea
  NotAFamilyTyCon {} -> [GhcHint]
noHints
  NotAnOpenFamilyTyCon {} -> [GhcHint]
noHints
  FamilyCategoryMismatch {} -> [GhcHint]
noHints
  FamilyArityMismatch {} -> [GhcHint]
noHints
  TyFamNameMismatch {} -> [GhcHint]
noHints
  FamInstRHSOutOfScopeTyVars {} -> [GhcHint]
noHints
  FamInstLHSUnusedBoundTyVars {} -> [GhcHint]
noHints

illegalFamilyInstanceReason :: IllegalFamilyInstanceReason -> DiagnosticReason
illegalFamilyInstanceReason :: IllegalFamilyInstanceReason -> DiagnosticReason
illegalFamilyInstanceReason = \case
  InvalidAssoc InvalidAssoc
rea -> InvalidAssoc -> DiagnosticReason
invalidAssocReason InvalidAssoc
rea
  NotAFamilyTyCon {} -> DiagnosticReason
ErrorWithoutFlag
  NotAnOpenFamilyTyCon {} -> DiagnosticReason
ErrorWithoutFlag
  FamilyCategoryMismatch {} -> DiagnosticReason
ErrorWithoutFlag
  FamilyArityMismatch {} -> DiagnosticReason
ErrorWithoutFlag
  TyFamNameMismatch {} -> DiagnosticReason
ErrorWithoutFlag
  FamInstRHSOutOfScopeTyVars {} -> DiagnosticReason
ErrorWithoutFlag
  FamInstLHSUnusedBoundTyVars {} -> DiagnosticReason
ErrorWithoutFlag

pprInvalidAssoc :: InvalidAssoc -> SDoc
pprInvalidAssoc :: InvalidAssoc -> SDoc
pprInvalidAssoc = \case
  InvalidAssocInstance InvalidAssocInstance
rea -> InvalidAssocInstance -> SDoc
pprInvalidAssocInstance InvalidAssocInstance
rea
  InvalidAssocDefault  InvalidAssocDefault
rea -> InvalidAssocDefault -> SDoc
pprInvalidAssocDefault  InvalidAssocDefault
rea

pprInvalidAssocInstance :: InvalidAssocInstance -> SDoc
pprInvalidAssocInstance :: InvalidAssocInstance -> SDoc
pprInvalidAssocInstance = \case
  AssocInstanceMissing Name
name ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No explicit" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"associated type"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or default declaration for"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
  AssocInstanceNotInAClass TyCon
fam_tc ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Associated type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
fam_tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be inside a class instance"
  AssocNotInThisClass Class
cls TyCon
fam_tc ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have an associated type", SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
fam_tc) ]
  AssocNoClassTyVar Class
cls TyCon
fam_tc ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The associated type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
fam_tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((TyVar -> SDoc) -> [TyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> [TyVar]
tyConTyVars TyCon
fam_tc)))
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"mentions none of the type or kind variables of the class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((TyVar -> SDoc) -> [TyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Class -> [TyVar]
classTyVars Class
cls)))]
  AssocTyVarsDontMatch ForAllTyFlag
vis TyCon
fam_tc [Type]
exp_tys [Type]
act_tys ->
    Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen (ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
vis) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type indexes must match class instance head"
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
pp [Type]
exp_tys
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
pp [Type]
act_tys ]
    where
      pp :: [Type] -> SDoc
pp [Type]
tys = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp PprPrec
topPrec (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
fam_tc) (IfaceAppArgs -> SDoc) -> IfaceAppArgs -> SDoc
forall a b. (a -> b) -> a -> b
$
               TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs TyCon
fam_tc [Type]
tys

pprInvalidAssocDefault :: InvalidAssocDefault -> SDoc
pprInvalidAssocDefault :: InvalidAssocDefault -> SDoc
pprInvalidAssocDefault = \case
  AssocDefaultNotAssoc Name
cls Name
tc ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls)
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have an associated type", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc) ]
  AssocMultipleDefaults Name
name ->
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"More than one default declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
  AssocDefaultBadArgs TyCon
fam_tc [Type]
pat_tys AssocDefaultBadArgs
bad_arg ->
    let (ForAllTyFlag
pat_vis, SDoc
main_msg) = case AssocDefaultBadArgs
bad_arg of
          AssocDefaultNonTyVarArg (Type
pat_ty, ForAllTyFlag
pat_vis) ->
            (ForAllTyFlag
pat_vis,
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal argument" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pat_ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in:")
          AssocDefaultDuplicateTyVars NonEmpty (TyVar, ForAllTyFlag)
dups ->
            let (TyVar
pat_tv, ForAllTyFlag
pat_vis) = NonEmpty (TyVar, ForAllTyFlag) -> (TyVar, ForAllTyFlag)
forall a. NonEmpty a -> a
NE.head NonEmpty (TyVar, ForAllTyFlag)
dups
            in (ForAllTyFlag
pat_vis,
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal duplicate variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
pat_tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in:")
    in Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen (ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
pat_vis) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Arity -> SDoc -> SDoc
hang SDoc
main_msg
            Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
ppr_eqn, SDoc
suggestion])
    where
      ppr_eqn :: SDoc
      ppr_eqn :: SDoc
ppr_eqn =
        SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> [Type] -> Type
mkTyConApp TyCon
fam_tc [Type]
pat_tys)
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...")

      suggestion :: SDoc
      suggestion :: SDoc
suggestion = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The arguments to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
fam_tc)
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must all be distinct type variables."

invalidAssocHints :: InvalidAssoc -> [GhcHint]
invalidAssocHints :: InvalidAssoc -> [GhcHint]
invalidAssocHints = \case
  InvalidAssocInstance InvalidAssocInstance
rea -> InvalidAssocInstance -> [GhcHint]
invalidAssocInstanceHints InvalidAssocInstance
rea
  InvalidAssocDefault  InvalidAssocDefault
rea -> InvalidAssocDefault -> [GhcHint]
invalidAssocDefaultHints  InvalidAssocDefault
rea

invalidAssocInstanceHints :: InvalidAssocInstance -> [GhcHint]
invalidAssocInstanceHints :: InvalidAssocInstance -> [GhcHint]
invalidAssocInstanceHints = \case
  AssocInstanceMissing {} -> [GhcHint]
noHints
  AssocInstanceNotInAClass {} -> [GhcHint]
noHints
  AssocNotInThisClass {} -> [GhcHint]
noHints
  AssocNoClassTyVar {} -> [GhcHint]
noHints
  AssocTyVarsDontMatch {} -> [GhcHint]
noHints

invalidAssocDefaultHints :: InvalidAssocDefault -> [GhcHint]
invalidAssocDefaultHints :: InvalidAssocDefault -> [GhcHint]
invalidAssocDefaultHints = \case
  AssocDefaultNotAssoc {} -> [GhcHint]
noHints
  AssocMultipleDefaults {} -> [GhcHint]
noHints
  AssocDefaultBadArgs TyCon
_ [Type]
_ AssocDefaultBadArgs
bad ->
    AssocDefaultBadArgs -> [GhcHint]
assocDefaultBadArgHints AssocDefaultBadArgs
bad

assocDefaultBadArgHints :: AssocDefaultBadArgs -> [GhcHint]
assocDefaultBadArgHints :: AssocDefaultBadArgs -> [GhcHint]
assocDefaultBadArgHints = \case
  AssocDefaultNonTyVarArg {} -> [GhcHint]
noHints
  AssocDefaultDuplicateTyVars {} -> [GhcHint]
noHints

invalidAssocReason :: InvalidAssoc -> DiagnosticReason
invalidAssocReason :: InvalidAssoc -> DiagnosticReason
invalidAssocReason = \case
  InvalidAssocInstance InvalidAssocInstance
rea -> InvalidAssocInstance -> DiagnosticReason
invalidAssocInstanceReason InvalidAssocInstance
rea
  InvalidAssocDefault  InvalidAssocDefault
rea -> InvalidAssocDefault -> DiagnosticReason
invalidAssocDefaultReason  InvalidAssocDefault
rea

invalidAssocInstanceReason :: InvalidAssocInstance -> DiagnosticReason
invalidAssocInstanceReason :: InvalidAssocInstance -> DiagnosticReason
invalidAssocInstanceReason = \case
  AssocInstanceMissing {} -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag
Opt_WarnMissingMethods)
  AssocInstanceNotInAClass {} -> DiagnosticReason
ErrorWithoutFlag
  AssocNotInThisClass {} -> DiagnosticReason
ErrorWithoutFlag
  AssocNoClassTyVar {} -> DiagnosticReason
ErrorWithoutFlag
  AssocTyVarsDontMatch {} -> DiagnosticReason
ErrorWithoutFlag

invalidAssocDefaultReason :: InvalidAssocDefault -> DiagnosticReason
invalidAssocDefaultReason :: InvalidAssocDefault -> DiagnosticReason
invalidAssocDefaultReason = \case
  AssocDefaultNotAssoc {} -> DiagnosticReason
ErrorWithoutFlag
  AssocMultipleDefaults {} -> DiagnosticReason
ErrorWithoutFlag
  AssocDefaultBadArgs TyCon
_ [Type]
_ AssocDefaultBadArgs
rea ->
    AssocDefaultBadArgs -> DiagnosticReason
assocDefaultBadArgReason AssocDefaultBadArgs
rea

assocDefaultBadArgReason :: AssocDefaultBadArgs -> DiagnosticReason
assocDefaultBadArgReason :: AssocDefaultBadArgs -> DiagnosticReason
assocDefaultBadArgReason = \case
  AssocDefaultNonTyVarArg {} -> DiagnosticReason
ErrorWithoutFlag
  AssocDefaultDuplicateTyVars {} -> DiagnosticReason
ErrorWithoutFlag

--------------------------------------------------------------------------------
-- Template Haskell quotes and splices

pprTHError :: THError -> DecoratedSDoc
pprTHError :: THError -> DecoratedSDoc
pprTHError = \case
  THSyntaxError THSyntaxError
err -> THSyntaxError -> DecoratedSDoc
pprTHSyntaxError THSyntaxError
err
  THNameError   THNameError
err -> THNameError -> DecoratedSDoc
pprTHNameError   THNameError
err
  THReifyError  THReifyError
err -> THReifyError -> DecoratedSDoc
pprTHReifyError  THReifyError
err
  TypedTHError  TypedTHError
err -> TypedTHError -> DecoratedSDoc
pprTypedTHError  TypedTHError
err
  THSpliceFailed SpliceFailReason
rea -> SpliceFailReason -> DecoratedSDoc
pprSpliceFailReason SpliceFailReason
rea
  AddTopDeclsError AddTopDeclsError
err -> AddTopDeclsError -> DecoratedSDoc
pprAddTopDeclsError AddTopDeclsError
err

  IllegalStaticFormInSplice HsExpr GhcPs
e ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"static forms cannot be used in splices:"
          , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
          ]

  FailedToLookupThInstName Type
th_type LookupTHInstNameErrReason
reason ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
    case LookupTHInstNameErrReason
reason of
      LookupTHInstNameErrReason
NoMatchesFound ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't find any instances of"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Type -> String
forall a. Ppr a => a -> String
TH.pprint Type
th_type)
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to add documentation to"
      LookupTHInstNameErrReason
CouldNotDetermineInstance ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't work out what instance"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Type -> String
forall a. Ppr a => a -> String
TH.pprint Type
th_type)
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is supposed to be"

  AddInvalidCorePlugin String
plugin ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"addCorePlugin: invalid plugin module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
plugin) )
         Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Plugins in the current package can't be specified.")

  AddDocToNonLocalDefn DocLoc
doc_loc ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't add documentation to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DocLoc -> SDoc
forall {doc}. IsLine doc => DocLoc -> doc
ppr_loc DocLoc
doc_loc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      String -> SDoc
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) = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
n
        ppr_loc (TH.ArgDoc Name
n Arity
_) = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
n
        ppr_loc (TH.InstDoc Type
t) = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Ppr a => a -> String
TH.pprint Type
t
        ppr_loc DocLoc
TH.ModuleDoc = String -> doc
forall doc. IsLine doc => String -> doc
text String
"the module header"

  ReportCustomQuasiError Bool
_ String
msg -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
msg

pprTHSyntaxError :: THSyntaxError -> DecoratedSDoc
pprTHSyntaxError :: THSyntaxError -> DecoratedSDoc
pprTHSyntaxError = SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc)
-> (THSyntaxError -> SDoc) -> THSyntaxError -> DecoratedSDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  IllegalTHQuotes HsExpr GhcPs
expr ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Syntax error on" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
expr
      -- The error message context will say
      -- "In the Template Haskell quotation", so no need to repeat that here.
  THSyntaxError
BadImplicitSplice ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Parse error: module header, import declaration"
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or top-level declaration expected." ]
    -- The compiler should not mention TemplateHaskell, as the common case
    -- is that this is a simple beginner error, for example:
    --
    -- module M where
    --   f :: Int -> Int; f x = x
    --   xyzzy
    --   g y = f y + 1
    --
    -- It's unlikely that 'xyzzy' above was intended to be a Template Haskell
    -- splice; instead it's probably something mistakenly left in the code.
    -- See #12146 for discussion.

  THSyntaxError
IllegalTHSplice ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected top-level splice."
  MismatchedSpliceType SpliceType
splice_type SpliceOrBracket
inner_splice_or_bracket ->
    SDoc
inner SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"may not appear in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
outer SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
      where
        (SDoc
inner, SDoc
outer) = case SpliceOrBracket
inner_splice_or_bracket of
          SpliceOrBracket
IsSplice -> case SpliceType
splice_type of
            SpliceType
Typed   -> (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Typed splices"  , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"untyped brackets")
            SpliceType
Untyped -> (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Untyped splices", String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"typed brackets")
          SpliceOrBracket
IsBracket ->
            case SpliceType
splice_type of
            SpliceType
Typed   -> (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Untyped brackets", String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"typed splices")
            SpliceType
Untyped -> (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Typed brackets"  , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"untyped splices")
  THSyntaxError
NestedTHBrackets ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Template Haskell brackets cannot be nested" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(without intervening splices)"

pprTHNameError :: THNameError -> DecoratedSDoc
pprTHNameError :: THNameError -> DecoratedSDoc
pprTHNameError = \case
  NonExactName RdrName
name ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The binder" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a NameU.")
         Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Probable cause: you used mkName instead of newName to generate a binding.")
  QuotedNameWrongStage HsQuote GhcPs
quote ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Stage error: the non-top-level quoted name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsQuote GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsQuote GhcPs
quote
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be used at the same stage at which it is bound." ]

pprTHReifyError :: THReifyError -> DecoratedSDoc
pprTHReifyError :: THReifyError -> DecoratedSDoc
pprTHReifyError = \case
  CannotReifyInstance Type
ty
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"reifyInstances:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty))
          Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a class constraint or type family application")
  CannotReifyOutOfScopeThing Name
th_name
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text (Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
th_name)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope at a reify"
             -- Ugh! Rather an indirect way to display the name
  CannotReifyThingNotInTypeEnv Name
name
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in the type environment at a reify"
  NoRolesAssociatedWithThing TcTyThing
thing
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No roles associated with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (TcTyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyThing
thing)
  CannotRepresentType UnrepresentableTypeDescr
sort Type
ty
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't represent" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
sort_doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in Template Haskell:",
               Arity -> SDoc -> SDoc
nest Arity
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)]
     where
       sort_doc :: SDoc
sort_doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$
         case UnrepresentableTypeDescr
sort of
           UnrepresentableTypeDescr
LinearInvisibleArgument -> String
"linear invisible argument"
           UnrepresentableTypeDescr
CoercionsInTypes -> String
"coercions in types"

pprTypedTHError :: TypedTHError -> DecoratedSDoc
pprTypedTHError :: TypedTHError -> DecoratedSDoc
pprTypedTHError = \case
  SplicePolymorphicLocalVar TyVar
ident
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't splice the polymorphic local variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
ident)
  TypedTHWithPolyType Type
ty
    -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal polytype:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type of a Typed Template Haskell expression must" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not have any quantification." ]

pprSpliceFailReason :: SpliceFailReason -> DecoratedSDoc
pprSpliceFailReason :: SpliceFailReason -> DecoratedSDoc
pprSpliceFailReason = \case
  SpliceThrewException SplicePhase
phase SomeException
_exn String
exn_msg LHsExpr GhcTc
expr Bool
show_code ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Exception when trying to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
phaseStr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"compile-time code:"
           , Arity -> SDoc -> SDoc
nest Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
exn_msg)
           , if Bool
show_code then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Code:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsExpr GhcTc) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr else SDoc
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"
  RunSpliceFailure RunSpliceFailReason
err -> Maybe String -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure Maybe String
forall a. Maybe a
Nothing RunSpliceFailReason
err

pprAddTopDeclsError :: AddTopDeclsError -> DecoratedSDoc
pprAddTopDeclsError :: AddTopDeclsError -> DecoratedSDoc
pprAddTopDeclsError = \case
  InvalidTopDecl HsDecl GhcPs
_decl ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Only function, value, annotation, and foreign import declarations"
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"may be added with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"addTopDecls") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot ]
  AddTopDeclsUnexpectedDeclarationSplice {} ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Declaration splices are not permitted" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"inside top-level declarations added with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"addTopDecls") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
  AddTopDeclsRunSpliceFailure RunSpliceFailReason
err ->
    Maybe String -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure (String -> Maybe String
forall a. a -> Maybe a
Just String
"addTopDecls") RunSpliceFailReason
err

pprRunSpliceFailure :: Maybe String -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure :: Maybe String -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure Maybe String
mb_calling_fn (ConversionFail ThingBeingConverted
what ConversionFailReason
reason) =
  SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> (SDoc -> SDoc) -> SDoc -> DecoratedSDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDoc
add_calling_fn (SDoc -> SDoc) -> (SDoc -> SDoc) -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDoc
addSpliceInfo (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
    ConversionFailReason -> SDoc
pprConversionFailReason ConversionFailReason
reason
  where
    add_calling_fn :: SDoc -> SDoc
add_calling_fn SDoc
rest =
      case Maybe String
mb_calling_fn of
        Just String
calling_fn ->
          SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Error in a declaration passed to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
calling_fn) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
             Arity
2 SDoc
rest
        Maybe String
Nothing -> SDoc
rest
    addSpliceInfo :: SDoc -> SDoc
addSpliceInfo = case ThingBeingConverted
what of
      ConvDec  Dec
d -> String -> Dec -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"declaration" Dec
d
      ConvExp  Exp
e -> String -> Exp -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"expression" Exp
e
      ConvPat  Pat
p -> String -> Pat -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"pattern" Pat
p
      ConvType Type
t -> String -> Type -> SDoc -> SDoc
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 SDoc -> SDoc -> SDoc
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 -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When splicing a TH" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
                   Arity
2 ((Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
                       Bool
True  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text (a -> String
forall a. Show a => a -> String
show a
item)
                       Bool
False -> String -> SDoc
forall doc. IsLine doc => String -> doc
text (a -> String
forall a. Ppr a => a -> String
TH.pprint a
item))

thErrorReason :: THError -> DiagnosticReason
thErrorReason :: THError -> DiagnosticReason
thErrorReason = \case
  THSyntaxError THSyntaxError
err -> THSyntaxError -> DiagnosticReason
thSyntaxErrorReason THSyntaxError
err
  THNameError   THNameError
err -> THNameError -> DiagnosticReason
thNameErrorReason   THNameError
err
  THReifyError  THReifyError
err -> THReifyError -> DiagnosticReason
thReifyErrorReason  THReifyError
err
  TypedTHError  TypedTHError
err -> TypedTHError -> DiagnosticReason
typedTHErrorReason  TypedTHError
err
  THSpliceFailed SpliceFailReason
rea -> SpliceFailReason -> DiagnosticReason
spliceFailedReason SpliceFailReason
rea
  AddTopDeclsError AddTopDeclsError
err -> AddTopDeclsError -> DiagnosticReason
addTopDeclsErrorReason AddTopDeclsError
err

  IllegalStaticFormInSplice {} -> DiagnosticReason
ErrorWithoutFlag
  FailedToLookupThInstName {}  -> DiagnosticReason
ErrorWithoutFlag
  AddInvalidCorePlugin {}      -> DiagnosticReason
ErrorWithoutFlag
  AddDocToNonLocalDefn {}      -> DiagnosticReason
ErrorWithoutFlag
  ReportCustomQuasiError Bool
is_error String
_ ->
    if Bool
is_error
    then DiagnosticReason
ErrorWithoutFlag
    else DiagnosticReason
WarningWithoutFlag

thSyntaxErrorReason :: THSyntaxError -> DiagnosticReason
thSyntaxErrorReason :: THSyntaxError -> DiagnosticReason
thSyntaxErrorReason = \case
  IllegalTHQuotes{}      -> DiagnosticReason
ErrorWithoutFlag
  THSyntaxError
BadImplicitSplice      -> DiagnosticReason
ErrorWithoutFlag
  IllegalTHSplice{}      -> DiagnosticReason
ErrorWithoutFlag
  NestedTHBrackets{}     -> DiagnosticReason
ErrorWithoutFlag
  MismatchedSpliceType{} -> DiagnosticReason
ErrorWithoutFlag

thNameErrorReason :: THNameError -> DiagnosticReason
thNameErrorReason :: THNameError -> DiagnosticReason
thNameErrorReason = \case
  NonExactName {}         -> DiagnosticReason
ErrorWithoutFlag
  QuotedNameWrongStage {} -> DiagnosticReason
ErrorWithoutFlag

thReifyErrorReason :: THReifyError -> DiagnosticReason
thReifyErrorReason :: THReifyError -> DiagnosticReason
thReifyErrorReason = \case
  CannotReifyInstance {}          -> DiagnosticReason
ErrorWithoutFlag
  CannotReifyOutOfScopeThing {}   -> DiagnosticReason
ErrorWithoutFlag
  CannotReifyThingNotInTypeEnv {} -> DiagnosticReason
ErrorWithoutFlag
  NoRolesAssociatedWithThing {}   -> DiagnosticReason
ErrorWithoutFlag
  CannotRepresentType {}          -> DiagnosticReason
ErrorWithoutFlag

typedTHErrorReason :: TypedTHError -> DiagnosticReason
typedTHErrorReason :: TypedTHError -> DiagnosticReason
typedTHErrorReason = \case
  SplicePolymorphicLocalVar {} -> DiagnosticReason
ErrorWithoutFlag
  TypedTHWithPolyType {}       -> DiagnosticReason
ErrorWithoutFlag

spliceFailedReason :: SpliceFailReason -> DiagnosticReason
spliceFailedReason :: SpliceFailReason -> DiagnosticReason
spliceFailedReason = \case
  SpliceThrewException {} -> DiagnosticReason
ErrorWithoutFlag
  RunSpliceFailure {}     -> DiagnosticReason
ErrorWithoutFlag

addTopDeclsErrorReason :: AddTopDeclsError -> DiagnosticReason
addTopDeclsErrorReason :: AddTopDeclsError -> DiagnosticReason
addTopDeclsErrorReason = \case
  InvalidTopDecl {}
    -> DiagnosticReason
ErrorWithoutFlag
  AddTopDeclsUnexpectedDeclarationSplice {}
    -> DiagnosticReason
ErrorWithoutFlag
  AddTopDeclsRunSpliceFailure {}
    -> DiagnosticReason
ErrorWithoutFlag

thErrorHints :: THError -> [GhcHint]
thErrorHints :: THError -> [GhcHint]
thErrorHints = \case
  THSyntaxError THSyntaxError
err -> THSyntaxError -> [GhcHint]
thSyntaxErrorHints THSyntaxError
err
  THNameError   THNameError
err -> THNameError -> [GhcHint]
thNameErrorHints   THNameError
err
  THReifyError  THReifyError
err -> THReifyError -> [GhcHint]
thReifyErrorHints  THReifyError
err
  TypedTHError  TypedTHError
err -> TypedTHError -> [GhcHint]
typedTHErrorHints  TypedTHError
err
  THSpliceFailed SpliceFailReason
rea -> SpliceFailReason -> [GhcHint]
spliceFailedHints SpliceFailReason
rea
  AddTopDeclsError AddTopDeclsError
err -> AddTopDeclsError -> [GhcHint]
addTopDeclsErrorHints AddTopDeclsError
err

  IllegalStaticFormInSplice {} -> [GhcHint]
noHints
  FailedToLookupThInstName {}  -> [GhcHint]
noHints
  AddInvalidCorePlugin {}      -> [GhcHint]
noHints
  AddDocToNonLocalDefn {}      -> [GhcHint]
noHints
  ReportCustomQuasiError {}    -> [GhcHint]
noHints

thSyntaxErrorHints :: THSyntaxError -> [GhcHint]
thSyntaxErrorHints :: THSyntaxError -> [GhcHint]
thSyntaxErrorHints = \case
  IllegalTHQuotes{}
    -> [[Extension] -> GhcHint
suggestAnyExtension [Extension
LangExt.TemplateHaskell, Extension
LangExt.TemplateHaskellQuotes]]
  BadImplicitSplice {}
    -> [GhcHint]
noHints -- NB: don't suggest TemplateHaskell
               -- see comments on BadImplicitSplice in pprTHSyntaxError
  IllegalTHSplice{}
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TemplateHaskell]
  NestedTHBrackets{}
    -> [GhcHint]
noHints
  MismatchedSpliceType{}
    -> [GhcHint]
noHints

thNameErrorHints :: THNameError -> [GhcHint]
thNameErrorHints :: THNameError -> [GhcHint]
thNameErrorHints = \case
  NonExactName {}         -> [GhcHint]
noHints
  QuotedNameWrongStage {} -> [GhcHint]
noHints

thReifyErrorHints :: THReifyError -> [GhcHint]
thReifyErrorHints :: THReifyError -> [GhcHint]
thReifyErrorHints = \case
  CannotReifyInstance {}          -> [GhcHint]
noHints
  CannotReifyOutOfScopeThing {}   -> [GhcHint]
noHints
  CannotReifyThingNotInTypeEnv {} -> [GhcHint]
noHints
  NoRolesAssociatedWithThing {}   -> [GhcHint]
noHints
  CannotRepresentType {}          -> [GhcHint]
noHints

typedTHErrorHints :: TypedTHError -> [GhcHint]
typedTHErrorHints :: TypedTHError -> [GhcHint]
typedTHErrorHints = \case
  SplicePolymorphicLocalVar {} -> [GhcHint]
noHints
  TypedTHWithPolyType {}       -> [GhcHint]
noHints

spliceFailedHints :: SpliceFailReason -> [GhcHint]
spliceFailedHints :: SpliceFailReason -> [GhcHint]
spliceFailedHints = \case
  SpliceThrewException {} -> [GhcHint]
noHints
  RunSpliceFailure {}     -> [GhcHint]
noHints

addTopDeclsErrorHints :: AddTopDeclsError -> [GhcHint]
addTopDeclsErrorHints :: AddTopDeclsError -> [GhcHint]
addTopDeclsErrorHints = \case
  InvalidTopDecl {}
    -> [GhcHint]
noHints
  AddTopDeclsUnexpectedDeclarationSplice {}
    -> [GhcHint]
noHints
  AddTopDeclsRunSpliceFailure {}
    -> [GhcHint]
noHints

--------------------------------------------------------------------------------

pprPatersonCondFailure ::
  PatersonCondFailure -> PatersonCondFailureContext -> Type -> Type -> SDoc
pprPatersonCondFailure :: PatersonCondFailure
-> PatersonCondFailureContext -> Type -> Type -> SDoc
pprPatersonCondFailure (PCF_TyVar [TyVar]
tvs) PatersonCondFailureContext
InInstanceDecl Type
lhs Type
rhs =
  SDoc -> Arity -> SDoc -> SDoc
hang ([TyVar] -> SDoc
occMsg [TyVar]
tvs)
    Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lhs)
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"than in the instance head" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs) ])
  where
    occMsg :: [TyVar] -> SDoc
occMsg [TyVar]
tvs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ((TyVar -> SDoc) -> [TyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
tvs)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_occurs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"more often"
    pp_occurs :: SDoc
pp_occurs | [TyVar] -> Bool
forall a. [a] -> Bool
isSingleton [TyVar]
tvs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"occurs"
              | Bool
otherwise       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"occur"
pprPatersonCondFailure (PCF_TyVar [TyVar]
tvs) PatersonCondFailureContext
InTyFamEquation Type
lhs Type
rhs =
  SDoc -> Arity -> SDoc -> SDoc
hang ([TyVar] -> SDoc
occMsg [TyVar]
tvs)
    Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the type-family application" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs)
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"than in the LHS of the family instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lhs) ])
  where
    occMsg :: [TyVar] -> SDoc
occMsg [TyVar]
tvs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural [TyVar]
tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ((TyVar -> SDoc) -> [TyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyVar]
tvs)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_occurs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"more often"
    pp_occurs :: SDoc
pp_occurs | [TyVar] -> Bool
forall a. [a] -> Bool
isSingleton [TyVar]
tvs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"occurs"
              | Bool
otherwise       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"occur"
pprPatersonCondFailure PatersonCondFailure
PCF_Size PatersonCondFailureContext
InInstanceDecl Type
lhs Type
rhs =
  SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lhs))
    Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is no smaller than", SDoc
pp_rhs ])
  where pp_rhs :: SDoc
pp_rhs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the instance head" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs)
pprPatersonCondFailure PatersonCondFailure
PCF_Size PatersonCondFailureContext
InTyFamEquation Type
lhs Type
rhs =
  SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type-family application" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs))
    Arity
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is no smaller than", SDoc
pp_lhs ])
  where pp_lhs :: SDoc
pp_lhs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the LHS of the family instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lhs)
pprPatersonCondFailure  (PCF_TyFam TyCon
tc) PatersonCondFailureContext
InInstanceDecl Type
lhs Type
_rhs =
  SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal use of type family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc))
    Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
lhs))
pprPatersonCondFailure  (PCF_TyFam TyCon
tc) PatersonCondFailureContext
InTyFamEquation Type
_lhs Type
rhs =
  SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal nested use of type family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc))
    Arity
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the arguments of the type-family application" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs))



--------------------------------------------------------------------------------

pprZonkerMessage :: ZonkerMessage -> SDoc
pprZonkerMessage :: ZonkerMessage -> SDoc
pprZonkerMessage = \case
  ZonkerCannotDefaultConcrete FixedRuntimeRepOrigin
frr ->
    FixedRuntimeRepContext -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context FixedRuntimeRepOrigin
frr) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot be assigned a fixed runtime representation," SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not even by defaulting."

zonkerMessageHints :: ZonkerMessage -> [GhcHint]
zonkerMessageHints :: ZonkerMessage -> [GhcHint]
zonkerMessageHints = \case
  ZonkerCannotDefaultConcrete {} -> [AvailableBindings -> GhcHint
SuggestAddTypeSignatures AvailableBindings
UnnamedBinding]

zonkerMessageReason :: ZonkerMessage -> DiagnosticReason
zonkerMessageReason :: ZonkerMessage -> DiagnosticReason
zonkerMessageReason = \case
  ZonkerCannotDefaultConcrete {} -> DiagnosticReason
ErrorWithoutFlag

--------------------------------------------------------------------------------