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

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

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

  --
  , mismatchMsg_ExpectedActuals

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

import GHC.Prelude

import qualified GHC.Internal.TH.Syntax as TH
-- In stage1: import "ghc-boot-th-next" qualified GHC.Internal.TH.Syntax as TH
-- In stage2: import "ghc-boot-th"      qualified GHC.Internal.TH.Syntax as TH
--            which resolves to
--            import "ghc-internal"     qualified GHC.Internal.TH.Syntax as TH
import qualified GHC.Internal.TH.Ppr as TH

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

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 (pprWithInvisibleBitsWhen, 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 hiding ( Position(..) )
import GHC.Tc.Types.CtLoc
import GHC.Tc.Types.Rank (Rank(..))
import GHC.Tc.Types.TH
import GHC.Tc.Utils.TcType

import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_module))
import GHC.Types.Error
import GHC.Types.Error.Codes
import GHC.Types.Hint
import GHC.Types.Hint.Ppr () -- Outputable GhcHint
import GHC.Types.Basic
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
_
      -> 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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           ( [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"export") GlobalRdrElt
gre (GlobalRdrElt -> IE (GhcPass 'Renamed)
dodgy_msg_insert GlobalRdrElt
gre)]
    TcRnMissingImportList IE GhcPs
ie
      -> [SDoc] -> DecoratedSDoc
mkDecorated [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                       [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not have an explicit import list"
                     ]
    TcRnMessage
TcRnUnsafeDueToPlugin
      -> [SDoc] -> DecoratedSDoc
mkDecorated [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Use of plugins makes the module unsafe"]
    TcRnModMissingRealSrcSpan Module
mod
      -> [SDoc] -> DecoratedSDoc
mkDecorated [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                       [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                       [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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     -> [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not valid",
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(user-defined category names must begin with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"x-"),
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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),
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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. HasLoc a => GenLocated 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"solveWanteds: too many iterations"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unsolved:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WantedConstraints -> SDoc
forall a. Outputable a => a -> SDoc
ppr WantedConstraints
wc
                        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Empty record update"
    TcRnIllegalFieldPunning Located RdrName
fld
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          BadAnonWildcardContext
WildcardBndrInForallTelescope ->
            SDoc
notAllowed
          BadAnonWildcardContext
WildcardBndrInTyFamResultVar ->
            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
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Named wildcard"
          | ExtraConstraintWildcardNotAllowed {} <- BadAnonWildcardContext
bad
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Extra-constraint wildcard"
          | WildcardBndrInForallTelescope {} <- BadAnonWildcardContext
bad
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Wildcard binder"
          | WildcardBndrInTyFamResultVar {} <- BadAnonWildcardContext
bad
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Wildcard binder"
          | Bool
otherwise
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Wildcard"
        how :: SDoc
how = case BadAnonWildcardContext
bad of
          BadAnonWildcardContext
WildcardNotLastInConstraint
            -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"not allowed in a constraint"
          BadAnonWildcardContext
WildcardBndrInForallTelescope
            -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"not allowed in a forall telescope"
          BadAnonWildcardContext
WildcardBndrInTyFamResultVar
            -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"not allowed in a type family result"
          BadAnonWildcardContext
_ -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Extra-constraint wildcards must be anonymous"
                 , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"e.g  f :: (Eq a, _) => blah") ]
          | Bool
otherwise
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"except as the last top-level constraint of a type signature"
                 , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"e.g  f :: (Eq a, _) => blah") ]
        sole_msg :: SDoc
        sole_msg :: SDoc
sole_msg =
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"except as the sole constraint"
               , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"e.g., deriving instance _ => Eq (Foo a)") ]
    TcRnIllegalNamedWildcardInTypeArgument RdrName
rdr
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal named wildcard in a required type argument:")
                Arity
2 (SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr))
    TcRnIllegalImplicitTyVarInTypeArgument RdrName
rdr
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal implicitly quantified type variable in a required type argument:")
                Arity
2 (SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr))
    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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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))
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Record wildcards may not be used for constructors with unlabelled fields.")
                , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Annotations are not compatible with Safe Haskell."
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Specify the type by giving a type signature"
                      , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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      {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"binding"
            BootBindsRn      {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"binding"
            BootInstanceSigs {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"instance body"
            BootFamInst      {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"family instance"
            BootSpliceDecls  {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"splice"
            BootForeignDecls {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"foreign declaration"
            BootDefaultDecls {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"default declaration"
            BootRuleDecls    {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"RULE pragma"
          whr :: SDoc
whr = case HsBootOrSig
boot_or_sig of
            HsBootOrSig
HsBoot -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"an hs-boot file"
            HsBootOrSig
Hsig   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 (EpAnn a) (HsBindLR (GhcPass 'Renamed) idR) -> SDoc
pprLBind LHsBinds (GhcPass 'Renamed)
[GenLocated SrcSpanAnnA (HsBind (GhcPass 'Renamed))]
binds)
          where
            pprLoc :: a -> SDoc
pprLoc a
loc = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 (EpAnn a) (HsBindLR GhcRn idR) -> SDoc
            pprLBind :: forall a idR.
CollectPass (GhcPass 'Renamed) =>
GenLocated (EpAnn a) (HsBindLR (GhcPass 'Renamed) idR) -> SDoc
pprLBind (L EpAnn 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 (EpAnn a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA EpAnn 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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), [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Pattern synonym with no type signature:")
            Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Top-level type constructor with no standalone kind signature or CUSK:"
                | Bool
otherwise
                = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 TcIdSig
sig
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Overloaded signature conflicts with monomorphism restriction")
              Arity
2 (TcIdSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSig
sig)
    TcRnTupleConstraintInst Class
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal unboxed" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type as function argument:"
               , Type -> SDoc
pprType Type
ty ]
        where
          what :: SDoc
what = case UnboxedTupleOrSum
tuple_or_sum of
            UnboxedTupleOrSum
UnboxedTupleType -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"tuple"
            UnboxedTupleOrSum
UnboxedSumType   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"sum"
    TcRnLinearFuncInKind Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Quantified type's kind mentions quantified type variable")
                Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"matches")
                Arity
2 (InstanceWhat -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstanceWhat
what)
           , SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"This makes type inference for inner bindings fragile;")
                Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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), [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"should have"
                , SDoc
n_arguments SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma, [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but has been given"
                , if Arity
nb_args Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0 then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
_         -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (TyThing -> [Char]
tyThingCategory TyThing
thing)
            n_arguments :: SDoc
n_arguments | Arity
thing_arity Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"no arguments"
                        | Arity
thing_arity Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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, [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
             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)
      where
        main_msg :: SDoc
main_msg =
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal visible, dependent quantification" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Non type-variable argument")
              Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
_) -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal qualified type:"
               ([TyVar], Type)
_       -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal polymorphic type:"
             extra :: SDoc
extra = case Rank
rank of
               Rank
MonoTypeConstraint -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                  , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Orphan family instance:")
              Arity
2 (FamInst -> SDoc
pprFamInst FamInst
fam_inst)
    TcRnFunDepConflict UnitState
unit_state NonEmpty ClsInst
sorted
      -> let herald :: SDoc
herald = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"RHS of injective type family equation is a bare" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type variable" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but these LHS type and kind patterns are not bare" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"RHS of injective type family equation cannot" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"be a type family:", Bool
False)
               InjectivityErrReason
InjErrRhsOverlap ->
                  ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type family equation right-hand sides overlap; this violates" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type/kind" else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
                                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
pprWithInvisibleBitsWhen 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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 TyCon
cls [LDefaultDecl (GhcPass 'Renamed)]
dup_things
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Multiple default declarations for class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
cls))
              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 {})
             = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
locn)
    TcRnBadDefaultType Type
ty [TyCon]
deflt_clss
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
b) ((TyCon -> SDoc) -> [TyCon] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes(SDoc -> SDoc) -> (TyCon -> SDoc) -> TyCon -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [TyCon]
deflt_clss))
    TcRnMessage
TcRnPatSynBundledWithNonDataCon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Pattern synonyms can only be bundled with matching type constructors"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Duplicate"
                , SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in export list" ]
    TcRnExportedModNotImported ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [Char] -> SDoc
formatExportItemError
           ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           [Char]
"is not imported"
    TcRnNullExportedModule ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [Char] -> SDoc
formatExportItemError
           ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           [Char]
"exports nothing"
    TcRnMissingExportList ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [Char] -> SDoc
formatExportItemError
           ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           [Char]
"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 -> [Char] -> SDoc
formatExportItemError
           (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
export_item)
           [Char]
"attempts to export constructors or class methods that are not visible here"
    TcRnExportHiddenDefault IE GhcPs
export_item
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [Char] -> SDoc
formatExportItemError
           (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
export_item)
           [Char]
"attempts to export a default class declaration that is 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)
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is exported by", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie1)
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not the parent of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> [Char]
capitalise [Char]
what_is)
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
_] -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parent:"
                       [SDoc]
_  -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char]
pp_category (AnId TyVar
i)
          | TyVar -> Bool
isRecordSelector TyVar
i = [Char]
"record selector"
        pp_category TyThing
i = TyThing -> [Char]
tyThingCategory TyThing
i
        what_is :: [Char]
what_is = TyThing -> [Char]
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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
                       , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
                       , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 {}
              | ParentIs { par_is :: Parent -> Name
par_is = Name
parent } <- GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
gre
              -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"record field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
fld SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
_ -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"This type-directed disambiguation mechanism"
                      , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"will not be supported by -XDuplicateRecordFields in future releases of GHC." ]
               , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Consider disambiguating using module qualification instead."
               ]
        where
          what :: SDoc
          what :: SDoc
what = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                     , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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   {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
which SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"datatypes"
                RecSelPatSyn {} -> [RdrName] -> SDoc
forall a. [a] -> SDoc
isOrAre [RdrName]
upd_flds SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"associated with"
                                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
which SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pattern synonyms"
              which :: SDoc
which = case [RecSelParent]
pars of
                [] -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"both"
                [RecSelParent]
_  -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                = SDoc -> SDoc
note SDoc
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is used in a static form but it is not closed"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not let-bound."]
          causes (NotTypeClosed VarSet
vs) =
            [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"has a non-closed type because it contains the"
            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                     [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Both DeriveAnyClass and"
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GeneralizedNewtypeDeriving are enabled"
                     , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Defaulting to the DeriveAnyClass strategy"
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"for instantiating" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls
                     ]
    TcRnNonUnaryTypeclassConstraint UserTypeCtxt
ctxt 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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not a unary constraint, as expected by"
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt
    TcRnPartialTypeSignatures SuggestPartialTypeSignatures
_ [Type]
theta
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"An existential or GADT data constructor cannot be used")
              Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"inside a lazy (~) pattern")
    TcRnMessage
TcRnArrowProcGADTPattern
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Proc patterns cannot use existential or GADT data constructors"
    TcRnMessage
TcRnTypeEqualityOutOfScope
      -> [SDoc] -> DecoratedSDoc
mkDecorated
           [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"~") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"operator is out of scope." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Assuming it to stand for an equality constraint."
           , SDoc -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
quotes SDoc
"~" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"used to be built-in syntax but now is a regular type operator" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                      SDoc
"exported from Data.Type.Equality and Prelude." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                      SDoc
"If you are using a custom Prelude, consider re-exporting it"
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The use of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"~")
                                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"without TypeOperators",
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Pattern matching on GADTs without MonoLocalBinds"
                 , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is fragile." ]
    TcRnIncorrectNameSpace Name
name Bool
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not live in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
other_ns
        where
          -- the other (opposite) namespace
          other_ns :: SDoc
other_ns | NameSpace -> Bool
isValNameSpace NameSpace
ns = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the type-level namespace"
                   | Bool
otherwise         = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the term-level namespace"
          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
<+>
             ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is a term-level binding") SDoc -> SDoc -> SDoc
$+$
             ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" 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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal", SDoc
what, [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Defaulting" ]
                     [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
                     (case Maybe TyVar
tidy_tv of
                         Maybe TyVar
Nothing -> []
                         Just TyVar
tv -> [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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]
++
                     [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"to type"
                     , SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
default_ty)
                     , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
    TcRnWarnClashingDefaultImports TyCon
cls Maybe [Type]
Nothing NonEmpty ClassDefaults
imports
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Clashing imported defaults for class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
cls) 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
$ ClassDefaults -> SDoc
defaultTypesAndImport (ClassDefaults -> SDoc) -> [ClassDefaults] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ClassDefaults -> [ClassDefaults]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClassDefaults
imports)
    TcRnWarnClashingDefaultImports TyCon
cls (Just [Type]
local) NonEmpty ClassDefaults
imports
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Imported defaults for class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
cls) 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
$ ClassDefaults -> SDoc
defaultTypesAndImport (ClassDefaults -> SDoc) -> [ClassDefaults] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ClassDefaults -> [ClassDefaults]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClassDefaults
imports)
               , SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"are not subsumed by the local `default` declaration")
                    Arity
2 (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (Type -> SDoc) -> [Type] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
local)
               ]

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

    TcRnForeignImportPrimSafeAnn ForeignImport (GhcPass 'Renamed)
_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"`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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal foreign declaration: requires one of these back ends:" SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
:
               SDoc -> [SDoc] -> [SDoc]
commafyWith ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"or") ((Backend -> SDoc) -> ExpectedBackends -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> (Backend -> [Char]) -> Backend -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backend -> [Char]
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 ->
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the 'stdcall' calling convention is unsupported on this platform,"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"treating as ccall"
             UnsupportedCallConvention
PrimCallConvUnsupported ->
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The `prim' calling convention can only be used with `foreign import'"
             UnsupportedCallConvention
JavaScriptCallConvUnsupported ->
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"argument"
          Just ArgOrResult
Result -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"result"
        msg :: SDoc
msg = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unacceptable", SDoc
arg_or_res
                   , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
                    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not in scope"
                TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded ->
                  SDoc
innerMsg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"foreign import prim only accepts simple unlifted types"
                TypeCannotBeMarshaledReason
NotBoxedKindAny ->
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expected kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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, [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  Actual:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty ]
            IllegalForeignTypeReason
SafeHaskellMustBeInIO ->
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Safe Haskell is on, all FFI imports must be in the IO monad"
            IllegalForeignTypeReason
IOResultExpected ->
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"IO result type expected"
            IllegalForeignTypeReason
UnexpectedNestedForall ->
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected nested forall"
            IllegalForeignTypeReason
LinearTypesNotAllowed ->
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Linear types are not supported in FFI declarations, see #18472"
            IllegalForeignTypeReason
OneArgExpected ->
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"One argument expected"
            IllegalForeignTypeReason
AtLeastOneArgExpected ->
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"used where a value identifier was expected"
    TcRnRecSelectorEscapedTyVar OccName
lbl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"used in an expression"
    TcRnIllegalDerivingItem LHsSigType (GhcPass 'Renamed)
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
    TcRnIllegalDefaultClass LHsSigType (GhcPass 'Renamed)
hs_ty
      -> 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))
hs_ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not a class"
    TcRnIllegalNamedDefault LDefaultDecl (GhcPass 'Renamed)
hs_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal use of default class name:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (DefaultDecl (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LDefaultDecl (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (DefaultDecl (GhcPass 'Renamed))
hs_decl)
    TcRnUnexpectedAnnotation HsType (GhcPass 'Renamed)
ty HsBang
bang
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           let err :: [Char]
err = case HsBang
bang of
                 HsBang SrcUnpackedness
SrcUnpack   SrcStrictness
_       -> [Char]
"UNPACK"
                 HsBang SrcUnpackedness
SrcNoUnpack SrcStrictness
_       -> [Char]
"NOUNPACK"
                 HsBang SrcUnpackedness
NoSrcUnpack SrcStrictness
SrcLazy -> [Char]
"laziness"
                 HsBang SrcUnpackedness
_           SrcStrictness
_       -> [Char]
"strictness"
            in [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"has non-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                 SDoc
allowed_kind_tycon
               , (if Bool
is_data_family then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"and non-variable" else SDoc
forall doc. IsOutput doc => doc
empty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                                    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"it comes from a data family instance"
                     PromotionErr
PatSynPE       -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"term variables cannot be promoted"
                     PromotionErr
TypeVariablePE -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type variables bound in a kind signature cannot be used in the type"
          same_rec_group_msg :: SDoc
same_rec_group_msg = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"it is defined and used in the same recursive group"
    TcRnIllegalTermLevelUse Name
name TermLevelUseErr
err
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal term-level use of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (TermLevelUseErr -> [Char]
teCategory TermLevelUseErr
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)
    TcRnMatchesHaveDiffNumArgs HsMatchContextRn
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 (LocatedN Name) -> SDoc
forall fn. Outputable fn => HsMatchContext fn -> SDoc
pprMatchContextNouns HsMatchContextRn
HsMatchContext (LocatedN Name)
argsContext SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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. HasLoc a => GenLocated 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. HasLoc a => GenLocated 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in a pattern binding signature")
    TcRnCannotBindTyVarsInPatBind NonEmpty (Name, TyVar)
_offenders
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"because its definition is not visible in this module"
    TcRnPragmaWarning
      { pragma_warning_info :: TcRnMessage -> PragmaWarningInfo
pragma_warning_info = PragmaWarningInstance{TyVar
pwarn_dfunid :: TyVar
pwarn_dfunid :: PragmaWarningInfo -> TyVar
pwarn_dfunid, CtOrigin
pwarn_ctorig :: CtOrigin
pwarn_ctorig :: PragmaWarningInfo -> CtOrigin
pwarn_ctorig}
      , WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: TcRnMessage -> WarningTxt (GhcPass 'Renamed)
pragma_warning_msg }
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In the use of")
                 Arity
2 (TyVar -> SDoc
pprDFunId TyVar
pwarn_dfunid)
            , CtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr CtOrigin
pwarn_ctorig
            , WarningTxt (GhcPass 'Renamed) -> SDoc
forall p. WarningTxt p -> SDoc
pprWarningTxtForMsg WarningTxt (GhcPass 'Renamed)
pragma_warning_msg
         ]
    TcRnPragmaWarning
      { pragma_warning_info :: TcRnMessage -> PragmaWarningInfo
pragma_warning_info = PragmaWarningDefault{TyCon
pwarn_class :: TyCon
pwarn_class :: PragmaWarningInfo -> TyCon
pwarn_class, ModuleName
pwarn_impmod :: ModuleName
pwarn_impmod :: PragmaWarningInfo -> ModuleName
pwarn_impmod}
      , WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: TcRnMessage -> WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: WarningTxt (GhcPass 'Renamed)
pragma_warning_msg }
      -> 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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In the use of class"
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
pwarn_class
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"defaults imported from"
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pwarn_impmod 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
         ]
    TcRnPragmaWarning {PragmaWarningInfo
pragma_warning_info :: TcRnMessage -> PragmaWarningInfo
pragma_warning_info :: PragmaWarningInfo
pragma_warning_info, WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: TcRnMessage -> WarningTxt (GhcPass 'Renamed)
pragma_warning_msg :: WarningTxt (GhcPass 'Renamed)
pragma_warning_msg}
      -> 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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In the use of"
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
occ_name)
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ_name)
                , SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
imp_msg 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
            occ_name :: OccName
occ_name = PragmaWarningInfo -> OccName
pwarn_occname PragmaWarningInfo
pragma_warning_info
            imp_mod :: ModuleName
imp_mod = PragmaWarningInfo -> ModuleName
pwarn_impmod PragmaWarningInfo
pragma_warning_info
            imp_msg :: SDoc
imp_msg  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"imported from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
imp_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
extra
            extra :: SDoc
extra | PragmaWarningName {pwarn_declmod :: PragmaWarningInfo -> ModuleName
pwarn_declmod = ModuleName
decl_mod} <- PragmaWarningInfo
pragma_warning_info
                  , ModuleName
imp_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
decl_mod = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
", but defined in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
decl_mod
                  | Bool
otherwise = 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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"exported with different error messages",
                                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"will not have its export warned about",
                                   [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"has conflicting fixities in the module",
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"and its hsig file",
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Main module:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fixity -> SDoc
ppr_fix Fixity
real_fixity,
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
clas),
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The MINIMAL pragma does not require:"
          , Arity -> SDoc -> SDoc
nest Arity
2 (ClassMinimalDef -> SDoc
forall (p :: Pass).
Outputable (LIdP (GhcPass p)) =>
BooleanFormula (GhcPass p) -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef)
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"lacks an accompanying binding"
    TcRnIgnoreSpecialisePragmaOnDefMethod Name
sel_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
badMethodErrClassName),
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
                    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
                ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
                ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
pprWithInvisibleBitsWhen 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 ->
                ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
                ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
                ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    TcRnOrPatBindsVariables NonEmpty (IdP (GhcPass 'Renamed))
bndrs -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"An or-pattern may not bind term or type variables such as"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
quotedListWithOr ((Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NonEmpty Name -> [Name]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (IdP (GhcPass 'Renamed))
NonEmpty Name
bndrs))
    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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"No explicit implementation for"
              ,Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ClassMinimalDef -> SDoc
forall (p :: Pass).
Outputable (LIdP (GhcPass p)) =>
BooleanFormula (GhcPass p) -> 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"RebindableSyntax is required if OverloadedRecordUpdate is enabled."
    TcRnMessage
TcRnNoFieldPunsRecordDot -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"For this to work enable NamedFieldPuns"
    TcRnIllegalStaticExpression HsExpr GhcPs
e -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Empty statement group in parallel comprehension"
      EmptyStatementGroupErrReason
EmptyStmtsGroupInTransformListComp ->
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Empty statement group preceding 'group' or 'then'"
      EmptyStmtsGroupInDoNotation HsDoFlavour
ctxt ->
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Empty" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsDoFlavour -> SDoc
pprHsDoFlavour HsDoFlavour
ctxt
      EmptyStatementGroupErrReason
EmptyStmtsGroupInArrowNotation ->
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Empty 'do' block in an arrow command"
    TcRnLastStmtNotExpr HsStmtContextRn
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 =
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The last statement in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsStmtContext (LocatedN Name) -> SDoc
forall fn. Outputable fn => HsStmtContext fn -> SDoc
pprAStmtContext HsStmtContextRn
HsStmtContext (LocatedN Name)
ctxt
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"must be an expression"
    TcRnUnexpectedStatementInContext HsStmtContextRn
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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StmtLR GhcPs GhcPs body -> SDoc
forall (p :: Pass) body. IsPass p => Stmt (GhcPass p) body -> SDoc
pprStmtCat StmtLR GhcPs GhcPs body
stmt SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"statement"
                       , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsStmtContext (LocatedN Name) -> SDoc
forall fn. Outputable fn => HsStmtContext fn -> SDoc
pprAStmtContext HsStmtContextRn
HsStmtContext (LocatedN Name)
ctxt ]
    TcRnMessage
TcRnIllegalTupleSection -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A section must be enclosed in parentheses")
         Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Missing role annotation" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
         Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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))

    TcRnIllformedTypePattern Pat (GhcPass 'Renamed)
p
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Ill-formed type pattern:") Arity
2 (Pat (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat (GhcPass 'Renamed)
p)
    TcRnMessage
TcRnIllegalTypePattern
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal type pattern." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A type pattern must be checked against a visible forall."
    TcRnIllformedTypeArgument LHsExpr (GhcPass 'Renamed)
e
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Ill-formed type argument:") Arity
2 (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e)
    TcRnIllegalTypeExpr TypeSyntax
syntax -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeSyntax -> SDoc
pprTypeSyntaxName TypeSyntax
syntax
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type syntax may only be used in a required type argument,"
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"i.e. to instantiate a visible forall." ]

    TcRnCapturedTermName RdrName
tv_name Either [GlobalRdrElt] Name
shadowed_term_names
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is implicitly quantified," SDoc -> SDoc -> SDoc
$+$
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$+$
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"This is not compatible with the RequiredTypeArguments extension."
        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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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),
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"class declaration:"
          DeclSort
InstanceDeclSort -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"instance declaration:"
        what :: SDoc
what = case HsBindLR GhcPs GhcPs
bind of
                  PatBind {}    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Pattern bindings (except simple variables)"
                  PatSynBind {} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Pattern synonyms"
                                   -- Associated pattern synonyms are not implemented yet
                  HsBindLR GhcPs GhcPs
_ -> [Char] -> SDoc -> SDoc
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Orphan COMPLETE pragmas not supported" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A COMPLETE pragma must mention at least one data constructor" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"or pattern synonym defined in the same module."
    TcRnEmptyCase HsMatchContextRn
ctxt -> SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
message
      where
        pp_ctxt :: SDoc
pp_ctxt = case HsMatchContextRn
ctxt of
          HsMatchContextRn
CaseAlt                                -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"case expression"
          LamAlt HsLamVariant
LamCase                         -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"\\case expression"
          ArrowMatchCtxt (ArrowLamAlt HsLamVariant
LamSingle) -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"kappa abstraction"
          ArrowMatchCtxt (ArrowLamAlt HsLamVariant
LamCase)   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"\\case command"
          ArrowMatchCtxt HsArrowMatchContext
ArrowCaseAlt            -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"case command"
          HsMatchContextRn
_                                      -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(unexpected)"
                                                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsMatchContext (LocatedN Name) -> SDoc
forall fn. Outputable fn => HsMatchContext fn -> SDoc
pprMatchContextNoun HsMatchContextRn
HsMatchContext (LocatedN Name)
ctxt

        message :: SDoc
message = case HsMatchContextRn
ctxt of
          LamAlt HsLamVariant
LamCases -> SDoc
lcases_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"expression"
          ArrowMatchCtxt (ArrowLamAlt HsLamVariant
LamCases) -> SDoc
lcases_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"command"
          HsMatchContextRn
_ -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Empty list of alternatives in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_ctxt

        lcases_msg :: SDoc
lcases_msg =
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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. HasLoc a => GenLocated 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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Multiple minimal complete definitions"
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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. HasLoc a => GenLocated a e -> SrcSpan
getLocA [GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs)
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    TcRnMessage
TcRnUnexpectedStandaloneDerivingDecl -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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,
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not appear on left hand side"]
    TcRnMessage
TcRnUnexpectedStandaloneKindSig -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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,
                         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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, HasLoc a) => GenLocated 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 {e}.
GenLocated SrcSpanAnnA e -> GenLocated SrcSpanAnnA 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 a a -> SDoc
pp_role_annot (L a
loc a
decl) = SDoc -> Arity -> SDoc -> SDoc
hang (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
decl)
                                        Arity
4 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-- written at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
loc))

        cmp_loc :: GenLocated SrcSpanAnnA e -> GenLocated SrcSpanAnnA e -> Ordering
cmp_loc = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated SrcSpanAnnA e -> SrcSpan)
-> GenLocated SrcSpanAnnA e
-> GenLocated SrcSpanAnnA e
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA e -> SrcSpan
forall a e. HasLoc a => GenLocated 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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, HasLoc a) => GenLocated 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 {e}.
GenLocated SrcSpanAnnA e -> GenLocated SrcSpanAnnA 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 a a -> SDoc
pp_kisig (L a
loc a
decl) =
          SDoc -> Arity -> SDoc -> SDoc
hang (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
decl) Arity
4 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-- written at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (a -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA a
loc))

        cmp_loc :: GenLocated SrcSpanAnnA e -> GenLocated SrcSpanAnnA e -> Ordering
cmp_loc = SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (GenLocated SrcSpanAnnA e -> SrcSpan)
-> GenLocated SrcSpanAnnA e
-> GenLocated SrcSpanAnnA e
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA e -> SrcSpan
forall a e. HasLoc a => GenLocated a e -> SrcSpan
getLocA
    TcRnIllegalDerivStrategy DerivStrategy GhcPs
ds -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal use of multiple, consecutive deriving clauses"
    TcRnNoDerivStratSpecified{} -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text
      [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"No context is allowed on a GADT-style data declaration",
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"naming a type family result,"
            ] SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char]
"Incorrect type variable on the LHS of "
                   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"injectivity condition"
      , Arity -> SDoc -> SDoc
nest Arity
5
      ( [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unknown type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Name] -> SDoc
forall a. [a] -> SDoc
plural [Name]
errorVars
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
         [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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,
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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]
         ] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
         [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Hint: quoting" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc -> SDoc
thBrackets (Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Name -> Bool
isValName Name
n) SDoc
"t") (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"or an enclosing expression would allow the quotation to be used in an earlier stage"
                ]
         | StageCheckSplice Name
n <- [StageCheckReason
reason]
         ]
    TcRnBadlyStagedType Name
name Arity
bind_lvl Arity
use_lvl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Badly staged type:" 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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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,
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is used in a top-level splice, quasi-quote, or annotation,"
                            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"of kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
knd
            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
pprWithInvisibleBitsWhen Bool
True (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
pprWithInvisibleBitsWhen 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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"scope"
                ]
          , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"if I tried to quantify"
                , TyVar -> SDoc
pprTyVar TyVar
tv
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in this type:"
                ]
          , Arity -> SDoc -> SDoc
nest Arity
2 (Type -> SDoc
pprTidiedType Type
orig_ty)
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(Indeed, I sometimes struggle even printing this correctly,"
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" 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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Iceland Jack!  Iceland Jack! Stop torturing me!"
           , SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Hint: use -fprint-explicit-coercions to see the coercions"
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"has"
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc -> SDoc
speakNOf Arity
decl_arity ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"argument"))
         Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal injectivity annotation"
    TcRnMessage
TcRnAbstractClosedTyFamDecl -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"You may define an abstract closed type family" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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. IsDoc doc => [doc] -> doc
vcat [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Definition of partial record field" 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)) ]
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Record selection and update using this field will be partial." ]
    TcRnHasFieldResolvedIncomplete Name
name [ConLike]
cons Arity
maxCons -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Selecting the record field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"may fail for the following constructors:")
           Arity
2
           ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([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] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
            (ConLike -> SDoc) -> [ConLike] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Arity -> [ConLike] -> [ConLike]
forall a. Arity -> [a] -> [a]
take Arity
maxCons [ConLike]
cons) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"..." | [ConLike] -> Arity -> Bool
forall a. [a] -> Arity -> Bool
lengthExceeds [ConLike]
cons Arity
maxCons ])
    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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Superclass cycle for"
                 | Bool
otherwise = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not match its corresponding"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"non-default type signature")
    TcRnTyFamsDisabled TyFamsDisabledReason
reason -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
sort SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
name
      where
        ([Char]
sort, SDoc
name) = case TyFamsDisabledReason
reason of
          TyFamsDisabledFamily Name
n -> ([Char]
"declaration", Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
          TyFamsDisabledInstance TyCon
n -> ([Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is ill-scoped")
                Arity
2 SDoc
pp_tc_kind
           , SDoc
extra
           , SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Perhaps try this order instead:")
                Arity
2 ([TyVar] -> SDoc
pprTyVars [TyVar]
sorted_tvs) ]
      where
        pp_tc_kind :: SDoc
pp_tc_kind = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
forall a. VarBndr a TyConBndrVis -> 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
forall a. VarBndr a TyConBndrVis -> 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 -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
"Specified variables" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_spec SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"always come first"
          | [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
specified_tvs
          = SDoc -> SDoc
note SDoc
inf_always_first
          | Bool
otherwise
          = SDoc -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
inf_always_first SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
              SDoc
"then specified variables" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_spec

        inf_always_first :: SDoc
inf_always_first = SDoc
"Inferred variables" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_inf SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
"always come first"

        pp_inf :: SDoc
pp_inf  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Internal error in role inference:",
            Role -> RoleValidationFailedReason -> SDoc
pprRoleValidationFailedReason Role
role RoleValidationFailedReason
reason,
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con2,
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con2,
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"A newtype must have exactly one constructor,",
           Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Annotation says", Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
annot
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but role", Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
inferred
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Wrong number of roles listed in role annotation;" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 EpAnnCO (Maybe Role)] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [XRec (GhcPass 'Renamed) (Maybe Role)]
[GenLocated EpAnnCO (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
$
      ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
       [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Roles other than" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"nominal") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"for class parameters can lead to incoherence.")
    TcRnUnexpectedKindVar RdrName
tv_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 HsTyLit GhcPs
tyLit
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal literal in type (type literals must not be negative):" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsTyLit GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyLit GhcPs
tyLit

    TcRnIllegalKind HsTypeOrSigType GhcPs
ty_thing Bool
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Precedence parsing error")
           Arity
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"cannot mix", (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op1, [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"and",
           (OpName, Fixity) -> SDoc
ppr_opfix (OpName, Fixity)
op2,
           [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"of a section",
             Arity -> SDoc -> SDoc
nest Arity
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"must have lower precedence than that of the operand,",
                          Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 Either (HsType GhcPs) Type
thing
      -- See Note [Checking for DataKinds] (Wrinkle: Migration story for
      -- DataKinds typechecker errors) in GHC.Tc.Validity for why we give
      -- different diagnostic messages below.
      -> case Either (HsType GhcPs) Type
thing of
           Left HsType GhcPs
renamer_thing ->
             SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ppr_level 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
renamer_thing)
           Right Type
typechecker_thing ->
             SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
               [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"An occurrence of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
typechecker_thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
ppr_level SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"requires DataKinds."
               , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Future versions of GHC will turn this warning into an error."
               ]
      where
        ppr_level :: SDoc
ppr_level = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ TypeOrKind -> [Char]
levelString TypeOrKind
typeOrKind

    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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
ppr_decl TySynCycleTyCons
[Either
   TyCon (GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed)))]
decl_or_tcs)) ]
      where
        ppr_decl :: Either TyCon (GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed)))
-> SDoc
ppr_decl = \case
          Right (L SrcSpanAnnA
loc TyClDecl (GhcPass 'Renamed)
decl) -> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not have an explicit import list"
    TcRnSafeImportsDisabled ModuleName
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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
   EpaLocation (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
 -> SDoc)
-> [GenLocated
      EpaLocation
      (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
      EpaLocation (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
    -> StringLiteral)
-> GenLocated
     EpaLocation (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
      EpaLocation (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
    -> WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
-> GenLocated
     EpaLocation (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
-> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  EpaLocation (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))
-> WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc) [GenLocated
   EpaLocation
   (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg)) ]
         where
          ([Char]
extra, [GenLocated
   EpaLocation
   (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg) = case WarningTxt (GhcPass 'Renamed)
txt of
            WarningTxt Maybe (LocatedE InWarningCategory)
_ SourceText
_ [GenLocated
   EpaLocation
   (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg -> ([Char]
"", [GenLocated
   EpaLocation
   (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg)
            DeprecatedTxt SourceText
_ [GenLocated
   EpaLocation
   (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg -> ([Char]
" is deprecated", [GenLocated
   EpaLocation
   (WithHsDocIdentifiers StringLiteral (GhcPass 'Renamed))]
msg)
    TcRnRedundantSourceImport ModuleName
mod_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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.
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"s or contexts"
         where
           what :: SDoc
what = case NestedForallsContextsIn
entity of
             NestedForallsContextsIn
NFC_Specialize -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"SPECIALISE instance type"
             NestedForallsContextsIn
NFC_ViaType -> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"via") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type"
             NestedForallsContextsIn
NFC_GadtConSig -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GADT constructor type signature"
             NestedForallsContextsIn
NFC_InstanceHead -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Instance head"
             NestedForallsContextsIn
NFC_StandaloneDerivedInstanceHead -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Standalone-derived instance head"
             NestedForallsContextsIn
NFC_DerivedClassType -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Derived class type"
    TcRnMessage
TcRnRedundantRecordWildcard
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Record wildcard does not bind any new variables"
    TcRnUnusedRecordWildcard [Name]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal visible" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type"
                TypeOrKind
KindLevel -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"kind"
             TypeApplicationInPattern HsConPatTyArg GhcPs
_ -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type"
           ctx :: SDoc
ctx = case TypeApplication
ty_app of
            TypeApplicationInPattern HsConPatTyArg GhcPs
_ -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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),
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-tuple is too large for GHC",
              Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Instead, use a nested tuple")
    TcRnIllegalInferredTyVars NonEmpty (HsTyVarBndr Specificity GhcPs)
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
                    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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]
: [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"    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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 =
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    TcRnDefaultedExceptionContext CtLoc
ct_loc ->
      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
proposal ]
      where
        header, warning, proposal :: SDoc
        header :: SDoc
header
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Solving for an implicit ExceptionContext constraint"
                 , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ CtOrigin -> SDoc
pprCtOrigin (CtLoc -> CtOrigin
ctLocOrigin CtLoc
ct_loc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"." ]
        warning :: SDoc
warning
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Future versions of GHC will turn this warning into an error." ]
        proposal :: SDoc
proposal
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"See GHC Proposal #330." ]
    TcRnMessage
TcRnImplicitImportOfPrelude
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Prelude") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
defOrExp SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"exported by"
                 | Bool
otherwise            = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char]
ty Maybe [GlobalRdrElt]
lookups
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<>
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is a monad that can execute GHCi statements.")
      where
        pp_ty :: SDoc
pp_ty = SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
ty)
        ambig_msg :: SDoc
ambig_msg = case Maybe [GlobalRdrElt]
lookups of
          Just (GlobalRdrElt
_:GlobalRdrElt
_:[GlobalRdrElt]
_) -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
    TcRnIllegalWildcardTyVarBndr 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal wildcard 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"There is no matching forall-bound variable"
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
             , SDoc -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [
                SDoc
"Only" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
"forall a." SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"-quantification matches invisible binders,",
                SDoc
"whereas" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
"forall {a}." SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
"forall a ->" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"do not"
             ]]

    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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Either a standalone kind signature (SAKS)"
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"or a complete user-supplied kind (CUSK, legacy feature)"
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"occurs free on the RHS of the type declaration"
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"In the future GHC will no longer implicitly quantify over such variables"
           ]

    TcRnInvalidDefaultedTyVar [Ct]
wanteds [(TyVar, Type)]
proposal NonEmpty TyVar
bad_tvs ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      Bool -> SDoc -> SDoc
pprWithInvisibleBitsWhen Bool
True (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid defaulting proposal."
           , SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The following type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TyVar] -> SDoc
forall a. [a] -> SDoc
plural (NonEmpty TyVar -> [TyVar]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TyVar
bad_tvs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"cannot be defaulted, as" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
why SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
                Arity
2 ([TyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList (NonEmpty TyVar -> [TyVar]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TyVar
bad_tvs))
           , SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Defaulting proposal:")
                Arity
2 ([(TyVar, Type)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(TyVar, Type)]
proposal)
           , SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Wanted constraints:")
                Arity
2 ([Type] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList ((Ct -> Type) -> [Ct] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Ct -> Type
ctPred [Ct]
wanteds))
           ]
        where
          why :: SDoc
why
            | TyVar
_ :| [] <- NonEmpty TyVar
bad_tvs
            = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"it is not an unfilled metavariable"
            | Bool
otherwise
            = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"they are not unfilled metavariables"

    TcRnNamespacedWarningPragmaWithoutFlag warning :: WarnDecl GhcPs
warning@(Warning (NamespaceSpecifier
kw, (EpToken "[", EpToken "]")
_) [LIdP GhcPs]
_ WarningTxt GhcPs
txt) -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal use of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (NamespaceSpecifier -> SDoc
forall a. Outputable a => a -> SDoc
ppr NamespaceSpecifier
kw) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"keyword:"
           , Arity -> SDoc -> SDoc
nest Arity
2 (WarnDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr WarnDecl GhcPs
warning)
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pragma_type SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pragma"
           ]
      where
        pragma_type :: SDoc
pragma_type = case WarningTxt GhcPs
txt of
          WarningTxt{} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"WARNING"
          DeprecatedTxt{} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"DEPRECATED"

    TcRnIllegalInvisibleTypePattern HsTyPat GhcPs
tp -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal invisible type pattern:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsTyPat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyPat GhcPs
tp

    TcRnInvisPatWithNoForAll HsTyPat (GhcPass 'Renamed)
tp -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invisible type pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsTyPat (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyPat (GhcPass 'Renamed)
tp SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"has no associated forall"

    TcRnNamespacedFixitySigWithoutFlag sig :: FixitySig GhcPs
sig@(FixitySig XFixitySig GhcPs
kw [LIdP GhcPs]
_ Fixity
_) -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal use of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (NamespaceSpecifier -> SDoc
forall a. Outputable a => a -> SDoc
ppr XFixitySig GhcPs
NamespaceSpecifier
kw) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"keyword:"
           , Arity -> SDoc -> SDoc
nest Arity
2 (FixitySig GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr FixitySig GhcPs
sig)
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in a fixity signature"
           ]

    TcRnOutOfArityTyVar Name
ts_name Name
tv_name -> [SDoc] -> DecoratedSDoc
mkDecorated
      [ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The arity of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
ts_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is insufficiently high to accommodate"
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"an implicit binding for the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tv_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type variable." ]
      , SDoc
suggestion ]
      where
        suggestion :: SDoc
suggestion =
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Use" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
at_bndr     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"on the LHS" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"or"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
forall_bndr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"on the RHS" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"to bring it into scope."
        at_bndr :: SDoc
at_bndr     = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tv_name
        forall_bndr :: SDoc
forall_bndr = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"forall" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tv_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"."

    TcRnMisplacedInvisPat HsTyPat GhcPs
tp -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invisible type pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsTyPat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyPat GhcPs
tp SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not allowed here"

    TcRnUnexpectedTypeSyntaxInTerms TypeSyntax
syntax -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unexpected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeSyntax -> SDoc
pprTypeSyntaxName TypeSyntax
syntax

  diagnosticReason :: TcRnMessage -> DiagnosticReason
  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
      -> 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
    TcRnIllegalNamedWildcardInTypeArgument{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalImplicitTyVarInTypeArgument{}
      -> 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
    TcRnExportHiddenDefault{}
      -> 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
    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
    TcRnWarnClashingDefaultImports {}
      -> 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
    TcRnIllegalDefaultClass{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalNamedDefault{}
      -> 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
    TcRnIllegalTermLevelUse{}
      -> 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
    TcRnOrPatBindsVariables{}
      -> 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
    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
    TcRnBadlyStagedType{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnBadlyStagedTypes
    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
    TcRnHasFieldResolvedIncomplete{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnIncompleteRecordSelectors
    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
    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 TypeOrKind
_ Either (HsType GhcPs) Type
thing
      -- DataKinds errors can arise from either the renamer (Left) or the
      -- typechecker (Right). The latter category of DataKinds errors are a
      -- fairly recent addition to GHC (introduced in GHC 9.10), and in order
      -- to prevent these new errors from breaking users' code, we temporarily
      -- downgrade these errors to warnings. See Note [Checking for DataKinds]
      -- (Wrinkle: Migration story for DataKinds typechecker errors)
      -- in GHC.Tc.Validity.
      -> case Either (HsType GhcPs) Type
thing of
           Left  HsType GhcPs
_ -> DiagnosticReason
ErrorWithoutFlag
           Right Type
_ -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDataKindsTC
    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)
    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
    TcRnDefaultedExceptionContext{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDefaultedExceptionContext
    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
    TcRnIllegalWildcardTyVarBndr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidInvisTyVarBndr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvisBndrWithoutSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnImplicitRhsQuantification{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnImplicitRhsQuantification
    TcRnPatersonCondFailure{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllformedTypePattern{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTypePattern{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllformedTypeArgument{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTypeExpr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidDefaultedTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNamespacedWarningPragmaWithoutFlag{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalInvisibleTypePattern{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvisPatWithNoForAll{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNamespacedFixitySigWithoutFlag{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnOutOfArityTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMisplacedInvisPat{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedTypeSyntaxInTerms{}
      -> 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 SolverReportErrCtxt
ctxt TcSolverReportMsg
msg) DiagnosticReason
_
      -> SolverReportErrCtxt -> TcSolverReportMsg -> [GhcHint]
tcSolverReportMsgHints SolverReportErrCtxt
ctxt TcSolverReportMsg
msg
    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
    TcRnIllegalNamedWildcardInTypeArgument{}
      -> [GhcHint
SuggestAnonymousWildcard]
    TcRnIllegalImplicitTyVarInTypeArgument RdrName
tv
      -> [RdrName -> GhcHint
SuggestExplicitQuantification RdrName
tv]
    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 Maybe Type
mb_ty
      | Maybe Type -> Bool
forall a. Maybe a -> Bool
isJust Maybe Type
mb_ty -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RequiredTypeArguments]
      | Bool
otherwise    -> []
    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
    TcRnExportHiddenDefault{}
      -> [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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    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
    TcRnWarnClashingDefaultImports TyCon
cls Maybe [Type]
local NonEmpty ClassDefaults
imports
      -> TyCon -> [Type] -> [[Type]] -> [GhcHint]
suggestDefaultDeclaration TyCon
cls (Maybe [Type] -> [Type]
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe [Type]
local) (ClassDefaults -> [Type]
cd_types (ClassDefaults -> [Type]) -> [ClassDefaults] -> [[Type]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ClassDefaults -> [ClassDefaults]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClassDefaults
imports)
    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
    TcRnIllegalDefaultClass{}
      -> [GhcHint]
noHints
    TcRnIllegalNamedDefault{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.NamedDefaults]
    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
    TcRnIllegalTermLevelUse{}
      -> [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
    TcRnOrPatBindsVariables{}
      -> [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 HsStmtContextRn
_ 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 HsMatchContextRn
ctxt -> case HsMatchContextRn
ctxt of
      LamAlt HsLamVariant
LamCases -> [GhcHint]
noHints -- cases syntax doesn't support empty case.
      ArrowMatchCtxt (ArrowLamAlt HsLamVariant
LamCases) -> [GhcHint]
noHints
      HsMatchContextRn
_ -> [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
    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
is_ds_enabled TcRnNoDerivStratSpecifiedInfo
info -> do
      let explicit_strategy_hint :: GhcHint
explicit_strategy_hint = case TcRnNoDerivStratSpecifiedInfo
info of
            TcRnNoDerivingClauseStrategySpecified Map AssumedDerivingStrategy [LHsSigType (GhcPass 'Renamed)]
assumed_derivings ->
              Map AssumedDerivingStrategy [LHsSigType (GhcPass 'Renamed)]
-> GhcHint
SuggestExplicitDerivingClauseStrategies Map AssumedDerivingStrategy [LHsSigType (GhcPass 'Renamed)]
assumed_derivings
            TcRnNoStandaloneDerivingStrategySpecified AssumedDerivingStrategy
assumed_strategy LHsSigWcType (GhcPass 'Renamed)
deriv_sig ->
              AssumedDerivingStrategy
-> LHsSigWcType (GhcPass 'Renamed) -> GhcHint
SuggestExplicitStandaloneDerivingStrategy AssumedDerivingStrategy
assumed_strategy LHsSigWcType (GhcPass 'Renamed)
deriv_sig
      GhcHint
explicit_strategy_hint GhcHint -> [GhcHint] -> [GhcHint]
forall a. a -> [a] -> [a]
: [Extension -> GhcHint
suggestExtension Extension
LangExt.DerivingStrategies | Bool -> Bool
not Bool
is_ds_enabled]
    TcRnStupidThetaInGadt{}
      -> [GhcHint]
noHints
    TcRnShadowedTyVarNameInFamResult{}
      -> [GhcHint]
noHints
    TcRnIncorrectTyVarOnLhsOfInjCond{}
      -> [GhcHint]
noHints
    TcRnUnknownTyVarsOnRhsOfInjCond{}
      -> [GhcHint]
noHints
    TcRnBadlyStaged{}
      -> [GhcHint]
noHints
    TcRnBadlyStagedType{}
      -> [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
    TcRnHasFieldResolvedIncomplete{}
      -> [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
suggestAnyExtension [Extension
LangExt.ExistentialQuantification, 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]
    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
    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
        BadImportAvailTyCon Bool
ex_ns  ->
          [SDoc -> Extension -> GhcHint
useExtensionInOrderTo SDoc
forall doc. IsOutput doc => doc
empty Extension
LangExt.ExplicitNamespaces | Bool -> Bool
not Bool
ex_ns]
          [GhcHint] -> [GhcHint] -> [GhcHint]
forall a. [a] -> [a] -> [a]
++ [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 OccName
_ NonEmpty Name
fs
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DuplicateRecordFields | (Name -> Bool) -> NonEmpty Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Name -> Bool
isFieldName NonEmpty Name
fs]
    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
    TcRnDefaultedExceptionContext CtLoc
_
      -> [GhcHint]
noHints
    TcRnImplicitImportOfPrelude {}
      -> [GhcHint]
noHints
    TcRnMissingMain {}
      -> [GhcHint]
noHints
    TcRnGhciUnliftedBind {}
      -> [GhcHint]
noHints
    TcRnGhciMonadLookupFail {}
      -> [GhcHint]
noHints
    TcRnMissingRoleAnnotation{}
      -> [GhcHint]
noHints
    TcRnIllegalInvisTyVarBndr{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeAbstractions]
    TcRnIllegalWildcardTyVarBndr{}
      -> [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]
    TcRnIllformedTypePattern{}
      -> [GhcHint]
noHints
    TcRnIllegalTypePattern{}
      -> [GhcHint]
noHints
    TcRnIllformedTypeArgument{}
      -> [GhcHint]
noHints
    TcRnIllegalTypeExpr{}
      -> [GhcHint]
noHints
    TcRnInvalidDefaultedTyVar{}
      -> [GhcHint]
noHints
    TcRnNamespacedWarningPragmaWithoutFlag{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ExplicitNamespaces]
    TcRnIllegalInvisibleTypePattern{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeAbstractions]
    TcRnInvisPatWithNoForAll{}
      -> [GhcHint]
noHints
    TcRnNamespacedFixitySigWithoutFlag{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ExplicitNamespaces]
    TcRnOutOfArityTyVar{}
      -> [GhcHint]
noHints
    TcRnMisplacedInvisPat{}
      -> [GhcHint]
noHints
    TcRnUnexpectedTypeSyntaxInTerms TypeSyntax
syntax
      -> [Extension -> GhcHint
suggestExtension (TypeSyntax -> Extension
typeSyntaxExtension TypeSyntax
syntax)]

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


note :: SDoc -> SDoc
note :: SDoc -> SDoc
note SDoc
note = SDoc
"Note" 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
note SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot

-- | 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]
_ = [Char] -> [SDoc]
forall a. HasCallStack => [Char] -> a
panic [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
kind SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          -> [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(in-scope) class methods or associated types" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but it has none" ]
        IAmTyCon TyConFlavour Name
_
          -> [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(in-scope) constructors or record fields" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but it has none" ]
        GREInfo
_ -> [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"children" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
             , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
-> Maybe (ExportDoc (GhcPass 'Renamed))
-> IE (GhcPass 'Renamed)
forall pass.
XIEThingAll pass
-> LIEWrappedName pass -> Maybe (ExportDoc pass) -> IE pass
IEThingAll (Maybe (GenLocated SrcSpanAnnP (WarningTxt (GhcPass 'Renamed)))
forall a. Maybe a
Nothing, (EpToken "(", EpToken "..", EpToken ")")
forall a. NoAnn a => a
noAnn) LIEWrappedName (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Renamed))
ii Maybe (ExportDoc (GhcPass 'Renamed))
forall a. Maybe a
Nothing
  where
    ii :: GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Renamed))
ii = IEWrappedName (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (IEWrappedName (GhcPass 'Renamed))
forall e a. HasAnnotation e => a -> GenLocated e 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 e a. HasAnnotation e => a -> GenLocated e 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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
tidyOpenTypeX 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 {}       -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"declaration"
  RecordFieldConstructor{} -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"construction"
  RecordFieldPattern{}     -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"pattern"
  RecordFieldPart
RecordFieldUpdate        -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 =
  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type family equation violates the family's injectivity annotation."

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

useGND :: GhcHint
useGND :: GhcHint
useGND = let info :: SDoc
info = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"for GHC's" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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
                  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"strategy"
                  | Bool
otherwise
                  = SDoc
forall doc. IsOutput doc => doc
empty

badCon :: DataCon -> SDoc -> SDoc
badCon :: DataCon -> SDoc -> SDoc
badCon DataCon
con SDoc
msg = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"...")))
                  Arity
2 SDoc
forall doc. IsOutput doc => doc
empty
           , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    ->     [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Generic instances can only be derived in"
       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Safe Haskell using the stock strategy."
  DerivErrDerivingViaWrongKind Type
cls_kind Type
via_ty Type
via_kind
    -> SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$+$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot eta-reduce to an instance of form",
            Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot derive instances in hs-boot files"
          SDoc -> SDoc -> SDoc
$+$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"are not all in scope")
            Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ( [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The last argument of the instance must be a"
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
           ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not parameterized over the last type variable")
           Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
           ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"contains the last type variable")
          Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is a type class,"
                          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"and can only have a derived instance"
                          SDoc -> SDoc -> SDoc
$+$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
                [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"must be an enumeration type"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is a GADT"
                 DerivErrBadConHasExistentials DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"must be a vanilla data constructor"
             DerivErrGenericsMustHaveSomeTypeParams TyCon
rep_tc
                ->     [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
                    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"applies a type to an argument involving the last parameter"
                 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  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
    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Not an exact match (i.e., some variables get instantiated)"
  LookupInstanceErrReason
LookupInstErrFlexiVar
    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 })
    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
       [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                   , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
                  , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(Use -fprint-explicit-coercions to see the full type.)" ]
        else [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 =
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"because the former 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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"RuntimeRep")
          | Type -> Bool
isLevityTy Type
ki
          = SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Levity")
          | Bool
otherwise
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type"
pprTcSolverReportMsg SolverReportErrCtxt
_ (BlockedEquality ErrorItem
item) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot use equality for substitution:")
           Arity
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ErrorItem -> Type
errorItemPred ErrorItem
item))
       , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Doing so would be ill-kinded." ]
pprTcSolverReportMsg SolverReportErrCtxt
_ (ExpectingMoreArguments Arity
n TypedThing
thing) =
  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"more argument to"
     | Bool
otherwise = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                   , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
               = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GHC can't yet do polykinded")
                    Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"fill in the wildcard constraint yourself"
      | Bool
otherwise
      = SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"use a standalone 'deriving instance' declaration,")
           Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"If the constraint looks soluble from a superclass of the instance context,"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
                        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"To pick the first instance above, use IncoherentInstances"
                           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                                   , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The matching instance is:",
              Arity -> SDoc -> SDoc
nest Arity
2 (ClsInst -> SDoc
pprInstance ClsInst
match)]
       , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"It is compiled in a Safe module and as such can only"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"overlap instances from the same module, however it"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"overlaps the following instances from different" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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

pprTcSolverReportMsg SolverReportErrCtxt
_ TcSolverReportMsg
MultiplicityCoercionsNotSupported = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GHC bug #19517: GHC currently does not support programs using GADTs or type families to witness equality of multiplicities"

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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot equate type variable"
          else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"with a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ TypeOrKind -> [Char]
levelString (TypeOrKind -> [Char]) -> TypeOrKind -> [Char]
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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"because" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"would escape" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                if [TyVar] -> Bool
forall a. [a] -> Bool
isSingleton [TyVar]
esc_skols then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"its scope"
                                         else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"variable is"
                else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"variables are")
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ TypeOrKind -> [Char]
levelString (TypeOrKind -> [Char]) -> TypeOrKind -> [Char]
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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is untouchable"
        , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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
$
              [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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
$
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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 :: [Char]
herald1 = [[Char]] -> [Char]
conc [ [Char]
"Couldn't match"
                   , if Bool
is_repr then [Char]
"representation of" else [Char]
""
                   , if Bool
want_ea then [Char]
"expected"          else [Char]
""
                   , [Char]
what ]
    herald2 :: [Char]
herald2 = [[Char]] -> [Char]
conc [ [Char]
"with"
                   , if Bool
is_repr then [Char]
"that of"           else [Char]
""
                   , if Bool
want_ea then ([Char]
"actual " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
what) else [Char]
"" ]

    padding :: Arity
padding = [Char] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Char]
herald1 Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
- [Char] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Char]
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 :: [Char]
what = TypeOrKind -> [Char]
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 :: [[Char]] -> [Char]
conc = ([Char] -> [Char] -> [Char]) -> [[Char]] -> [Char]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 [Char] -> [Char] -> [Char]
add_space

    add_space :: String -> String -> String
    add_space :: [Char] -> [Char] -> [Char]
add_space [Char]
s1 [Char]
s2 | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s1   = [Char]
s2
                    | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s2   = [Char]
s1
                    | Bool
otherwise = [Char]
s1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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  -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a type"
              | Bool
otherwise       = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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_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
pprWithInvisibleBitsWhen Bool
ppr_invis_bits 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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
            , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                Maybe TypedThing
Nothing    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                     Maybe TypedThing
Nothing    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is"
                     Maybe TypedThing
Nothing    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    ppr_invis_bits :: Bool
ppr_invis_bits = Type -> Type -> CtOrigin -> Bool
shouldPprWithInvisibleBits Type
ty1 Type
ty2 CtOrigin
orig

    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       = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type";
    ppr_torc TypeOrConstraint
ConstraintLike = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a lifted")
                      Levity
Unlifted -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a zero-bit")
             | [Char] -> Bool
starts_with_vowel [Char]
rr_occ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"an" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
rr_occ)
             | Bool
otherwise                -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
rr_occ)
             where
               rr_occ :: [Char]
rr_occ = OccName -> [Char]
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 :: [Char] -> Bool
starts_with_vowel (Char
c:[Char]
_) = Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"AEIOU" :: String)
    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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"No instance for"
        [Type]
_ -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Could not solve:"

    no_deduce_msg :: SDoc
no_deduce_msg =
      case [Type]
wanteds of
        [Type
_wanted] -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Could not deduce"
        [Type]
_         -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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


-- | Whether to print explicit kinds (with @-fprint-explicit-kinds@)
-- in an 'SDoc' when a type mismatch occurs to due invisible parts of the types.
-- See Note [Showing invisible bits of types in error messages]
--
-- This function first checks to see if the 'CtOrigin' argument is a
-- 'TypeEqOrigin'. If so, it first checks whether the equality is a visible
-- equality; if it's not, definitely print the kinds. Even if the equality is
-- a visible equality, check the expected/actual types to see if the types
-- have equal visible components. If the 'CtOrigin' is
-- not a 'TypeEqOrigin', fall back on the actual mismatched types themselves.
shouldPprWithInvisibleBits :: Type -> Type -> CtOrigin -> Bool
shouldPprWithInvisibleBits :: Type -> Type -> CtOrigin -> Bool
shouldPprWithInvisibleBits Type
_ty1 Type
_ty2 (TypeEqOrigin { uo_actual :: CtOrigin -> Type
uo_actual = Type
act
                                                   , uo_expected :: CtOrigin -> Type
uo_expected = Type
exp
                                                   , uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis })
  | Bool -> Bool
not Bool
vis   = Bool
True                  -- See tests T15870, T16204c
  | Bool
otherwise = Type -> Type -> Bool
mayLookIdentical Type
act Type
exp   -- See tests T9171, T9144.
shouldPprWithInvisibleBits Type
ty1 Type
ty2 CtOrigin
_ct
  = Type -> Type -> Bool
mayLookIdentical Type
ty1 Type
ty2

{- Note [Showing invisible bits of types in error messages]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It can be terribly confusing to get an error message like (#9171)

    Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
                with actual type ‘GetParam Base (GetParam Base Int)’

The reason may be that the kinds don't match up.  Typically you'll get
more useful information, but not when it's as a result of ambiguity.

To mitigate this, when we find a type or kind mis-match:

* See if normally-visible parts of the type would make the two types
  look different.  This check is made by
  `GHC.Core.TyCo.Compare.mayLookIdentical`

* If not, display the types with their normally-visible parts made visible,
  by setting flags in the `SDocContext":
  Specifically:
    - Display kind arguments: sdocPrintExplicitKinds
    - Don't default away runtime-reps: sdocPrintExplicitRuntimeReps,
           which controls `GHC.Iface.Type.hideNonStandardTypes`
  (NB: foralls are always printed by pprType, it turns out.)

As a result the above error message would instead be displayed as:

    Couldn't match expected type
                  ‘GetParam @* @k2 @* Base (GetParam @* @* @k2 Base Int)’
                with actual type
                  ‘GetParam @* @k20 @* Base (GetParam @* @* @k20 Base Int)’

Which makes it clearer that the culprit is the mismatch between `k2` and `k20`.

Another example of what goes wrong without this: #24553.
-}

{- *********************************************************************
*                                                                      *
                 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
$
       [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
        ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"...plus"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Arity -> SDoc -> SDoc
speakNOf Arity
n_in_scope_hidden ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"...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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"instance")
                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
                [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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
        = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"An overlapping instance can only be chosen when it is strictly more specific."
        | Bool
otherwise
        = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
        = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp
    , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  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
      [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type synonyms expanded:"
      , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expected type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp
      , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  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 -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
"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
<+> SDoc
"have;" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           SDoc
"we must assume that the role is nominal"
pprCoercibleMsg (TyConIsAbstract TyCon
tc) =
  SDoc -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
"The type constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"is abstract"
pprCoercibleMsg (OutOfScopeNewtypeConstructor TyCon
tc DataCon
dc) =
  SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"of newtype" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
tc)
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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  = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (TypeOrKind -> [Char]
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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
               , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type") [TyVar]
ambig_tvs

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

    pp_ambig :: SDoc -> [TyVar] -> SDoc
pp_ambig SDoc
what [TyVar]
tkvs
      | Bool
prepend_msg -- "Ambiguous type variable 't0'"
      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Ambiguous" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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"
      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"ambiguous"
pprAmbiguityInfo (NonInjectiveTyFam TyCon
tc) =
  SDoc -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is a non-injective type family"

pprSameOccInfo :: SameOccInfo -> SDoc
pprSameOccInfo :: SameOccInfo -> SDoc
pprSameOccInfo (SameOcc Bool
same_pkg Name
n1 Name
n2) =
  SDoc -> SDoc
note (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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [GhcHint]
_hints)
  = 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) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Data constructor not in scope:"
           | Bool
otherwise     = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Found hole:")
          Arity
2 (RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
hole_occ Type
hole_ty)
      HoleSort
TypeHole ->
        SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
                 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 "_"
         = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Not in scope:")
        Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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) ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
thing
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"lacks an accompanying binding" ]
    NotInScopeError
NoTopLevelBinding ->
      SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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[[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not in scope during type checking, but it passed the renamer",
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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

tcSolverReportMsgHints :: SolverReportErrCtxt -> TcSolverReportMsg -> [GhcHint]
tcSolverReportMsgHints :: SolverReportErrCtxt -> TcSolverReportMsg -> [GhcHint]
tcSolverReportMsgHints SolverReportErrCtxt
ctxt = \case
  BadTelescope {}
    -> [GhcHint]
noHints
  UserTypeError {}
    -> [GhcHint]
noHints
  UnsatisfiableError {}
    -> [GhcHint]
noHints
  ReportHoleError Hole
hole HoleError
err
    -> Hole -> HoleError -> [GhcHint]
holeErrorHints Hole
hole HoleError
err
  CannotUnifyVariable MismatchMsg
mismatch_msg CannotUnifyVariableReason
rea
    -> SolverReportErrCtxt -> MismatchMsg -> [GhcHint]
mismatchMsgHints SolverReportErrCtxt
ctxt MismatchMsg
mismatch_msg [GhcHint] -> [GhcHint] -> [GhcHint]
forall a. [a] -> [a] -> [a]
++ CannotUnifyVariableReason -> [GhcHint]
cannotUnifyVariableHints CannotUnifyVariableReason
rea
  Mismatch { mismatchMsg :: TcSolverReportMsg -> MismatchMsg
mismatchMsg = MismatchMsg
mismatch_msg }
    -> SolverReportErrCtxt -> MismatchMsg -> [GhcHint]
mismatchMsgHints SolverReportErrCtxt
ctxt MismatchMsg
mismatch_msg
  FixedRuntimeRepError {}
    -> [GhcHint]
noHints
  BlockedEquality {}
    -> [GhcHint]
noHints
  ExpectingMoreArguments {}
    -> [GhcHint]
noHints
  UnboundImplicitParams {}
    -> [GhcHint]
noHints
  AmbiguityPreventsSolvingCt {}
    -> [GhcHint]
noHints
  CannotResolveInstance {}
    -> [GhcHint]
noHints
  OverlappingInstances {}
    -> [GhcHint]
noHints
  UnsafeOverlap {}
   -> [GhcHint]
noHints
  MultiplicityCoercionsNotSupported {}
   -> [GhcHint]
noHints

mismatchMsgHints :: SolverReportErrCtxt -> MismatchMsg -> [GhcHint]
mismatchMsgHints :: SolverReportErrCtxt -> MismatchMsg -> [GhcHint]
mismatchMsgHints SolverReportErrCtxt
ctxt MismatchMsg
msg =
  Maybe GhcHint -> [GhcHint]
forall a. Maybe a -> [a]
maybeToList [ GhcHint
hint | (Type
exp,Type
act) <- MismatchMsg -> Maybe (Type, Type)
mismatchMsg_ExpectedActuals MismatchMsg
msg
                     , GhcHint
hint <- SolverReportErrCtxt -> Type -> Type -> Maybe GhcHint
suggestAddSig SolverReportErrCtxt
ctxt Type
exp Type
act ]

mismatchMsg_ExpectedActuals :: MismatchMsg -> Maybe (Type, Type)
mismatchMsg_ExpectedActuals :: MismatchMsg -> Maybe (Type, Type)
mismatchMsg_ExpectedActuals = \case
  BasicMismatch { mismatch_ty1 :: MismatchMsg -> Type
mismatch_ty1 = Type
exp, mismatch_ty2 :: MismatchMsg -> Type
mismatch_ty2 = Type
act } ->
    (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
exp, Type
act)
  KindMismatch { kmismatch_expected :: MismatchMsg -> Type
kmismatch_expected = Type
exp, kmismatch_actual :: MismatchMsg -> Type
kmismatch_actual = Type
act } ->
    (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
exp, Type
act)
  TypeEqMismatch { teq_mismatch_expected :: MismatchMsg -> Type
teq_mismatch_expected = Type
exp, teq_mismatch_actual :: MismatchMsg -> Type
teq_mismatch_actual = Type
act } ->
    (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
exp,Type
act)
  CouldNotDeduce { cnd_extra :: MismatchMsg -> Maybe CND_Extra
cnd_extra = Maybe CND_Extra
cnd_extra }
    | Just (CND_Extra TypeOrKind
_ Type
exp Type
act) <- Maybe CND_Extra
cnd_extra
    -> (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
exp, Type
act)
    | Bool
otherwise
    -> Maybe (Type, Type)
forall a. Maybe a
Nothing

holeErrorHints :: Hole -> HoleError -> [GhcHint]
holeErrorHints :: Hole -> HoleError -> [GhcHint]
holeErrorHints Hole
_hole = \case
  OutOfScopeHole [ImportError]
_ [GhcHint]
hints
    -> [GhcHint]
hints
  HoleError {}
    -> [GhcHint]
noHints

cannotUnifyVariableHints :: CannotUnifyVariableReason -> [GhcHint]
cannotUnifyVariableHints :: CannotUnifyVariableReason -> [GhcHint]
cannotUnifyVariableHints = \case
  CannotUnifyWithPolytype {}
    -> [GhcHint]
noHints
  OccursCheck {}
    -> [GhcHint]
noHints
  SkolemEscape {}
    -> [GhcHint]
noHints
  DifferentTyVars {}
    -> [GhcHint]
noHints
  RepresentationalEq {}
    -> [GhcHint]
noHints

suggestAddSig :: SolverReportErrCtxt -> TcType -> TcType -> Maybe GhcHint
-- See Note [Suggest adding a type signature]
suggestAddSig :: SolverReportErrCtxt -> Type -> Type -> Maybe GhcHint
suggestAddSig SolverReportErrCtxt
ctxt Type
ty1 Type
_ty2
  | Name
bndr : [Name]
bndrs <- [Name]
inferred_bndrs
  = GhcHint -> Maybe GhcHint
forall a. a -> Maybe a
Just (GhcHint -> Maybe GhcHint) -> GhcHint -> Maybe GhcHint
forall a b. (a -> b) -> a -> b
$ AvailableBindings -> GhcHint
SuggestAddTypeSignatures (AvailableBindings -> GhcHint) -> AvailableBindings -> GhcHint
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> AvailableBindings
NamedBindings (Name
bndr Name -> [Name] -> NonEmpty Name
forall a. a -> [a] -> NonEmpty a
:| [Name]
bndrs)
  | Bool
otherwise
  = Maybe GhcHint
forall a. Maybe a
Nothing
  where
    inferred_bndrs :: [Name]
inferred_bndrs =
      case Type -> Maybe TyVar
getTyVar_maybe Type
ty1 of
        Just TyVar
tv | TyVar -> Bool
isSkolemTyVar TyVar
tv -> [Implication] -> Bool -> TyVar -> [Name]
find (SolverReportErrCtxt -> [Implication]
cec_encl SolverReportErrCtxt
ctxt) Bool
False TyVar
tv
        Maybe TyVar
_                          -> []

    -- 'find' returns the binders of an InferSkol for 'tv',
    -- provided there is an intervening implication with
    -- ic_given_eqs /= NoGivenEqs (i.e. a GADT match)
    find :: [Implication] -> Bool -> TyVar -> [Name]
find [] Bool
_ TyVar
_ = []
    find (Implication
implic:[Implication]
implics) Bool
seen_eqs TyVar
tv
       | TyVar
tv TyVar -> [TyVar] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Implication -> [TyVar]
ic_skols Implication
implic
       , InferSkol [(Name, Type)]
prs <- Implication -> SkolemInfoAnon
ic_info Implication
implic
       , Bool
seen_eqs
       = ((Name, Type) -> Name) -> [(Name, Type)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Type) -> Name
forall a b. (a, b) -> a
fst [(Name, Type)]
prs
       | Bool
otherwise
       = [Implication] -> Bool -> TyVar -> [Name]
find [Implication]
implics (Bool
seen_eqs Bool -> Bool -> Bool
|| Implication -> HasGivenEqs
ic_given_eqs Implication
implic HasGivenEqs -> HasGivenEqs -> Bool
forall a. Eq a => a -> a -> Bool
/= HasGivenEqs
NoGivenEqs) TyVar
tv

{- Note [Suggest adding a type signature]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The OutsideIn algorithm rejects GADT programs that don't have a principal
type, and indeed some that do.  Example:
   data T a where
     MkT :: Int -> T Int

   f (MkT n) = n

Does this have type f :: T a -> a, or f :: T a -> Int?
The error that shows up tends to be an attempt to unify an
untouchable type variable.  So suggestAddSig sees if the offending
type variable is bound by an *inferred* signature, and suggests
adding a declared signature instead.

More specifically, we suggest adding a type sig if we have p ~ ty, and
p is a skolem bound by an InferSkol.  Those skolems were created from
unification variables in simplifyInfer.  Why didn't we unify?  It must
have been because of an intervening GADT or existential, making it
untouchable. Either way, a type signature would help.  For GADTs, it
might make it typeable; for existentials the attempt to write a
signature will fail -- or at least will produce a better error message
next time

This initially came up in #8968, concerning pattern synonyms.
-}

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

instance Outputable ImportError where
  ppr :: ImportError -> SDoc
ppr ImportError
err = SDoc -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ case ImportError
err of
      MissingModule ModuleName
mod_name -> SDoc
"No module named" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
quoted ModuleName
mod_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"is imported"
      ModulesDoNotExport NonEmpty Module
mods OccName
occ_name
        | Module
mod NE.:| [] <- NonEmpty Module
mods -> SDoc
"The module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
quoted Module
mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"does not export" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
quoted OccName
occ_name
        | Bool
otherwise -> SDoc
"Neither" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [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) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"export" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
quoted OccName
occ_name
    where
      quoted :: Outputable a => a -> SDoc
      quoted :: forall a. Outputable a => a -> SDoc
quoted = SDoc -> SDoc
quotes (SDoc -> SDoc) -> (a -> SDoc) -> a -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
forall a. Outputable a => a -> SDoc
ppr

{- *********************************************************************
*                                                                      *
             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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
             = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"\"required\""
             | Bool
otherwise
             = SDoc
forall doc. IsOutput doc => doc
empty
  = [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"to the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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) HsMatchContextRn
_) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)   HsMatchContextRn
_) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                       , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char]
levelString TypeOrKind
TypeLevel = [Char]
"type"
levelString TypeOrKind
KindLevel = [Char]
"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 []
  = [Char] -> SDoc
forall a. HasCallStack => [Char] -> a
panic [Char]
"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 XXExprGhcRn].

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 { ft_mult :: Type -> Type
ft_mult = Type
w, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res })
      = -- Look under  c => t and t1 -> t2
        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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"This should not happen, please report it as a bug following the instructions at:"
       SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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] -> [Char] -> [Char] -> SDoc
forall {doc} {a}. IsLine doc => [a] -> [Char] -> [Char] -> doc
is_or_are [TyVar]
tvs [Char]
"a" [Char]
"(rigid, skolem)")
             , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"of unknown origin")
             , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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] -> [Char] -> [Char] -> SDoc
forall {doc} {a}. IsLine doc => [a] -> [Char] -> [Char] -> doc
is_or_are [TyVar]
tvs [Char]
"an" [Char]
"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] -> [Char] -> [Char] -> SDoc
forall {doc} {a}. IsLine doc => [a] -> [Char] -> [Char] -> doc
is_or_are [TyVar]
tvs [Char]
"a"  [Char]
"rigid" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"bound by")
             , Arity -> SDoc -> SDoc
nest Arity
2 (SkolemInfoAnon -> SDoc
pprSkolInfo SkolemInfoAnon
skol_info)
             , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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] -> [Char] -> [Char] -> doc
is_or_are [a
_] [Char]
article [Char]
adjective = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
article doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
adjective
                                      doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type variable"
    is_or_are [a]
_   [Char]
_       [Char]
adjective = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"are" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
adjective
                                      doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 HasCallStack => Type -> Type -> Bool
Type -> Type -> Bool
`eqType` Type
liftedTypeKind Bool -> Bool -> Bool
&& Type
t2 HasCallStack => Type -> Type -> Bool
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 ([Char]
-> (Type -> Type -> (Type, Type))
-> [Type]
-> [Type]
-> [(Type, Type)]
forall a b c.
HasDebugCallStack =>
[Char] -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual [Char]
"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 HasCallStack => Type -> Type -> Bool
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
$
          [Char] -> [Type] -> [Type] -> [(Type, Type)]
forall a b. HasDebugCallStack => [Char] -> [a] -> [b] -> [(a, b)]
zipEqual [Char]
"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 [] = [Char] -> SDoc -> (Type, Type)
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
pprHsDocContext (StandaloneKindSigCtx SDoc
doc) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the standalone kind signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
pprHsDocContext HsDocContext
PatCtx                = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a pattern type-signature"
pprHsDocContext HsDocContext
SpecInstSigCtx        = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a SPECIALISE instance pragma"
pprHsDocContext HsDocContext
DefaultDeclCtx        = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a `default' declaration"
pprHsDocContext HsDocContext
DerivDeclCtx          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a deriving declaration"
pprHsDocContext (RuleCtx FastString
name)        = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)     = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)     = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)       = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)    = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)   = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"an expression type signature"
pprHsDocContext HsDocContext
TypBrCtx              = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a Template-Haskell quoted type"
pprHsDocContext HsDocContext
HsTypeCtx             = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a type argument"
pprHsDocContext HsDocContext
HsTypePatCtx          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"a type argument in a pattern"
pprHsDocContext HsDocContext
GHCiCtx               = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GHCi input"
pprHsDocContext (SpliceTypeCtx LHsType GhcPs
hs_ty) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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      = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GHC.Tc.Gen.Splice.reifyInstances"

pprHsDocContext (ForeignDeclCtx LocatedN RdrName
name)
   = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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])
   = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
   = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char]
occ ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"name:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
occ)
  SumAltArityExceeded Arity
alt Arity
arity ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Sum alternatives must start from 1" ]
  IllegalSumArity Arity
arity ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Sums must have an arity of at least 2" ]
  MalformedType TypeOrKind
typeOrKind Type
ty ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Malformed " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
ty_str SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Type -> [Char]
forall a. Show a => a -> [Char]
show Type
ty)
    where ty_str :: [Char]
ty_str = case TypeOrKind
typeOrKind of
                     TypeOrKind
TypeLevel -> [Char]
"type"
                     TypeOrKind
KindLevel -> [Char]
"kind"
  IllegalLastStatement HsDoFlavour
do_or_lc LStmt GhcPs (LHsExpr GhcPs)
stmt ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(It should be an expression.)" ]
  ConversionFailReason
KindSigsOnlyAllowedOnGADTs ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Kind signatures are only allowed on GADTs"
  IllegalDeclaration THDeclDescriptor
declDescr IllegalDecls
bad_decls ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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) ->
            ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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) ->
            ( [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ case THDeclDescriptor
declDescr of
                   THDeclDescriptor
InstanceDecl -> [Char]
"an instance declaration"
                   THDeclDescriptor
WhereClause -> [Char]
"a where clause"
                   THDeclDescriptor
LetBinding -> [Char]
"a let expression"
                   THDeclDescriptor
LetExpression -> [Char]
"a let expression"
                   THDeclDescriptor
ClssDecl -> [Char]
"a class declaration"
  ConversionFailReason
CannotMixGADTConsWith98Cons ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot mix GADT constructors with Haskell 98"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"constructors"
  ConversionFailReason
EmptyStmtListInDoBlock ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Empty stmt list in do-block"
  ConversionFailReason
NonVarInInfixExpr ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Non-variable expression is not allowed in an infix expression"
  ConversionFailReason
MultiWayIfWithoutAlts ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Multi-way if-expression with no alternatives"
  ConversionFailReason
CasesExprWithoutAlts ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"\\cases expression with no alternatives"
  ConversionFailReason
ImplicitParamsWithOtherBinds ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Implicit parameters mixed with other bindings"
  InvalidCCallImpent [Char]
from ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
from) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not a valid ccall impent"
  ConversionFailReason
RecGadtNoCons ->
    SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"RecGadtC") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"must have at least one constructor name"
  ConversionFailReason
GadtNoCons ->
    SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GadtC") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"must have at least one constructor name"
  InvalidTypeInstanceHeader Type
tys ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid type instance header:"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Type -> [Char]
forall a. Show a => a -> [Char]
show Type
tys)
  InvalidTyFamInstLHS Type
lhs ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Invalid type family instance LHS:"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Type -> [Char]
forall a. Show a => a -> [Char]
show Type
lhs)
  ConversionFailReason
InvalidImplicitParamBinding ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Implicit parameter binding only allowed in let or where"
  DefaultDataInstDecl [LDataFamInstDecl GhcPs]
adts ->
    ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Default data instance declarations"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Function binding for"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Name -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Name
nm))
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 =
  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc)
-> (WrongThingSort -> [Char]) -> WrongThingSort -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    WrongThingSort
WrongThingType -> [Char]
"type"
    WrongThingSort
WrongThingDataCon -> [Char]
"data constructor"
    WrongThingSort
WrongThingPatSyn -> [Char]
"pattern synonym"
    WrongThingSort
WrongThingConLike -> [Char]
"constructor-like thing"
    WrongThingSort
WrongThingClass -> [Char]
"class"
    WrongThingSort
WrongThingTyCon -> [Char]
"type constructor"
    WrongThingSort
WrongThingAxiom -> [Char]
"axiom"

pprStageCheckReason :: StageCheckReason -> SDoc
pprStageCheckReason :: StageCheckReason -> SDoc
pprStageCheckReason = \case
  StageCheckInstance InstanceWhat
_ Type
t ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the class context:", [Type] -> SDoc
pprTheta [Type]
theta ]
  UninfTyCtx_DataContext [Type]
theta ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the datatype context:", [Type] -> SDoc
pprTheta [Type]
theta ]
  UninfTyCtx_ProvidedContext [Type]
theta ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the provided context:" , [Type] -> SDoc
pprTheta [Type]
theta ]
  UninfTyCtx_TyFamRhs Type
rhs_ty ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not bound by the LHS of the pattern synonym"

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

pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc
pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc
pprSuperclassCycleDetail = \case
  SCD_HeadTyVar Type
pred ->
    SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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' ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"missing in environment"
  BadCoercionRole Coercion
co ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
howMany SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 :: [Char]
howMany | Arity
n Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0 = [Char]
"No"
              | Bool
otherwise = [Char]
"Too many"
  DisabledClassExtension
FunDepsDisabled ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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  -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(hi-boot interface)"
            IsBootInterface
NotBoot -> SDoc
forall doc. IsOutput doc => doc
empty
      withContext :: [SDoc] -> SDoc
withContext [SDoc]
msgs =
        SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is exported, but it does not export any children"
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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
          [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"an item called" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
datacon
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal qualified name in import item:")
       Arity
2 (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
  ImportLookupReason
ImportLookupIllegal ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal import item"
  ImportLookupAmbiguous RdrName
rdr [GlobalRdrElt]
gres ->
    SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is redundant"
         , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"except perhaps to import instances from"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_mod)
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"To import instances alone, use:"
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_qual SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"import of"
    pp_qual :: SDoc
pp_qual
      | ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (ImportDecl (GhcPass 'Renamed) -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl (GhcPass 'Renamed)
decl) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"but not used"
      UnusedNameProv
UnusedNameTypePattern ->
        SDoc
defined SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"on the right hand side"
      UnusedNameProv
UnusedNameMatch ->
        SDoc
defined
      UnusedNameProv
UnusedNameLocalBind ->
        SDoc
defined
    defined :: SDoc
defined = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
                      , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
              -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
        = [Char] -> SDoc -> SDoc
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"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 ->
      [Char] -> [Char] -> SDoc
msg1 [Char]
"(<>)" [Char]
"mappend"
    NonCanonical_Monoid
NonCanonical_Mappend ->
      [Char] -> [Char] -> SDoc
msg2 [Char]
"mappend" [Char]
"(<>)"
  NonCanonicalMonad NonCanonical_Monad
sub -> case NonCanonical_Monad
sub of
    NonCanonical_Monad
NonCanonical_Pure ->
      [Char] -> [Char] -> SDoc
msg1 [Char]
"pure" [Char]
"return"
    NonCanonical_Monad
NonCanonical_ThenA ->
      [Char] -> [Char] -> SDoc
msg1 [Char]
"(*>)" [Char]
"(>>)"
    NonCanonical_Monad
NonCanonical_Return ->
      [Char] -> [Char] -> SDoc
msg2 [Char]
"return" [Char]
"pure"
    NonCanonical_Monad
NonCanonical_ThenM ->
      [Char] -> [Char] -> SDoc
msg2 [Char]
"(>>)" [Char]
"(*>)"
  where
    msg1 :: String -> String -> SDoc
    msg1 :: [Char] -> [Char] -> SDoc
msg1 [Char]
lhs [Char]
rhs =
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Noncanonical" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char]
lhs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rhs)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"definition detected"
          , SDoc
inst
          ]

    msg2 :: String -> String -> SDoc
    msg2 :: [Char] -> [Char] -> SDoc
msg2 [Char]
lhs [Char]
rhs =
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Noncanonical" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
lhs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"definition detected"
          , SDoc
inst
          , SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
lhs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"will eventually be removed in favour of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
            SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in the instance declaration for")
                         Arity
2 (SDoc -> SDoc
quotes SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
".")

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

    move :: Name -> Name -> [Char] -> GhcHint
move = Name -> Name -> [Char] -> GhcHint
SuggestMoveNonCanonicalDefinition
    remove :: Name -> Name -> [Char] -> GhcHint
remove = Name -> Name -> [Char] -> GhcHint
SuggestRemoveNonCanonicalDefinition

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

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

suggestDefaultDeclaration :: TyCon -> [Type] -> [[Type]] -> [GhcHint]
suggestDefaultDeclaration :: TyCon -> [Type] -> [[Type]] -> [GhcHint]
suggestDefaultDeclaration TyCon
cls [Type]
prefix [[Type]]
seqs =
  [TyCon -> [Type] -> GhcHint
SuggestDefaultDeclaration TyCon
cls ([Type] -> GhcHint) -> [Type] -> GhcHint
forall a b. (a -> b) -> a -> b
$ [[Type]] -> [Type]
supersequence ([Type]
prefix [Type] -> [[Type]] -> [[Type]]
forall a. a -> [a] -> [a]
: [[Type]]
seqs)]
  where
    -- Not exactly the shortest possible supersequence, but it preserves
    -- the head sequence as the prefix of the result which is a requirement.
    supersequence :: [[Type]] -> [Type]
    supersequence :: [[Type]] -> [Type]
supersequence [] = []
    supersequence ([] : [[Type]]
seqs) = [[Type]] -> [Type]
supersequence [[Type]]
seqs
    supersequence ((Type
x : [Type]
xs) : [[Type]]
seqs) =
      Type
x Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [[Type]] -> [Type]
supersequence ([Type]
xs [Type] -> [[Type]] -> [[Type]]
forall a. a -> [a] -> [a]
: (Type -> [Type] -> [Type]
dropHead Type
x ([Type] -> [Type]) -> [[Type]] -> [[Type]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Type]]
seqs))
    dropHead :: Type -> [Type] -> [Type]
dropHead Type
x ys :: [Type]
ys@(Type
y : [Type]
ys')
      | HasDebugCallStack => Type -> Type -> Bool
Type -> Type -> Bool
tcEqType Type
x Type
y = [Type]
ys'
      | Bool
otherwise = [Type]
ys
    dropHead Type
_ [] = []

--------------------------------------------------------------------------------
-- 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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"defined in"
          MissingBootThing
MissingBootExport     -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the implementing module."
  MissingBootInstance TyVar
boot_dfun ->
    SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
        [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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)
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"has conflicting definitions in the module"
      , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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,
                    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Main module:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
real_doc
      , (case HsBootOrSig
boot_or_sig of
          HsBootOrSig
HsBoot -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  Boot file:"
          HsBootOrSig
Hsig   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  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 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"hs-boot file"
      HsBootOrSig
Hsig   -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"hsig file"


pprBootMismatchWhat :: HsBootOrSig -> BootMismatchWhat -> SDoc
pprBootMismatchWhat :: HsBootOrSig -> BootMismatchWhat -> SDoc
pprBootMismatchWhat HsBootOrSig
boot_or_sig = \case
  BootMismatchedIdTypes {} ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The types have different kinds."
  TyConRoleMismatch Bool
sub_type ->
    if Bool
sub_type
    then
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The roles are not compatible:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  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
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 SDoc -> SDoc
note (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
"Roles on abstract types default to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
"representational" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type family equations do not match:")
      BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc
pprTyConAxiomMismatch BootListMismatches CoAxBranch BootAxiomBranchMismatch
ax_errs
  TyConInjectivityMismatch {} ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The number of equations differs."
  MismatchedThing Arity
i CoAxBranch
br1 CoAxBranch
br2 BootAxiomBranchMismatch
err ->
    SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 =
  [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"don't match."
  where
    what :: SDoc
what = case BootAxiomBranchMismatch
err of
      BootAxiomBranchMismatch
MismatchedAxiomBinders -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"variables bound in the equation"
      BootAxiomBranchMismatch
MismatchedAxiomLHS     -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"equation left-hand sides"
      BootAxiomBranchMismatch
MismatchedAxiomRHS     -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The associated types do not match:")
      (HsBootOrSig -> BootListMismatch ClassATItem BootATMismatch -> SDoc
pprATMismatch HsBootOrSig
boot_or_sig) BootListMismatches ClassATItem BootATMismatch
at_errs
  BootClassMismatch
MismatchedFunDeps ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The functional dependencies do not match."
  BootClassMismatch
MismatchedSuperclasses ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The superclass constraints do not match."
  BootClassMismatch
MismatchedMinimalPragmas ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"associated type default differ."

pprBootClassMethodListMismatch :: BootListMismatch ClassOpItem BootMethodMismatch -> SDoc
pprBootClassMethodListMismatch :: BootListMismatch ClassOpItem BootMethodMismatch -> SDoc
pprBootClassMethodListMismatch = \case
  BootListMismatch ClassOpItem BootMethodMismatch
MismatchedLength ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"differ."
  MismatchedMethodTypes {} ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"are different."
  MismatchedDefaultMethods Bool
subtype_check ->
    if Bool
subtype_check
    then
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"are not compatible."
    else
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot match a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"data") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"definition with a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"newtype") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The constructors do not match:")
      BootListMismatch DataCon BootDataConMismatch -> SDoc
pprBootDataConMismatch BootListMismatches DataCon BootDataConMismatch
dc_errs
  MismatchedDatatypeContexts {} ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The datatype contexts do not match."

pprBootDataConMismatch :: BootListMismatch DataCon BootDataConMismatch
                       -> SDoc
pprBootDataConMismatch :: BootListMismatch DataCon BootDataConMismatch -> SDoc
pprBootDataConMismatch = \case
  BootListMismatch DataCon BootDataConMismatch
MismatchedLength ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The names" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pname2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"differ."
  BootDataConMismatch
MismatchedDataConFixities ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"differ."
  BootDataConMismatch
MismatchedDataConBangs ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"differ."
  BootDataConMismatch
MismatchedDataConFieldLabels ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"differ."
  BootDataConMismatch
MismatchedDataConTypes ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
pprWithInvisibleBitsWhen Bool
invis_arg (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" 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
$
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"All instance types must be of the form (T t1 ... tn)" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"All instance types must be of the form (T a1 ... an)",
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"where a1 ... an are *distinct type variables*,",
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Only one type can be given in an instance head."
  InstHeadAbstractClass Class
clas ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Instance heads must be of the form"
         , Arity -> SDoc -> SDoc
nest Arity
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"C ty_1 ... ty_n"
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is a class."
         ]
    where
      what_illegal :: SDoc
what_illegal = case Maybe TyCon
bad_head of
        Just TyCon
tc ->
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
          [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Record data type must be specified."
  IllegalHasFieldInstance
IllegalHasFieldInstanceFamilyTyCon
    -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
pprWithInvisibleBitsWhen (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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
liberal ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"liberal")
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not"
                  else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"do not jointly")
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ]
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"family"
  NotAnOpenFamilyTyCon TyCon
tc ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
_ -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"data family"
        TyConFlavour TyCon
_                           -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"type family"
  FamilyArityMismatch TyCon
_ Arity
max_args ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Mismatched type name in type family instance.")
       Arity
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fam_tc_name
               , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in the RHS of a family instance.")
       Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"bound by a forall,"
              , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"bound by a forall," SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in the LHS of a family instance:")
             Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in LHS patterns,"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"No explicit" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"associated type"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"must be inside a class instance"
  AssocNotInThisClass Class
cls TyCon
fam_tc ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Class", SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)))
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
pprWithInvisibleBitsWhen (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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Type indexes must match class instance head"
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
pp [Type]
exp_tys
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"  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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls)
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not have an associated type", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc) ]
  AssocMultipleDefaults Name
name ->
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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,
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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,
                [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"in:")
    in Bool -> SDoc -> SDoc
pprWithInvisibleBitsWhen (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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"...")

      suggestion :: SDoc
      suggestion :: SDoc
suggestion = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Couldn't find any instances of"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Type -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Type
th_type)
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"to add documentation to"
      LookupTHInstNameErrReason
CouldNotDetermineInstance ->
        [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Couldn't work out what instance"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Type -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Type
th_type)
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is supposed to be"

  AddInvalidCorePlugin [Char]
plugin ->
    SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"addCorePlugin: invalid plugin module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
plugin) )
         Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Can't add documentation to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DocLoc -> SDoc
forall {b}. IsLine b => DocLoc -> b
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
<+>
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"as it isn't inside the current module."
      where
        ppr_loc :: DocLoc -> b
ppr_loc (TH.DeclDoc Name
n) = [Char] -> b
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ Name -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Name
n
        ppr_loc (TH.ArgDoc Name
n Arity
_) = [Char] -> b
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ Name -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Name
n
        ppr_loc (TH.InstDoc Type
t) = [Char] -> b
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ Type -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Type
t
        ppr_loc DocLoc
TH.ModuleDoc = [Char] -> b
forall doc. IsLine doc => [Char] -> doc
text [Char]
"the module header"

  ReportCustomQuasiError Bool
_ [Char]
msg -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Parse error: module header, import declaration"
        , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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   -> ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Typed splices"  , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"untyped brackets")
            SpliceType
Untyped -> ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Untyped splices", [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"typed brackets")
          SpliceOrBracket
IsBracket ->
            case SpliceType
splice_type of
            SpliceType
Typed   -> ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Untyped brackets", [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"typed splices")
            SpliceType
Untyped -> ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Typed brackets"  , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"untyped splices")
  THSyntaxError
NestedTHBrackets ->
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Template Haskell brackets cannot be nested" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"(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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not a NameU.")
         Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Name -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Name
th_name)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
               [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
       [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+>
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$
         case UnrepresentableTypeDescr
sort of
           UnrepresentableTypeDescr
LinearInvisibleArgument -> [Char]
"linear invisible argument"
           UnrepresentableTypeDescr
CoercionsInTypes -> [Char]
"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
$
         [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Illegal polytype:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty
           , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The type of a Typed Template Haskell expression must" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"not have any quantification." ]

pprSpliceFailReason :: SpliceFailReason -> DecoratedSDoc
pprSpliceFailReason :: SpliceFailReason -> DecoratedSDoc
pprSpliceFailReason = \case
  SpliceThrewException SplicePhase
phase SomeException
_exn [Char]
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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Exception when trying to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
phaseStr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"compile-time code:"
           , Arity -> SDoc -> SDoc
nest Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
exn_msg)
           , if Bool
show_code then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 :: [Char]
phaseStr =
            case SplicePhase
phase of
              SplicePhase
SplicePhase_Run -> [Char]
"run"
              SplicePhase
SplicePhase_CompileAndLink -> [Char]
"compile and link"
  RunSpliceFailure RunSpliceFailReason
err -> Maybe [Char] -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure Maybe [Char]
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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Only function, value, annotation, and foreign import declarations"
          , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"may be added with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
$
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Declaration splices are not permitted" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"inside top-level declarations added with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
      SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"addTopDecls") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
  AddTopDeclsRunSpliceFailure RunSpliceFailReason
err ->
    Maybe [Char] -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"addTopDecls") RunSpliceFailReason
err

pprRunSpliceFailure :: Maybe String -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure :: Maybe [Char] -> RunSpliceFailReason -> DecoratedSDoc
pprRunSpliceFailure Maybe [Char]
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 [Char]
mb_calling_fn of
        Just [Char]
calling_fn ->
          SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Error in a declaration passed to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
calling_fn) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
             Arity
2 SDoc
rest
        Maybe [Char]
Nothing -> SDoc
rest
    addSpliceInfo :: SDoc -> SDoc
addSpliceInfo = case ThingBeingConverted
what of
      ConvDec  Dec
d -> [Char] -> Dec -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => [Char] -> a -> SDoc -> SDoc
addSliceInfo' [Char]
"declaration" Dec
d
      ConvExp  Exp
e -> [Char] -> Exp -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => [Char] -> a -> SDoc -> SDoc
addSliceInfo' [Char]
"expression" Exp
e
      ConvPat  Pat
p -> [Char] -> Pat -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => [Char] -> a -> SDoc -> SDoc
addSliceInfo' [Char]
"pattern" Pat
p
      ConvType Type
t -> [Char] -> Type -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => [Char] -> a -> SDoc -> SDoc
addSliceInfo' [Char]
"type" Type
t
    addSliceInfo' :: [Char] -> a -> SDoc -> SDoc
addSliceInfo' [Char]
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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"When splicing a TH" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
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  -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (a -> [Char]
forall a. Show a => a -> [Char]
show a
item)
                       Bool
False -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (a -> [Char]
forall a. Ppr a => a -> [Char]
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 [Char]
_ ->
    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
suggestExtension 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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"more often"
    pp_occurs :: SDoc
pp_occurs | [TyVar] -> Bool
forall a. [a] -> Bool
isSingleton [TyVar]
tvs = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"occurs"
              | Bool
otherwise       = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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)
         , [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"more often"
    pp_occurs :: SDoc
pp_occurs | [TyVar] -> Bool
forall a. [a] -> Bool
isSingleton [TyVar]
tvs = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"occurs"
              | Bool
otherwise       = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"occur"
pprPatersonCondFailure PatersonCondFailure
PCF_Size PatersonCondFailureContext
InInstanceDecl Type
lhs Type
rhs =
  SDoc -> Arity -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is no smaller than", SDoc
pp_rhs ])
  where pp_rhs :: SDoc
pp_rhs = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is no smaller than", SDoc
pp_lhs ])
  where pp_lhs :: SDoc
pp_lhs = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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))

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

defaultTypesAndImport :: ClassDefaults -> SDoc
defaultTypesAndImport :: ClassDefaults -> SDoc
defaultTypesAndImport ClassDefaults{[Type]
cd_types :: ClassDefaults -> [Type]
cd_types :: [Type]
cd_types, cd_module :: ClassDefaults -> Maybe Module
cd_module = Just Module
cdm} =
  SDoc -> Arity -> SDoc -> SDoc
hang (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (Type -> SDoc) -> [Type] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
cd_types)
     Arity
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"imported from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
cdm)
defaultTypesAndImport ClassDefaults{[Type]
cd_types :: ClassDefaults -> [Type]
cd_types :: [Type]
cd_types} = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ((Type -> SDoc) -> [Type] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
cd_types)

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

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
$$
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"cannot be assigned a fixed runtime representation," SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"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

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

pprTypeSyntaxName :: TypeSyntax -> SDoc
pprTypeSyntaxName :: TypeSyntax -> SDoc
pprTypeSyntaxName TypeSyntax
TypeKeywordSyntax     = SDoc
"keyword" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
"type"
pprTypeSyntaxName TypeSyntax
ForallTelescopeSyntax = SDoc
"forall telescope"
pprTypeSyntaxName TypeSyntax
ContextArrowSyntax    = SDoc
"context arrow (=>)"
pprTypeSyntaxName TypeSyntax
FunctionArrowSyntax   = SDoc
"function type arrow (->)"