{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.Tc.Errors.Ppr
( pprTypeDoesNotHaveFixedRuntimeRep
, pprScopeError
, tidySkolemInfo
, tidySkolemInfoAnon
, withHsDocContext
, pprHsDocContext
, inHsDocContext
)
where
import GHC.Prelude
import GHC.Builtin.Names
import GHC.Core.Coercion
import GHC.Core.Unify ( tcMatchTys )
import GHC.Core.TyCon
import GHC.Core.Class
import GHC.Core.DataCon
import GHC.Core.Coercion.Axiom (coAxiomTyCon, coAxiomSingleBranch)
import GHC.Core.ConLike
import GHC.Core.FamInstEnv (famInstAxiom)
import GHC.Core.InstEnv
import GHC.Core.TyCo.Rep (Type(..))
import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen,
pprSourceTyCon, pprTyVars, pprWithTYPE)
import GHC.Core.PatSyn ( patSynName, pprPatSynType )
import GHC.Core.Predicate
import GHC.Core.Type
import GHC.Driver.Flags
import GHC.Hs
import GHC.Tc.Errors.Types
import GHC.Tc.Types.Constraint
import {-# SOURCE #-} GHC.Tc.Types (getLclEnvLoc)
import GHC.Tc.Types.Origin
import GHC.Tc.Types.Rank (Rank(..))
import GHC.Tc.Utils.TcType
import GHC.Types.Error
import GHC.Types.FieldLabel (flIsOverloaded)
import GHC.Types.Hint (UntickedPromotedThing(..), pprUntickedConstructor, isBareSymbol)
import GHC.Types.Hint.Ppr ()
import GHC.Types.Basic
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader ( GreName(..), pprNameProvenance
, RdrName, rdrNameOcc, greMangledName )
import GHC.Types.Name.Set
import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Unit.State (pprWithUnitState, UnitState)
import GHC.Unit.Module
import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Data.List.SetOps ( nubOrdBy )
import GHC.Data.Maybe
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified GHC.LanguageExtensions as LangExt
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Function (on)
import Data.List ( groupBy, sortBy, tails
, partition, unfoldr )
import Data.Ord ( comparing )
import Data.Bifunctor
import GHC.Types.Name.Env
instance Diagnostic TcRnMessage where
diagnosticMessage :: TcRnMessage -> DecoratedSDoc
diagnosticMessage = \case
TcRnUnknownMessage a
m
-> a -> DecoratedSDoc
forall a. Diagnostic a => a -> DecoratedSDoc
diagnosticMessage a
m
TcRnMessageWithInfo UnitState
unit_state TcRnMessageDetailed
msg_with_info
-> case TcRnMessageDetailed
msg_with_info of
TcRnMessageDetailed ErrInfo
err_info TcRnMessage
msg
-> UnitState -> ErrInfo -> DecoratedSDoc -> DecoratedSDoc
messageWithInfoDiagnosticMessage UnitState
unit_state ErrInfo
err_info (TcRnMessage -> DecoratedSDoc
forall a. Diagnostic a => a -> DecoratedSDoc
diagnosticMessage TcRnMessage
msg)
TcRnSolverReport [SolverReportWithCtxt]
msgs DiagnosticReason
_ [GhcHint]
_
-> [SDoc] -> DecoratedSDoc
mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
(SolverReportWithCtxt -> SDoc) -> [SolverReportWithCtxt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt [SolverReportWithCtxt]
msgs
TcRnRedundantConstraints [TcTyVar]
redundants (SkolemInfoAnon
info, Bool
show_info)
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Redundant constraint" SDoc -> SDoc -> SDoc
<> [TcTyVar] -> SDoc
forall a. [a] -> SDoc
plural [TcTyVar]
redundants SDoc -> SDoc -> SDoc
<> SDoc
colon
SDoc -> SDoc -> SDoc
<+> [TcTyVar] -> SDoc
pprEvVarTheta [TcTyVar]
redundants
SDoc -> SDoc -> SDoc
$$ if Bool
show_info then String -> SDoc
text String
"In" SDoc -> SDoc -> SDoc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
info else SDoc
empty
TcRnInaccessibleCode Implication
implic NonEmpty SolverReportWithCtxt
contras
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Inaccessible code in")
Int
2 (SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Implication -> SkolemInfoAnon
ic_info Implication
implic))
SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((SolverReportWithCtxt -> SDoc) -> [SolverReportWithCtxt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt (NonEmpty SolverReportWithCtxt -> [SolverReportWithCtxt]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty SolverReportWithCtxt
contras))
TcRnTypeDoesNotHaveFixedRuntimeRep Type
ty FixedRuntimeRepProvenance
prov (ErrInfo SDoc
extra SDoc
supplementary)
-> [SDoc] -> DecoratedSDoc
mkDecorated [Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep Type
ty FixedRuntimeRepProvenance
prov, SDoc
extra, SDoc
supplementary]
TcRnImplicitLift var
id_or_name ErrInfo{SDoc
errInfoContext :: SDoc
errInfoSupplementary :: SDoc
errInfoContext :: ErrInfo -> SDoc
errInfoSupplementary :: ErrInfo -> SDoc
..}
-> [SDoc] -> DecoratedSDoc
mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
( String -> SDoc
text String
"The variable" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (var -> SDoc
forall a. Outputable a => a -> SDoc
ppr var
id_or_name) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"is implicitly lifted in the TH quotation"
) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc
errInfoContext, SDoc
errInfoSupplementary]
TcRnUnusedPatternBinds HsBind GhcRn
bind
-> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"This pattern-binding binds no variables:") Int
2 (HsBind GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBind GhcRn
bind)]
TcRnDodgyImports RdrName
name
-> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> RdrName -> IE GhcPs -> SDoc
forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg (String -> SDoc
text String
"import") RdrName
name (IdP GhcPs -> IE GhcPs
forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert IdP GhcPs
RdrName
name :: IE GhcPs)]
TcRnDodgyExports Name
name
-> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> Name -> IE GhcRn -> SDoc
forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg (String -> SDoc
text String
"export") Name
name (IdP GhcRn -> IE GhcRn
forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert IdP GhcRn
Name
name :: IE GhcRn)]
TcRnMissingImportList IE GhcPs
ie
-> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
text String
"The import item" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"does not have an explicit import list"
]
TcRnMessage
TcRnUnsafeDueToPlugin
-> [SDoc] -> DecoratedSDoc
mkDecorated [String -> SDoc
text String
"Use of plugins makes the module unsafe"]
TcRnModMissingRealSrcSpan Module
mod
-> [SDoc] -> DecoratedSDoc
mkDecorated [String -> SDoc
text String
"Module does not have a RealSrcSpan:" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod]
TcRnIdNotExportedFromModuleSig Name
name Module
mod
-> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
text String
"The identifier" SDoc -> SDoc -> SDoc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"does not exist in the signature for" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod
]
TcRnIdNotExportedFromLocalSig Name
name
-> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
text String
"The identifier" SDoc -> SDoc -> SDoc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"does not exist in the local signature."
]
TcRnShadowedName OccName
occ ShadowedNameProvenance
provenance
-> let shadowed_locs :: [SDoc]
shadowed_locs = case ShadowedNameProvenance
provenance of
ShadowedNameProvenanceLocal SrcLoc
n -> [String -> SDoc
text String
"bound at" SDoc -> SDoc -> SDoc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcLoc
n]
ShadowedNameProvenanceGlobal [GlobalRdrElt]
gres -> (GlobalRdrElt -> SDoc) -> [GlobalRdrElt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> SDoc
pprNameProvenance [GlobalRdrElt]
gres
in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [String -> SDoc
text String
"This binding for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"shadows the existing binding" SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
forall a. [a] -> SDoc
plural [SDoc]
shadowed_locs,
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat [SDoc]
shadowed_locs)]
TcRnDuplicateWarningDecls LocatedN RdrName
d RdrName
rdr_name
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [String -> SDoc
text String
"Multiple warning declarations for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name),
String -> SDoc
text String
"also at " SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
d)]
TcRnSimplifierTooManyIterations Cts
simples IntWithInf
limit WantedConstraints
wc
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"solveWanteds: too many iterations"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text String
"limit =" SDoc -> SDoc -> SDoc
<+> IntWithInf -> SDoc
forall a. Outputable a => a -> SDoc
ppr IntWithInf
limit))
Int
2 ([SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Unsolved:" SDoc -> SDoc -> SDoc
<+> WantedConstraints -> SDoc
forall a. Outputable a => a -> SDoc
ppr WantedConstraints
wc
, String -> SDoc
text String
"Simples:" SDoc -> SDoc -> SDoc
<+> Cts -> SDoc
forall a. Outputable a => a -> SDoc
ppr Cts
simples
])
TcRnIllegalPatSynDecl LIdP GhcPs
rdrname
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal pattern synonym declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP GhcPs
LocatedN RdrName
rdrname))
Int
2 (String -> SDoc
text String
"Pattern synonym declarations are only valid at top level")
TcRnLinearPatSyn Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Pattern synonyms do not support linear fields (GHC #18806):") Int
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
TcRnMessage
TcRnEmptyRecordUpdate
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Empty record update"
TcRnIllegalFieldPunning Located RdrName
fld
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal use of punning for field" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Located RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located RdrName
fld)
TcRnIllegalWildcardsInRecord RecordFieldPart
fld_part
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal `..' in record" SDoc -> SDoc -> SDoc
<+> RecordFieldPart -> SDoc
pprRecordFieldPart RecordFieldPart
fld_part
TcRnIllegalWildcardInType Maybe Name
mb_name BadAnonWildcardContext
bad Maybe HsDocContext
mb_ctxt
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [ SDoc
main_msg, SDoc
context_msg ]
where
main_msg :: SDoc
main_msg :: SDoc
main_msg = case BadAnonWildcardContext
bad of
BadAnonWildcardContext
WildcardNotLastInConstraint ->
SDoc -> Int -> SDoc -> SDoc
hang SDoc
notAllowed Int
2 SDoc
constraint_hint_msg
ExtraConstraintWildcardNotAllowed SoleExtraConstraintWildcardAllowed
allow_sole ->
case SoleExtraConstraintWildcardAllowed
allow_sole of
SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardNotAllowed ->
SDoc
notAllowed
SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardAllowed ->
SDoc -> Int -> SDoc -> SDoc
hang SDoc
notAllowed Int
2 SDoc
sole_msg
BadAnonWildcardContext
WildcardsNotAllowedAtAll ->
SDoc
notAllowed
context_msg :: SDoc
context_msg :: SDoc
context_msg = case Maybe HsDocContext
mb_ctxt of
Just HsDocContext
ctxt -> Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"in" SDoc -> SDoc -> SDoc
<+> HsDocContext -> SDoc
pprHsDocContext HsDocContext
ctxt)
Maybe HsDocContext
_ -> SDoc
empty
notAllowed, what, wildcard, how :: SDoc
notAllowed :: SDoc
notAllowed = SDoc
what SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
wildcard SDoc -> SDoc -> SDoc
<+> SDoc
how
wildcard :: SDoc
wildcard = case Maybe Name
mb_name of
Maybe Name
Nothing -> SDoc
pprAnonWildCard
Just Name
name -> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
what :: SDoc
what
| Just Name
_ <- Maybe Name
mb_name
= String -> SDoc
text String
"Named wildcard"
| ExtraConstraintWildcardNotAllowed {} <- BadAnonWildcardContext
bad
= String -> SDoc
text String
"Extra-constraint wildcard"
| Bool
otherwise
= String -> SDoc
text String
"Wildcard"
how :: SDoc
how = case BadAnonWildcardContext
bad of
BadAnonWildcardContext
WildcardNotLastInConstraint
-> String -> SDoc
text String
"not allowed in a constraint"
BadAnonWildcardContext
_ -> String -> SDoc
text String
"not allowed"
constraint_hint_msg :: SDoc
constraint_hint_msg :: SDoc
constraint_hint_msg
| Just Name
_ <- Maybe Name
mb_name
= [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Extra-constraint wildcards must be anonymous"
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"e.g f :: (Eq a, _) => blah") ]
| Bool
otherwise
= [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"except as the last top-level constraint of a type signature"
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"e.g f :: (Eq a, _) => blah") ]
sole_msg :: SDoc
sole_msg :: SDoc
sole_msg =
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
"except as the sole constraint"
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"e.g., deriving instance _ => Eq (Foo a)") ]
TcRnDuplicateFieldName RecordFieldPart
fld_part NonEmpty RdrName
dups
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
hsep [String -> SDoc
text String
"duplicate field name",
SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NonEmpty RdrName -> RdrName
forall a. NonEmpty a -> a
NE.head NonEmpty RdrName
dups)),
String -> SDoc
text String
"in record", RecordFieldPart -> SDoc
pprRecordFieldPart RecordFieldPart
fld_part]
TcRnIllegalViewPattern Pat GhcPs
pat
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [String -> SDoc
text String
"Illegal view pattern: " SDoc -> SDoc -> SDoc
<+> Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcPs
pat]
TcRnCharLiteralOutOfRange Char
c
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"character literal out of range: '\\" SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
c SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'\''
TcRnIllegalWildcardsInConstructor Name
con
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Illegal `..' notation for constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con)
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"The constructor has no labelled fields") ]
TcRnIgnoringAnnotations [LAnnDecl GhcRn]
anns
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Ignoring ANN annotation" SDoc -> SDoc -> SDoc
<> [GenLocated SrcSpanAnnA (AnnDecl GhcRn)] -> SDoc
forall a. [a] -> SDoc
plural [LAnnDecl GhcRn]
[GenLocated SrcSpanAnnA (AnnDecl GhcRn)]
anns SDoc -> SDoc -> SDoc
<> SDoc
comma
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi"
TcRnMessage
TcRnAnnotationInSafeHaskell
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Annotations are not compatible with Safe Haskell."
, String -> SDoc
text String
"See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]
TcRnInvalidTypeApplication Type
fun_ty LHsWcType GhcRn
hs_ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Cannot apply expression of type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
fun_ty) SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"to a visible type argument" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
hs_ty)
TcRnMessage
TcRnTagToEnumMissingValArg
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"tagToEnum# must appear applied to one value argument"
TcRnTagToEnumUnspecifiedResTy Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
Int
2 ([SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Specify the type by giving a type signature"
, String -> SDoc
text String
"e.g. (tagToEnum# x) :: Bool" ])
TcRnTagToEnumResTyNotAnEnum Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
Int
2 (String -> SDoc
text String
"Result type must be an enumeration type")
TcRnMessage
TcRnArrowIfThenElsePredDependsOnResultTy
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Predicate type of `ifThenElse' depends on result type"
TcRnMessage
TcRnIllegalHsBootFileDecl
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal declarations in an hs-boot file"
TcRnRecursivePatternSynonym LHsBinds GhcRn
binds
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Recursive pattern synonym definition with following bindings:")
Int
2 ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsBind GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsBind GhcRn) -> SDoc
forall a idR.
CollectPass GhcRn =>
GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
pprLBind ([GenLocated SrcSpanAnnA (HsBind GhcRn)] -> [SDoc])
-> (LHsBinds GhcRn -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
-> LHsBinds GhcRn
-> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBinds GhcRn -> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall a. Bag a -> [a]
bagToList (LHsBinds GhcRn -> [SDoc]) -> LHsBinds GhcRn -> [SDoc]
forall a b. (a -> b) -> a -> b
$ LHsBinds GhcRn
binds)
where
pprLoc :: a -> SDoc
pprLoc a
loc = SDoc -> SDoc
parens (String -> SDoc
text String
"defined at" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
loc)
pprLBind :: CollectPass GhcRn => GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
pprLBind :: forall a idR.
CollectPass GhcRn =>
GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
pprLBind (L SrcSpanAnn' a
loc HsBindLR GhcRn idR
bind) = (Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CollectFlag GhcRn -> HsBindLR GhcRn idR -> [IdP GhcRn]
forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
collectHsBindBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders HsBindLR GhcRn idR
bind)
SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
pprLoc (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc)
TcRnPartialTypeSigTyVarMismatch Name
n1 Name
n2 Name
fn_name LHsSigWcType GhcRn
hs_ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Couldn't match" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n1)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"with" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n2))
Int
2 (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"both bound by the partial type signature:")
Int
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn_name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
hs_ty))
TcRnPartialTypeSigBadQuantifier Name
n Name
fn_name Maybe Type
m_unif_ty LHsSigWcType GhcRn
hs_ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Can't quantify over" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n))
Int
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"bound by the partial type signature:")
Int
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn_name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
hs_ty)
, SDoc
extra ])
where
extra :: SDoc
extra | Just Type
rhs_ty <- Maybe Type
m_unif_ty
= [SDoc] -> SDoc
sep [ SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n), String -> SDoc
text String
"should really be", SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs_ty) ]
| Bool
otherwise
= SDoc
empty
TcRnMissingSignature MissingSignature
what Exported
_ Bool
_ ->
SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
case MissingSignature
what of
MissingPatSynSig PatSyn
p ->
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Pattern synonym with no type signature:")
Int
2 (String -> SDoc
text String
"pattern" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName (PatSyn -> Name
patSynName PatSyn
p) SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> PatSyn -> SDoc
pprPatSynType PatSyn
p)
MissingTopLevelBindingSig Name
name Type
ty ->
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Top-level binding with no type signature:")
Int
2 (Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprSigmaType Type
ty)
MissingTyConKindSig TyCon
tc Bool
cusks_enabled ->
SDoc -> Int -> SDoc -> SDoc
hang SDoc
msg
Int
2 (String -> SDoc
text String
"type" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName (TyCon -> Name
tyConName TyCon
tc) SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprKind (TyCon -> Type
tyConKind TyCon
tc))
where
msg :: SDoc
msg | Bool
cusks_enabled
= String -> SDoc
text String
"Top-level type constructor with no standalone kind signature or CUSK:"
| Bool
otherwise
= String -> SDoc
text String
"Top-level type constructor with no standalone kind signature:"
TcRnPolymorphicBinderMissingSig Name
n Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [ String -> SDoc
text String
"Polymorphic local binding with no type signature:"
, Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
n SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty ]
TcRnOverloadedSig TcIdSigInfo
sig
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Overloaded signature conflicts with monomorphism restriction")
Int
2 (TcIdSigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSigInfo
sig)
TcRnTupleConstraintInst Class
_
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"You can't specify an instance for a tuple constraint"
TcRnAbstractClassInst Class
clas
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Cannot define instance for abstract class" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Class -> Name
className Class
clas))
TcRnNoClassInstHead Type
tau
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Instance head is not headed by a class:") Int
2 (Type -> SDoc
pprType Type
tau)
TcRnUserTypeError Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (Type -> SDoc
pprUserTypeErrorTy Type
ty)
TcRnConstraintInKind Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal constraint in a kind:" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprType Type
ty
TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
tuple_or_sum Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [ String -> SDoc
text String
"Illegal unboxed" SDoc -> SDoc -> SDoc
<+> SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"type as function argument:"
, Type -> SDoc
pprType Type
ty ]
where
what :: SDoc
what = case UnboxedTupleOrSum
tuple_or_sum of
UnboxedTupleOrSum
UnboxedTupleType -> String -> SDoc
text String
"tuple"
UnboxedTupleOrSum
UnboxedSumType -> String -> SDoc
text String
"sum"
TcRnLinearFuncInKind Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal linear function in a kind:" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprType Type
ty
TcRnForAllEscapeError Type
ty Type
kind
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat
[ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Quantified type's kind mentions quantified type variable")
Int
2 (String -> SDoc
text String
"type:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty))
, SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"where the body of the forall has this kind:")
Int
2 (SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
kind)) ]
TcRnVDQInTermType Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat
[ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Illegal visible, dependent quantification" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"in the type of a term:")
Int
2 (Type -> SDoc
pprType Type
ty)
, String -> SDoc
text String
"(GHC does not yet support this)" ]
TcRnBadQuantPredHead Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Quantified predicate must have a class or type variable head:")
Int
2 (Type -> SDoc
pprType Type
ty)
TcRnIllegalTupleConstraint Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal tuple constraint:" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprType Type
ty
TcRnNonTypeVarArgInConstraint Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Non type-variable argument")
Int
2 (String -> SDoc
text String
"in the constraint:" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprType Type
ty)
TcRnIllegalImplicitParam Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal implicit parameter" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
ty)
TcRnIllegalConstraintSynonymOfKind Type
kind
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal constraint synonym of kind:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
kind)
TcRnIllegalClassInst TyConFlavour
tcf
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Illegal instance for a" SDoc -> SDoc -> SDoc
<+> TyConFlavour -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour
tcf
, String -> SDoc
text String
"A class instance must be for a class" ]
TcRnOversaturatedVisibleKindArg Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal oversaturated visible kind argument:" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
quotes (Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> Type -> SDoc
pprParendType Type
ty)
TcRnBadAssociatedType Name
clas Name
tc
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
hsep [ String -> SDoc
text String
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
clas)
, String -> SDoc
text String
"does not have an associated type", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc) ]
TcRnForAllRankErr Rank
rank Type
ty
-> let herald :: SDoc
herald = case Type -> ([TcTyVar], Type)
tcSplitForAllTyVars Type
ty of
([], Type
_) -> String -> SDoc
text String
"Illegal qualified type:"
([TcTyVar], Type)
_ -> String -> SDoc
text String
"Illegal polymorphic type:"
extra :: SDoc
extra = case Rank
rank of
Rank
MonoTypeConstraint -> String -> SDoc
text String
"A constraint must be a monotype"
Rank
_ -> SDoc
empty
in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 (Type -> SDoc
pprType Type
ty), SDoc
extra]
TcRnMonomorphicBindings [Name]
bindings
-> let pp_bndrs :: SDoc
pp_bndrs = [Name] -> SDoc
pprBindings [Name]
bindings
in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [ String -> SDoc
text String
"The Monomorphism Restriction applies to the binding"
SDoc -> SDoc -> SDoc
<> [Name] -> SDoc
forall a. [a] -> SDoc
plural [Name]
bindings
, String -> SDoc
text String
"for" SDoc -> SDoc -> SDoc
<+> SDoc
pp_bndrs ]
TcRnOrphanInstance ClsInst
inst
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
hsep [ String -> SDoc
text String
"Orphan instance:"
, ClsInst -> SDoc
pprInstanceHdr ClsInst
inst
]
TcRnFunDepConflict UnitState
unit_state NonEmpty ClsInst
sorted
-> let herald :: SDoc
herald = String -> SDoc
text String
"Functional dependencies conflict between instance declarations:"
in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 ([ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
sorted))
TcRnDupInstanceDecls UnitState
unit_state NonEmpty ClsInst
sorted
-> let herald :: SDoc
herald = String -> SDoc
text String
"Duplicate instance declarations:"
in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 ([ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
sorted))
TcRnConflictingFamInstDecls NonEmpty FamInst
sortedNE
-> let sorted :: [FamInst]
sorted = NonEmpty FamInst -> [FamInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FamInst
sortedNE
in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Conflicting family instance declarations:")
Int
2 ([SDoc] -> SDoc
vcat [ TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser (CoAxiom Unbranched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
ax) (CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch CoAxiom Unbranched
ax)
| FamInst
fi <- [FamInst]
sorted
, let ax :: CoAxiom Unbranched
ax = FamInst -> CoAxiom Unbranched
famInstAxiom FamInst
fi ])
TcRnFamInstNotInjective InjectivityErrReason
rea TyCon
fam_tc (CoAxBranch
eqn1 NE.:| [CoAxBranch]
rest_eqns)
-> let (SDoc
herald, Bool
show_kinds) = case InjectivityErrReason
rea of
InjErrRhsBareTyVar [Type]
tys ->
(SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"RHS of injective type family equation is a bare" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"type variable" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"but these LHS type and kind patterns are not bare" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"variables:" SDoc -> SDoc -> SDoc
<+> [Type] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [Type]
tys, Bool
False)
InjectivityErrReason
InjErrRhsCannotBeATypeFam ->
(SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"RHS of injective type family equation cannot" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"be a type family:", Bool
False)
InjectivityErrReason
InjErrRhsOverlap ->
(String -> SDoc
text String
"Type family equation right-hand sides overlap; this violates" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"the family's injectivity annotation:", Bool
False)
InjErrCannotInferFromRhs TyVarSet
tvs HasKinds
has_kinds SuggestUndecidableInstances
_ ->
let show_kinds :: Bool
show_kinds = HasKinds
has_kinds HasKinds -> HasKinds -> Bool
forall a. Eq a => a -> a -> Bool
== HasKinds
YesHasKinds
what :: SDoc
what = if Bool
show_kinds then String -> SDoc
text String
"Type/kind" else String -> SDoc
text String
"Type"
body :: SDoc
body = [SDoc] -> SDoc
sep [ SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"variable" SDoc -> SDoc -> SDoc
<>
TyVarSet -> SDoc
pluralVarSet TyVarSet
tvs SDoc -> SDoc -> SDoc
<+> TyVarSet -> ([TcTyVar] -> SDoc) -> SDoc
pprVarSet TyVarSet
tvs ([TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList ([TcTyVar] -> SDoc)
-> ([TcTyVar] -> [TcTyVar]) -> [TcTyVar] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TcTyVar] -> [TcTyVar]
scopedSort)
, String -> SDoc
text String
"cannot be inferred from the right-hand side." ]
in (SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
$$ SDoc
body SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"In the type family equation:", Bool
show_kinds)
in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
show_kinds (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald
Int
2 ([SDoc] -> SDoc
vcat ((CoAxBranch -> SDoc) -> [CoAxBranch] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser TyCon
fam_tc) (CoAxBranch
eqn1 CoAxBranch -> [CoAxBranch] -> [CoAxBranch]
forall a. a -> [a] -> [a]
: [CoAxBranch]
rest_eqns)))
TcRnBangOnUnliftedType Type
ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Strictness flag has no effect on unlifted type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
TcRnMultipleDefaultDeclarations [LDefaultDecl GhcRn]
dup_things
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Multiple default declarations")
Int
2 ([SDoc] -> SDoc
vcat ((GenLocated SrcSpanAnnA (DefaultDecl GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (DefaultDecl GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LDefaultDecl GhcRn -> SDoc
GenLocated SrcSpanAnnA (DefaultDecl GhcRn) -> SDoc
pp [LDefaultDecl GhcRn]
[GenLocated SrcSpanAnnA (DefaultDecl GhcRn)]
dup_things))
where
pp :: LDefaultDecl GhcRn -> SDoc
pp :: LDefaultDecl GhcRn -> SDoc
pp (L SrcSpanAnnA
locn (DefaultDecl XCDefaultDecl GhcRn
_ [LHsType GhcRn]
_))
= String -> SDoc
text String
"here was another default declaration" SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
locn)
TcRnBadDefaultType Type
ty [Class]
deflt_clss
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"The default type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not an instance of")
Int
2 ((SDoc -> SDoc -> SDoc) -> [SDoc] -> SDoc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\SDoc
a SDoc
b -> SDoc
a SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"or" SDoc -> SDoc -> SDoc
<+> SDoc
b) ((Class -> SDoc) -> [Class] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes(SDoc -> SDoc) -> (Class -> SDoc) -> Class -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [Class]
deflt_clss))
TcRnMessage
TcRnPatSynBundledWithNonDataCon
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Pattern synonyms can be bundled only with datatypes."
TcRnPatSynBundledWithWrongType Type
expected_res_ty Type
res_ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Pattern synonyms can only be bundled with matching type constructors"
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"Couldn't match expected type of"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
expected_res_ty)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"with actual type of"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
res_ty)
TcRnDupeModuleExport ModuleName
mod
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
hsep [ String -> SDoc
text String
"Duplicate"
, SDoc -> SDoc
quotes (String -> SDoc
text String
"Module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
, String -> SDoc
text String
"in export list" ]
TcRnExportedModNotImported ModuleName
mod
-> SDoc -> DecoratedSDoc
mkSimpleDecorated
(SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
(String -> SDoc
text String
"module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
String
"is not imported"
TcRnNullExportedModule ModuleName
mod
-> SDoc -> DecoratedSDoc
mkSimpleDecorated
(SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
(String -> SDoc
text String
"module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
String
"exports nothing"
TcRnMissingExportList ModuleName
mod
-> SDoc -> DecoratedSDoc
mkSimpleDecorated
(SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
(String -> SDoc
text String
"module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
String
"is missing an export list"
TcRnExportHiddenComponents IE GhcPs
export_item
-> SDoc -> DecoratedSDoc
mkSimpleDecorated
(SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
(IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
export_item)
String
"attempts to export constructors or class methods that are not visible here"
TcRnDuplicateExport GreName
child IE GhcPs
ie1 IE GhcPs
ie2
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
hsep [ SDoc -> SDoc
quotes (GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
child)
, String -> SDoc
text String
"is exported by", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie1)
, String -> SDoc
text String
"and", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie2) ]
TcRnExportedParentChildMismatch Name
parent_name TyThing
ty_thing GreName
child [Name]
parent_names
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"The type constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
parent_name)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not the parent of the" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
what_is
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes SDoc
thing SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'.'
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text (String -> String
capitalise String
what_is)
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"s can only be exported with their parent type constructor."
SDoc -> SDoc -> SDoc
$$ (case [SDoc]
parents of
[] -> SDoc
empty
[SDoc
_] -> String -> SDoc
text String
"Parent:"
[SDoc]
_ -> String -> SDoc
text String
"Parents:") SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
parents)
where
pp_category :: TyThing -> String
pp_category :: TyThing -> String
pp_category (AnId TcTyVar
i)
| TcTyVar -> Bool
isRecordSelector TcTyVar
i = String
"record selector"
pp_category TyThing
i = TyThing -> String
tyThingCategory TyThing
i
what_is :: String
what_is = TyThing -> String
pp_category TyThing
ty_thing
thing :: SDoc
thing = GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
child
parents :: [SDoc]
parents = (Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
parent_names
TcRnConflictingExports OccName
occ GreName
child1 GlobalRdrElt
gre1 IE GhcPs
ie1 GreName
child2 GlobalRdrElt
gre2 IE GhcPs
ie2
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Conflicting exports for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
<> SDoc
colon
, GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child1 GlobalRdrElt
gre1 IE GhcPs
ie1
, GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child2 GlobalRdrElt
gre2 IE GhcPs
ie2
]
where
ppr_export :: GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child GlobalRdrElt
gre a
ie = Int -> SDoc -> SDoc
nest Int
3 (SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ie) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"exports" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
quotes (GreName -> SDoc
ppr_name GreName
child))
Int
2 (GlobalRdrElt -> SDoc
pprNameProvenance GlobalRdrElt
gre))
ppr_name :: GreName -> SDoc
ppr_name (FieldGreName FieldLabel
fl) | FieldLabel -> Bool
flIsOverloaded FieldLabel
fl = FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl
| Bool
otherwise = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> Name
flSelector FieldLabel
fl)
ppr_name (NormalGreName Name
name) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
TcRnAmbiguousField HsExpr GhcRn
rupd TyCon
parent_type
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The record update" SDoc -> SDoc -> SDoc
<+> HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
rupd
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"with type" SDoc -> SDoc -> SDoc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
parent_type
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is ambiguous."
, String -> SDoc
text String
"This will not be supported by -XDuplicateRecordFields in future releases of GHC."
]
TcRnMissingFields ConLike
con [(FieldLabelString, Type)]
fields
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [SDoc
header, Int -> SDoc -> SDoc
nest Int
2 SDoc
rest]
where
rest :: SDoc
rest | [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = SDoc
empty
| Bool
otherwise = [SDoc] -> SDoc
vcat (((FieldLabelString, Type) -> SDoc)
-> [(FieldLabelString, Type)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)
header :: SDoc
header = String -> SDoc
text String
"Fields of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"not initialised" SDoc -> SDoc -> SDoc
<>
if [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields then SDoc
empty else SDoc
colon
TcRnFieldUpdateInvalidType [(FieldLabelString, Type)]
prs
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Record update for insufficiently polymorphic field"
SDoc -> SDoc -> SDoc
<> [(FieldLabelString, Type)] -> SDoc
forall a. [a] -> SDoc
plural [(FieldLabelString, Type)]
prs SDoc -> SDoc -> SDoc
<> SDoc
colon)
Int
2 ([SDoc] -> SDoc
vcat [ FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
f SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty | (FieldLabelString
f,Type
ty) <- [(FieldLabelString, Type)]
prs ])
TcRnNoConstructorHasAllFields [FieldLabelString]
conflictingFields
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"No constructor has all these fields:")
Int
2 ([FieldLabelString] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [FieldLabelString]
conflictingFields)
TcRnMixedSelectors Name
data_name [TcTyVar]
data_sels Name
pat_name [TcTyVar]
pat_syn_sels
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Cannot use a mixture of pattern synonym and record selectors" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"Record selectors defined by"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
data_name)
SDoc -> SDoc -> SDoc
<> SDoc
colon
SDoc -> SDoc -> SDoc
<+> (TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
data_sels SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"Pattern synonym selectors defined by"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
pat_name)
SDoc -> SDoc -> SDoc
<> SDoc
colon
SDoc -> SDoc -> SDoc
<+> (TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
pat_syn_sels
TcRnMissingStrictFields ConLike
con [(FieldLabelString, Type)]
fields
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [SDoc
header, Int -> SDoc -> SDoc
nest Int
2 SDoc
rest]
where
rest :: SDoc
rest | [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = SDoc
empty
| Bool
otherwise = [SDoc] -> SDoc
vcat (((FieldLabelString, Type) -> SDoc)
-> [(FieldLabelString, Type)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)
header :: SDoc
header = String -> SDoc
text String
"Constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"does not have the required strict field(s)" SDoc -> SDoc -> SDoc
<>
if [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields then SDoc
empty else SDoc
colon
TcRnNoPossibleParentForFields [LHsRecUpdField GhcRn]
rbinds
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"No type has all these fields:")
Int
2 ([GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
fields)
where fields :: [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
fields = (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS (HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
-> (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc) [LHsRecUpdField GhcRn]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
(GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
rbinds
TcRnBadOverloadedRecordUpdate [LHsRecUpdField GhcRn]
_rbinds
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Record update is ambiguous, and requires a type signature"
TcRnStaticFormNotClosed Name
name NotClosedReason
reason
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is used in a static form but it is not closed"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"because it"
SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
sep (NotClosedReason -> [SDoc]
causes NotClosedReason
reason)
where
causes :: NotClosedReason -> [SDoc]
causes :: NotClosedReason -> [SDoc]
causes NotClosedReason
NotLetBoundReason = [String -> SDoc
text String
"is not let-bound."]
causes (NotTypeClosed TyVarSet
vs) =
[ String -> SDoc
text String
"has a non-closed type because it contains the"
, String -> SDoc
text String
"type variables:" SDoc -> SDoc -> SDoc
<+>
TyVarSet -> ([TcTyVar] -> SDoc) -> SDoc
pprVarSet TyVarSet
vs ([SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> ([TcTyVar] -> [SDoc]) -> [TcTyVar] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ([SDoc] -> [SDoc]) -> ([TcTyVar] -> [SDoc]) -> [TcTyVar] -> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TcTyVar -> SDoc) -> [TcTyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (TcTyVar -> SDoc) -> TcTyVar -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr))
]
causes (NotClosed Name
n NotClosedReason
reason) =
let msg :: SDoc
msg = String -> SDoc
text String
"uses" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"which"
in case NotClosedReason
reason of
NotClosed Name
_ NotClosedReason
_ -> SDoc
msg SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: NotClosedReason -> [SDoc]
causes NotClosedReason
reason
NotClosedReason
_ -> let ([SDoc]
xs0, [SDoc]
xs1) = Int -> [SDoc] -> ([SDoc], [SDoc])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([SDoc] -> ([SDoc], [SDoc])) -> [SDoc] -> ([SDoc], [SDoc])
forall a b. (a -> b) -> a -> b
$ NotClosedReason -> [SDoc]
causes NotClosedReason
reason
in (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SDoc
msg SDoc -> SDoc -> SDoc
<+>) [SDoc]
xs0 [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
xs1
TcRnMessage
TcRnUselessTypeable
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Deriving" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
typeableClassName) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"has no effect: all types now auto-derive Typeable"
TcRnDerivingDefaults Class
cls
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
sep
[ String -> SDoc
text String
"Both DeriveAnyClass and"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"GeneralizedNewtypeDeriving are enabled"
, String -> SDoc
text String
"Defaulting to the DeriveAnyClass strategy"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"for instantiating" SDoc -> SDoc -> SDoc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls
]
TcRnNonUnaryTypeclassConstraint LHsSigType GhcRn
ct
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
ct)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not a unary constraint, as expected by a deriving clause"
TcRnPartialTypeSignatures SuggestPartialTypeSignatures
_ [Type]
theta
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Found type wildcard" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Char -> SDoc
char Char
'_')
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"standing for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes ([Type] -> SDoc
pprTheta [Type]
theta)
TcRnCannotDeriveInstance Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving DeriveInstanceErrReason
reason
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
True DeriveInstanceErrReason
reason
TcRnMessage
TcRnLazyGADTPattern
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"An existential or GADT data constructor cannot be used")
Int
2 (String -> SDoc
text String
"inside a lazy (~) pattern")
TcRnMessage
TcRnArrowProcGADTPattern
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Proc patterns cannot use existential or GADT data constructors"
TcRnSpecialClassInst Class
cls Bool
because_safeHaskell
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ Class -> Name
className Class
cls)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"does not support user-specified instances"
SDoc -> SDoc -> SDoc
<> SDoc
safeHaskell_msg
where
safeHaskell_msg :: SDoc
safeHaskell_msg
| Bool
because_safeHaskell
= String -> SDoc
text String
" when Safe Haskell is enabled."
| Bool
otherwise
= SDoc
dot
TcRnForallIdentifier RdrName
rdr_name
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
fsep [ String -> SDoc
text String
"The use of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"as an identifier",
String -> SDoc
text String
"will become an error in a future GHC release." ]
TcRnMessage
TcRnTypeEqualityOutOfScope
-> [SDoc] -> DecoratedSDoc
mkDecorated
[ String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"~") SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"operator is out of scope." SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"Assuming it to stand for an equality constraint."
, String -> SDoc
text String
"NB:" SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc
quotes (String -> SDoc
text String
"~") SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"used to be built-in syntax but now is a regular type operator" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"exported from Data.Type.Equality and Prelude.") SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"If you are using a custom Prelude, consider re-exporting it."
, String -> SDoc
text String
"This will become an error in a future GHC release." ]
TcRnMessage
TcRnTypeEqualityRequiresOperators
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
fsep [ String -> SDoc
text String
"The use of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"~")
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"without TypeOperators",
String -> SDoc
text String
"will become an error in a future GHC release." ]
TcRnIllegalTypeOperator SDoc
overall_ty RdrName
op
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Illegal operator" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
op) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"in type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SDoc
overall_ty)
TcRnMessage
TcRnGADTMonoLocalBinds
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
fsep [ String -> SDoc
text String
"Pattern matching on GADTs without MonoLocalBinds"
, String -> SDoc
text String
"is fragile." ]
TcRnIncorrectNameSpace Name
name Bool
_
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc
msg
where
msg :: SDoc
msg
| NameSpace -> Bool
isValNameSpace NameSpace
ns
= String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"does not live in the type-level namespace"
| Bool
otherwise
= String -> SDoc
text String
"Illegal term-level use of the" SDoc -> SDoc -> SDoc
<+> SDoc
what
ns :: NameSpace
ns = Name -> NameSpace
nameNameSpace Name
name
what :: SDoc
what = NameSpace -> SDoc
pprNameSpace NameSpace
ns SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
TcRnNotInScope NotInScopeError
err RdrName
name [ImportError]
imp_errs [GhcHint]
_
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
name NotInScopeError
err SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((ImportError -> SDoc) -> [ImportError] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ImportError -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs)
TcRnUntickedPromotedThing UntickedPromotedThing
thing
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Unticked promoted" SDoc -> SDoc -> SDoc
<+> SDoc
what
where
what :: SDoc
what :: SDoc
what = case UntickedPromotedThing
thing of
UntickedPromotedThing
UntickedExplicitList -> String -> SDoc
text String
"list" SDoc -> SDoc -> SDoc
<> SDoc
dot
UntickedConstructor LexicalFixity
fixity Name
nm ->
let con :: SDoc
con = LexicalFixity -> Name -> SDoc
pprUntickedConstructor LexicalFixity
fixity Name
nm
bare_sym :: Bool
bare_sym = LexicalFixity -> Name -> Bool
isBareSymbol LexicalFixity
fixity Name
nm
in String -> SDoc
text String
"constructor:" SDoc -> SDoc -> SDoc
<+> SDoc
con SDoc -> SDoc -> SDoc
<> if Bool
bare_sym then SDoc
empty else SDoc
dot
TcRnIllegalBuiltinSyntax SDoc
what RdrName
rdr_name
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
hsep [String -> SDoc
text String
"Illegal", SDoc
what, String -> SDoc
text String
"of built-in syntax:", RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name]
TcRnWarnDefaulting [Ct]
tidy_wanteds Maybe TcTyVar
tidy_tv Type
default_ty
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ String -> SDoc
text String
"Defaulting" ]
[SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
(case Maybe TcTyVar
tidy_tv of
Maybe TcTyVar
Nothing -> []
Just TcTyVar
tv -> [String -> SDoc
text String
"the type variable"
, SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)])
[SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
[ String -> SDoc
text String
"to type"
, SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
default_ty)
, String -> SDoc
text String
"in the following constraint" SDoc -> SDoc -> SDoc
<> [Ct] -> SDoc
forall a. [a] -> SDoc
plural [Ct]
tidy_wanteds ])
Int
2
([Ct] -> SDoc
pprWithArising [Ct]
tidy_wanteds)
TcRnForeignImportPrimExtNotSet ForeignImport
_decl
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"`foreign import prim' requires GHCForeignImportPrim."
TcRnForeignImportPrimSafeAnn ForeignImport
_decl
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"The safe/unsafe annotation should not be used with `foreign import prim'."
TcRnForeignFunctionImportAsValue ForeignImport
_decl
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"`value' imports cannot have function types"
TcRnFunPtrImportWithoutAmpersand ForeignImport
_decl
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"possible missing & in foreign import of FunPtr"
TcRnIllegalForeignDeclBackend Either ForeignExport ForeignImport
_decl Backend
_backend ExpectedBackends
expectedBknds
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Illegal foreign declaration:" SDoc -> SDoc -> SDoc
<+>
case ExpectedBackends
expectedBknds of
ExpectedBackends
COrAsmOrLlvm ->
String -> SDoc
text String
"requires unregisterised, llvm (-fllvm) or native code generation (-fasm)"
ExpectedBackends
COrAsmOrLlvmOrInterp ->
String -> SDoc
text String
"requires interpreted, unregisterised, llvm or native code generation"
TcRnUnsupportedCallConv Either ForeignExport ForeignImport
_decl UnsupportedCallConvention
unsupportedCC
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
case UnsupportedCallConvention
unsupportedCC of
UnsupportedCallConvention
StdCallConvUnsupported ->
String -> SDoc
text String
"the 'stdcall' calling convention is unsupported on this platform,"
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"treating as ccall"
UnsupportedCallConvention
PrimCallConvUnsupported ->
String -> SDoc
text String
"The `prim' calling convention can only be used with `foreign import'"
UnsupportedCallConvention
JavaScriptCallConvUnsupported ->
String -> SDoc
text String
"The `javascript' calling convention is unsupported on this platform"
TcRnIllegalForeignType Maybe ArgOrResult
mArgOrResult IllegalForeignTypeReason
reason
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang SDoc
msg Int
2 SDoc
extra
where
arg_or_res :: SDoc
arg_or_res = case Maybe ArgOrResult
mArgOrResult of
Maybe ArgOrResult
Nothing -> SDoc
empty
Just ArgOrResult
Arg -> String -> SDoc
text String
"argument"
Just ArgOrResult
Result -> String -> SDoc
text String
"result"
msg :: SDoc
msg = [SDoc] -> SDoc
hsep [ String -> SDoc
text String
"Unacceptable", SDoc
arg_or_res
, String -> SDoc
text String
"type in foreign declaration:"]
extra :: SDoc
extra =
case IllegalForeignTypeReason
reason of
TypeCannotBeMarshaled Type
ty TypeCannotBeMarshaledReason
why ->
let innerMsg :: SDoc
innerMsg = SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"cannot be marshalled in a foreign call"
in case TypeCannotBeMarshaledReason
why of
TypeCannotBeMarshaledReason
NotADataType ->
SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not a data type"
NewtypeDataConNotInScope Maybe TyCon
Nothing ->
SDoc -> Int -> SDoc -> SDoc
hang SDoc
innerMsg Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"because its data constructor is not in scope"
NewtypeDataConNotInScope (Just TyCon
tc) ->
SDoc -> Int -> SDoc -> SDoc
hang SDoc
innerMsg Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"because the data constructor for"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not in scope"
TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded ->
SDoc
innerMsg SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"UnliftedFFITypes is required to marshal unlifted types"
TypeCannotBeMarshaledReason
NotABoxedMarshalableTyCon -> SDoc
innerMsg
TypeCannotBeMarshaledReason
ForeignLabelNotAPtr ->
SDoc
innerMsg SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)"
TypeCannotBeMarshaledReason
NotSimpleUnliftedType ->
SDoc
innerMsg SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"foreign import prim only accepts simple unlifted types"
ForeignDynNotPtr Type
expected Type
ty ->
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Expected: Ptr/FunPtr" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprParendType Type
expected SDoc -> SDoc -> SDoc
<> SDoc
comma, String -> SDoc
text String
" Actual:" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty ]
IllegalForeignTypeReason
SafeHaskellMustBeInIO ->
String -> SDoc
text String
"Safe Haskell is on, all FFI imports must be in the IO monad"
IllegalForeignTypeReason
IOResultExpected ->
String -> SDoc
text String
"IO result type expected"
IllegalForeignTypeReason
UnexpectedNestedForall ->
String -> SDoc
text String
"Unexpected nested forall"
IllegalForeignTypeReason
LinearTypesNotAllowed ->
String -> SDoc
text String
"Linear types are not supported in FFI declarations, see #18472"
IllegalForeignTypeReason
OneArgExpected ->
String -> SDoc
text String
"One argument expected"
IllegalForeignTypeReason
AtLeastOneArgExpected ->
String -> SDoc
text String
"At least one argument expected"
TcRnInvalidCIdentifier FieldLabelString
target
-> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
sep [SDoc -> SDoc
quotes (FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
target) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not a valid C identifier"]
diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
TcRnUnknownMessage a
m
-> a -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason a
m
TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
-> case TcRnMessageDetailed
msg_with_info of
TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> TcRnMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason TcRnMessage
m
TcRnSolverReport [SolverReportWithCtxt]
_ DiagnosticReason
reason [GhcHint]
_
-> DiagnosticReason
reason
TcRnRedundantConstraints {}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantConstraints
TcRnInaccessibleCode {}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnInaccessibleCode
TcRnTypeDoesNotHaveFixedRuntimeRep{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnImplicitLift{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnImplicitLift
TcRnUnusedPatternBinds{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedPatternBinds
TcRnDodgyImports{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyImports
TcRnDodgyExports{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyExports
TcRnMissingImportList{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingImportList
TcRnUnsafeDueToPlugin{}
-> DiagnosticReason
WarningWithoutFlag
TcRnModMissingRealSrcSpan{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIdNotExportedFromModuleSig{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIdNotExportedFromLocalSig{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnShadowedName{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnNameShadowing
TcRnDuplicateWarningDecls{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnSimplifierTooManyIterations{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalPatSynDecl{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnLinearPatSyn{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMessage
TcRnEmptyRecordUpdate
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalFieldPunning{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalWildcardsInRecord{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalWildcardInType{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnDuplicateFieldName{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalViewPattern{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnCharLiteralOutOfRange{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalWildcardsInConstructor{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIgnoringAnnotations{}
-> DiagnosticReason
WarningWithoutFlag
TcRnMessage
TcRnAnnotationInSafeHaskell
-> DiagnosticReason
ErrorWithoutFlag
TcRnInvalidTypeApplication{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMessage
TcRnTagToEnumMissingValArg
-> DiagnosticReason
ErrorWithoutFlag
TcRnTagToEnumUnspecifiedResTy{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnTagToEnumResTyNotAnEnum{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMessage
TcRnArrowIfThenElsePredDependsOnResultTy
-> DiagnosticReason
ErrorWithoutFlag
TcRnMessage
TcRnIllegalHsBootFileDecl
-> DiagnosticReason
ErrorWithoutFlag
TcRnRecursivePatternSynonym{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnPartialTypeSigTyVarMismatch{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnPartialTypeSigBadQuantifier{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMissingSignature MissingSignature
what Exported
exported Bool
overridden
-> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag -> DiagnosticReason)
-> WarningFlag -> DiagnosticReason
forall a b. (a -> b) -> a -> b
$ MissingSignature -> Exported -> Bool -> WarningFlag
missingSignatureWarningFlag MissingSignature
what Exported
exported Bool
overridden
TcRnPolymorphicBinderMissingSig{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingLocalSignatures
TcRnOverloadedSig{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnTupleConstraintInst{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnAbstractClassInst{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnNoClassInstHead{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnUserTypeError{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnConstraintInKind{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnUnboxedTupleOrSumTypeFuncArg{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnLinearFuncInKind{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnForAllEscapeError{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnVDQInTermType{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnBadQuantPredHead{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalTupleConstraint{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnNonTypeVarArgInConstraint{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalImplicitParam{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalConstraintSynonymOfKind{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalClassInst{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnOversaturatedVisibleKindArg{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnBadAssociatedType{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnForAllRankErr{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMonomorphicBindings{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMonomorphism
TcRnOrphanInstance{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnOrphans
TcRnFunDepConflict{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnDupInstanceDecls{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnConflictingFamInstDecls{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnFamInstNotInjective{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnBangOnUnliftedType{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantStrictnessFlags
TcRnMultipleDefaultDeclarations{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnBadDefaultType{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnPatSynBundledWithNonDataCon{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnPatSynBundledWithWrongType{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnDupeModuleExport{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDuplicateExports
TcRnExportedModNotImported{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnNullExportedModule{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyExports
TcRnMissingExportList{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingExportList
TcRnExportHiddenComponents{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnDuplicateExport{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDuplicateExports
TcRnExportedParentChildMismatch{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnConflictingExports{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnAmbiguousField{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnAmbiguousFields
TcRnMissingFields{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingFields
TcRnFieldUpdateInvalidType{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnNoConstructorHasAllFields{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMixedSelectors{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMissingStrictFields{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnNoPossibleParentForFields{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnBadOverloadedRecordUpdate{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnStaticFormNotClosed{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnMessage
TcRnUselessTypeable
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDerivingTypeable
TcRnDerivingDefaults{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDerivingDefaults
TcRnNonUnaryTypeclassConstraint{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnPartialTypeSignatures{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnPartialTypeSignatures
TcRnCannotDeriveInstance Class
_ [Type]
_ Maybe (DerivStrategy GhcTc)
_ UsingGeneralizedNewtypeDeriving
_ DeriveInstanceErrReason
rea
-> case DeriveInstanceErrReason
rea of
DerivErrNotWellKinded{} -> DiagnosticReason
ErrorWithoutFlag
DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst -> DiagnosticReason
ErrorWithoutFlag
DerivErrDerivingViaWrongKind{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrNoEtaReduce{} -> DiagnosticReason
ErrorWithoutFlag
DeriveInstanceErrReason
DerivErrBootFileFound -> DiagnosticReason
ErrorWithoutFlag
DerivErrDataConsNotAllInScope{} -> DiagnosticReason
ErrorWithoutFlag
DeriveInstanceErrReason
DerivErrGNDUsedOnData -> DiagnosticReason
ErrorWithoutFlag
DeriveInstanceErrReason
DerivErrNullaryClasses -> DiagnosticReason
ErrorWithoutFlag
DeriveInstanceErrReason
DerivErrLastArgMustBeApp -> DiagnosticReason
ErrorWithoutFlag
DerivErrNoFamilyInstance{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrNotStockDeriveable{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrHasAssociatedDatatypes{} -> DiagnosticReason
ErrorWithoutFlag
DeriveInstanceErrReason
DerivErrNewtypeNonDeriveableClass -> DiagnosticReason
ErrorWithoutFlag
DerivErrCannotEtaReduceEnough{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrOnlyAnyClassDeriveable{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrNotDeriveable{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrNotAClass{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrNoConstructors{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrLangExtRequired{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrDunnoHowToDeriveForType{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrMustBeEnumType{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrMustHaveExactlyOneConstructor{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrMustHaveSomeParameters{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrMustNotHaveClassContext{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrBadConstructor{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrGenerics{} -> DiagnosticReason
ErrorWithoutFlag
DerivErrEnumOrProduct{} -> DiagnosticReason
ErrorWithoutFlag
TcRnMessage
TcRnLazyGADTPattern
-> DiagnosticReason
ErrorWithoutFlag
TcRnMessage
TcRnArrowProcGADTPattern
-> DiagnosticReason
ErrorWithoutFlag
TcRnSpecialClassInst {}
-> DiagnosticReason
ErrorWithoutFlag
TcRnForallIdentifier {}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnForallIdentifier
TcRnMessage
TcRnTypeEqualityOutOfScope
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTypeEqualityOutOfScope
TcRnMessage
TcRnTypeEqualityRequiresOperators
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTypeEqualityRequiresOperators
TcRnIllegalTypeOperator {}
-> DiagnosticReason
ErrorWithoutFlag
TcRnGADTMonoLocalBinds {}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnGADTMonoLocalBinds
TcRnIncorrectNameSpace {}
-> DiagnosticReason
ErrorWithoutFlag
TcRnNotInScope {}
-> DiagnosticReason
ErrorWithoutFlag
TcRnUntickedPromotedThing {}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUntickedPromotedConstructors
TcRnIllegalBuiltinSyntax {}
-> DiagnosticReason
ErrorWithoutFlag
TcRnWarnDefaulting {}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTypeDefaults
TcRnForeignImportPrimExtNotSet{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnForeignImportPrimSafeAnn{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnForeignFunctionImportAsValue{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnFunPtrImportWithoutAmpersand{}
-> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyForeignImports
TcRnIllegalForeignDeclBackend{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnUnsupportedCallConv Either ForeignExport ForeignImport
_ UnsupportedCallConvention
unsupportedCC
-> case UnsupportedCallConvention
unsupportedCC of
UnsupportedCallConvention
StdCallConvUnsupported -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnsupportedCallingConventions
UnsupportedCallConvention
_ -> DiagnosticReason
ErrorWithoutFlag
TcRnIllegalForeignType{}
-> DiagnosticReason
ErrorWithoutFlag
TcRnInvalidCIdentifier{}
-> DiagnosticReason
ErrorWithoutFlag
diagnosticHints :: TcRnMessage -> [GhcHint]
diagnosticHints = \case
TcRnUnknownMessage a
m
-> a -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints a
m
TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
-> case TcRnMessageDetailed
msg_with_info of
TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> TcRnMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
m
TcRnSolverReport [SolverReportWithCtxt]
_ DiagnosticReason
_ [GhcHint]
hints
-> [GhcHint]
hints
TcRnRedundantConstraints{}
-> [GhcHint]
noHints
TcRnInaccessibleCode{}
-> [GhcHint]
noHints
TcRnTypeDoesNotHaveFixedRuntimeRep{}
-> [GhcHint]
noHints
TcRnImplicitLift{}
-> [GhcHint]
noHints
TcRnUnusedPatternBinds{}
-> [GhcHint]
noHints
TcRnDodgyImports{}
-> [GhcHint]
noHints
TcRnDodgyExports{}
-> [GhcHint]
noHints
TcRnMissingImportList{}
-> [GhcHint]
noHints
TcRnUnsafeDueToPlugin{}
-> [GhcHint]
noHints
TcRnModMissingRealSrcSpan{}
-> [GhcHint]
noHints
TcRnIdNotExportedFromModuleSig Name
name Module
mod
-> [Name -> Maybe Module -> GhcHint
SuggestAddToHSigExportList Name
name (Maybe Module -> GhcHint) -> Maybe Module -> GhcHint
forall a b. (a -> b) -> a -> b
$ Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod]
TcRnIdNotExportedFromLocalSig Name
name
-> [Name -> Maybe Module -> GhcHint
SuggestAddToHSigExportList Name
name Maybe Module
forall a. Maybe a
Nothing]
TcRnShadowedName{}
-> [GhcHint]
noHints
TcRnDuplicateWarningDecls{}
-> [GhcHint]
noHints
TcRnSimplifierTooManyIterations{}
-> [GhcHint
SuggestIncreaseSimplifierIterations]
TcRnIllegalPatSynDecl{}
-> [GhcHint]
noHints
TcRnLinearPatSyn{}
-> [GhcHint]
noHints
TcRnEmptyRecordUpdate{}
-> [GhcHint]
noHints
TcRnIllegalFieldPunning{}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.NamedFieldPuns]
TcRnIllegalWildcardsInRecord{}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.RecordWildCards]
TcRnIllegalWildcardInType{}
-> [GhcHint]
noHints
TcRnDuplicateFieldName{}
-> [GhcHint]
noHints
TcRnIllegalViewPattern{}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.ViewPatterns]
TcRnCharLiteralOutOfRange{}
-> [GhcHint]
noHints
TcRnIllegalWildcardsInConstructor{}
-> [GhcHint]
noHints
TcRnIgnoringAnnotations{}
-> [GhcHint]
noHints
TcRnMessage
TcRnAnnotationInSafeHaskell
-> [GhcHint]
noHints
TcRnInvalidTypeApplication{}
-> [GhcHint]
noHints
TcRnMessage
TcRnTagToEnumMissingValArg
-> [GhcHint]
noHints
TcRnTagToEnumUnspecifiedResTy{}
-> [GhcHint]
noHints
TcRnTagToEnumResTyNotAnEnum{}
-> [GhcHint]
noHints
TcRnMessage
TcRnArrowIfThenElsePredDependsOnResultTy
-> [GhcHint]
noHints
TcRnMessage
TcRnIllegalHsBootFileDecl
-> [GhcHint]
noHints
TcRnRecursivePatternSynonym{}
-> [GhcHint]
noHints
TcRnPartialTypeSigTyVarMismatch{}
-> [GhcHint]
noHints
TcRnPartialTypeSigBadQuantifier{}
-> [GhcHint]
noHints
TcRnMissingSignature {}
-> [GhcHint]
noHints
TcRnPolymorphicBinderMissingSig{}
-> [GhcHint]
noHints
TcRnOverloadedSig{}
-> [GhcHint]
noHints
TcRnTupleConstraintInst{}
-> [GhcHint]
noHints
TcRnAbstractClassInst{}
-> [GhcHint]
noHints
TcRnNoClassInstHead{}
-> [GhcHint]
noHints
TcRnUserTypeError{}
-> [GhcHint]
noHints
TcRnConstraintInKind{}
-> [GhcHint]
noHints
TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
tuple_or_sum Type
_
-> [Extension -> GhcHint
suggestExtension (Extension -> GhcHint) -> Extension -> GhcHint
forall a b. (a -> b) -> a -> b
$ UnboxedTupleOrSum -> Extension
unboxedTupleOrSumExtension UnboxedTupleOrSum
tuple_or_sum]
TcRnLinearFuncInKind{}
-> [GhcHint]
noHints
TcRnForAllEscapeError{}
-> [GhcHint]
noHints
TcRnVDQInTermType{}
-> [GhcHint]
noHints
TcRnBadQuantPredHead{}
-> [GhcHint]
noHints
TcRnIllegalTupleConstraint{}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.ConstraintKinds]
TcRnNonTypeVarArgInConstraint{}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.FlexibleContexts]
TcRnIllegalImplicitParam{}
-> [GhcHint]
noHints
TcRnIllegalConstraintSynonymOfKind{}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.ConstraintKinds]
TcRnIllegalClassInst{}
-> [GhcHint]
noHints
TcRnOversaturatedVisibleKindArg{}
-> [GhcHint]
noHints
TcRnBadAssociatedType{}
-> [GhcHint]
noHints
TcRnForAllRankErr Rank
rank Type
_
-> case Rank
rank of
LimitedRank{} -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RankNTypes]
Rank
MonoTypeRankZero -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RankNTypes]
Rank
MonoTypeTyConArg -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ImpredicativeTypes]
Rank
MonoTypeSynArg -> [Extension -> GhcHint
suggestExtension Extension
LangExt.LiberalTypeSynonyms]
Rank
MonoTypeConstraint -> [Extension -> GhcHint
suggestExtension Extension
LangExt.QuantifiedConstraints]
Rank
_ -> [GhcHint]
noHints
TcRnMonomorphicBindings [Name]
bindings
-> case [Name]
bindings of
[] -> [GhcHint]
noHints
(Name
x:[Name]
xs) -> [AvailableBindings -> GhcHint
SuggestAddTypeSignatures (AvailableBindings -> GhcHint) -> AvailableBindings -> GhcHint
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> AvailableBindings
NamedBindings (Name
x Name -> [Name] -> NonEmpty Name
forall a. a -> [a] -> NonEmpty a
NE.:| [Name]
xs)]
TcRnOrphanInstance{}
-> [GhcHint
SuggestFixOrphanInstance]
TcRnFunDepConflict{}
-> [GhcHint]
noHints
TcRnDupInstanceDecls{}
-> [GhcHint]
noHints
TcRnConflictingFamInstDecls{}
-> [GhcHint]
noHints
TcRnFamInstNotInjective InjectivityErrReason
rea TyCon
_ NonEmpty CoAxBranch
_
-> case InjectivityErrReason
rea of
InjErrRhsBareTyVar{} -> [GhcHint]
noHints
InjectivityErrReason
InjErrRhsCannotBeATypeFam -> [GhcHint]
noHints
InjectivityErrReason
InjErrRhsOverlap -> [GhcHint]
noHints
InjErrCannotInferFromRhs TyVarSet
_ HasKinds
_ SuggestUndecidableInstances
suggestUndInst
| SuggestUndecidableInstances
YesSuggestUndecidableInstaces <- SuggestUndecidableInstances
suggestUndInst
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.UndecidableInstances]
| Bool
otherwise
-> [GhcHint]
noHints
TcRnBangOnUnliftedType{}
-> [GhcHint]
noHints
TcRnMultipleDefaultDeclarations{}
-> [GhcHint]
noHints
TcRnBadDefaultType{}
-> [GhcHint]
noHints
TcRnPatSynBundledWithNonDataCon{}
-> [GhcHint]
noHints
TcRnPatSynBundledWithWrongType{}
-> [GhcHint]
noHints
TcRnDupeModuleExport{}
-> [GhcHint]
noHints
TcRnExportedModNotImported{}
-> [GhcHint]
noHints
TcRnNullExportedModule{}
-> [GhcHint]
noHints
TcRnMissingExportList{}
-> [GhcHint]
noHints
TcRnExportHiddenComponents{}
-> [GhcHint]
noHints
TcRnDuplicateExport{}
-> [GhcHint]
noHints
TcRnExportedParentChildMismatch{}
-> [GhcHint]
noHints
TcRnConflictingExports{}
-> [GhcHint]
noHints
TcRnAmbiguousField{}
-> [GhcHint]
noHints
TcRnMissingFields{}
-> [GhcHint]
noHints
TcRnFieldUpdateInvalidType{}
-> [GhcHint]
noHints
TcRnNoConstructorHasAllFields{}
-> [GhcHint]
noHints
TcRnMixedSelectors{}
-> [GhcHint]
noHints
TcRnMissingStrictFields{}
-> [GhcHint]
noHints
TcRnNoPossibleParentForFields{}
-> [GhcHint]
noHints
TcRnBadOverloadedRecordUpdate{}
-> [GhcHint]
noHints
TcRnStaticFormNotClosed{}
-> [GhcHint]
noHints
TcRnMessage
TcRnUselessTypeable
-> [GhcHint]
noHints
TcRnDerivingDefaults{}
-> [GhcHint
useDerivingStrategies]
TcRnNonUnaryTypeclassConstraint{}
-> [GhcHint]
noHints
TcRnPartialTypeSignatures SuggestPartialTypeSignatures
suggestParSig [Type]
_
-> case SuggestPartialTypeSignatures
suggestParSig of
SuggestPartialTypeSignatures
YesSuggestPartialTypeSignatures
-> let info :: SDoc
info = String -> SDoc
text String
"to use the inferred type"
in [SDoc -> Extension -> GhcHint
suggestExtensionWithInfo SDoc
info Extension
LangExt.PartialTypeSignatures]
SuggestPartialTypeSignatures
NoSuggestPartialTypeSignatures
-> [GhcHint]
noHints
TcRnCannotDeriveInstance Class
cls [Type]
_ Maybe (DerivStrategy GhcTc)
_ UsingGeneralizedNewtypeDeriving
newtype_deriving DeriveInstanceErrReason
rea
-> Class
-> UsingGeneralizedNewtypeDeriving
-> DeriveInstanceErrReason
-> [GhcHint]
deriveInstanceErrReasonHints Class
cls UsingGeneralizedNewtypeDeriving
newtype_deriving DeriveInstanceErrReason
rea
TcRnMessage
TcRnLazyGADTPattern
-> [GhcHint]
noHints
TcRnMessage
TcRnArrowProcGADTPattern
-> [GhcHint]
noHints
TcRnSpecialClassInst {}
-> [GhcHint]
noHints
TcRnForallIdentifier {}
-> [GhcHint
SuggestRenameForall]
TcRnMessage
TcRnTypeEqualityOutOfScope
-> [GhcHint]
noHints
TcRnMessage
TcRnTypeEqualityRequiresOperators
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeOperators]
TcRnIllegalTypeOperator {}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeOperators]
TcRnGADTMonoLocalBinds {}
-> [[Extension] -> GhcHint
suggestAnyExtension [Extension
LangExt.GADTs, Extension
LangExt.TypeFamilies]]
TcRnIncorrectNameSpace Name
nm Bool
is_th_use
| Bool
is_th_use
-> [NameSpace -> GhcHint
SuggestAppropriateTHTick (NameSpace -> GhcHint) -> NameSpace -> GhcHint
forall a b. (a -> b) -> a -> b
$ Name -> NameSpace
nameNameSpace Name
nm]
| Bool
otherwise
-> [GhcHint]
noHints
TcRnNotInScope NotInScopeError
err RdrName
_ [ImportError]
_ [GhcHint]
hints
-> NotInScopeError -> [GhcHint]
scopeErrorHints NotInScopeError
err [GhcHint] -> [GhcHint] -> [GhcHint]
forall a. [a] -> [a] -> [a]
++ [GhcHint]
hints
TcRnUntickedPromotedThing UntickedPromotedThing
thing
-> [UntickedPromotedThing -> GhcHint
SuggestAddTick UntickedPromotedThing
thing]
TcRnIllegalBuiltinSyntax {}
-> [GhcHint]
noHints
TcRnWarnDefaulting {}
-> [GhcHint]
noHints
TcRnForeignImportPrimExtNotSet{}
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.GHCForeignImportPrim]
TcRnForeignImportPrimSafeAnn{}
-> [GhcHint]
noHints
TcRnForeignFunctionImportAsValue{}
-> [GhcHint]
noHints
TcRnFunPtrImportWithoutAmpersand{}
-> [GhcHint]
noHints
TcRnIllegalForeignDeclBackend{}
-> [GhcHint]
noHints
TcRnUnsupportedCallConv{}
-> [GhcHint]
noHints
TcRnIllegalForeignType Maybe ArgOrResult
_ IllegalForeignTypeReason
reason
-> case IllegalForeignTypeReason
reason of
TypeCannotBeMarshaled Type
_ TypeCannotBeMarshaledReason
why
| NewtypeDataConNotInScope{} <- TypeCannotBeMarshaledReason
why -> [GhcHint
SuggestImportingDataCon]
| TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded <- TypeCannotBeMarshaledReason
why -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UnliftedFFITypes]
IllegalForeignTypeReason
_ -> [GhcHint]
noHints
TcRnInvalidCIdentifier{}
-> [GhcHint]
noHints
deriveInstanceErrReasonHints :: Class
-> UsingGeneralizedNewtypeDeriving
-> DeriveInstanceErrReason
-> [GhcHint]
deriveInstanceErrReasonHints :: Class
-> UsingGeneralizedNewtypeDeriving
-> DeriveInstanceErrReason
-> [GhcHint]
deriveInstanceErrReasonHints Class
cls UsingGeneralizedNewtypeDeriving
newtype_deriving = \case
DerivErrNotWellKinded TyCon
_ Type
_ Int
n_args_to_keep
| Class
cls Class -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
gen1ClassKey Bool -> Bool -> Bool
&& Int
n_args_to_keep Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.PolyKinds]
| Bool
otherwise
-> [GhcHint]
noHints
DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst -> [GhcHint]
noHints
DerivErrDerivingViaWrongKind{} -> [GhcHint]
noHints
DerivErrNoEtaReduce{} -> [GhcHint]
noHints
DeriveInstanceErrReason
DerivErrBootFileFound -> [GhcHint]
noHints
DerivErrDataConsNotAllInScope{} -> [GhcHint]
noHints
DeriveInstanceErrReason
DerivErrGNDUsedOnData -> [GhcHint]
noHints
DeriveInstanceErrReason
DerivErrNullaryClasses -> [GhcHint]
noHints
DeriveInstanceErrReason
DerivErrLastArgMustBeApp -> [GhcHint]
noHints
DerivErrNoFamilyInstance{} -> [GhcHint]
noHints
DerivErrNotStockDeriveable DeriveAnyClassEnabled
deriveAnyClassEnabled
| DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
| Bool
otherwise
-> [GhcHint]
noHints
DerivErrHasAssociatedDatatypes{}
-> [GhcHint]
noHints
DeriveInstanceErrReason
DerivErrNewtypeNonDeriveableClass
| UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
-> [GhcHint
useGND]
| Bool
otherwise
-> [GhcHint]
noHints
DerivErrCannotEtaReduceEnough{}
| UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
-> [GhcHint
useGND]
| Bool
otherwise
-> [GhcHint]
noHints
DerivErrOnlyAnyClassDeriveable TyCon
_ DeriveAnyClassEnabled
deriveAnyClassEnabled
| DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
| Bool
otherwise
-> [GhcHint]
noHints
DerivErrNotDeriveable DeriveAnyClassEnabled
deriveAnyClassEnabled
| DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
-> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
| Bool
otherwise
-> [GhcHint]
noHints
DerivErrNotAClass{}
-> [GhcHint]
noHints
DerivErrNoConstructors{}
-> let info :: SDoc
info = String -> SDoc
text String
"to enable deriving for empty data types"
in [SDoc -> Extension -> GhcHint
useExtensionInOrderTo SDoc
info Extension
LangExt.EmptyDataDeriving]
DerivErrLangExtRequired{}
-> [GhcHint]
noHints
DerivErrDunnoHowToDeriveForType{}
-> [GhcHint]
noHints
DerivErrMustBeEnumType TyCon
rep_tc
| UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving Bool -> Bool -> Bool
&& TyCon -> Bool
isNewTyCon TyCon
rep_tc
-> [GhcHint
useGND]
| Bool
otherwise
-> [GhcHint]
noHints
DerivErrMustHaveExactlyOneConstructor{}
-> [GhcHint]
noHints
DerivErrMustHaveSomeParameters{}
-> [GhcHint]
noHints
DerivErrMustNotHaveClassContext{}
-> [GhcHint]
noHints
DerivErrBadConstructor Maybe HasWildcard
wcard [DeriveInstanceBadConstructor]
_
-> case Maybe HasWildcard
wcard of
Maybe HasWildcard
Nothing -> [GhcHint]
noHints
Just HasWildcard
YesHasWildcard -> [GhcHint
SuggestFillInWildcardConstraint]
Just HasWildcard
NoHasWildcard -> [GhcHint
SuggestAddStandaloneDerivation]
DerivErrGenerics{}
-> [GhcHint]
noHints
DerivErrEnumOrProduct{}
-> [GhcHint]
noHints
messageWithInfoDiagnosticMessage :: UnitState
-> ErrInfo
-> DecoratedSDoc
-> DecoratedSDoc
messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo -> DecoratedSDoc -> DecoratedSDoc
messageWithInfoDiagnosticMessage UnitState
unit_state ErrInfo{SDoc
errInfoContext :: ErrInfo -> SDoc
errInfoSupplementary :: ErrInfo -> SDoc
errInfoContext :: SDoc
errInfoSupplementary :: SDoc
..} DecoratedSDoc
important =
let err_info' :: [SDoc]
err_info' = (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state) [SDoc
errInfoContext, SDoc
errInfoSupplementary]
in ((SDoc -> SDoc) -> DecoratedSDoc -> DecoratedSDoc
mapDecoratedSDoc (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state) DecoratedSDoc
important) DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
`unionDecoratedSDoc`
[SDoc] -> DecoratedSDoc
mkDecorated [SDoc]
err_info'
dodgy_msg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg :: forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg SDoc
kind a
tc b
ie
= [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc
kind SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"item"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
ie)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"suggests that",
SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"has (in-scope) constructors or class methods,",
String -> SDoc
text String
"but it has none" ]
dodgy_msg_insert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert :: forall (p :: Pass). IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert IdP (GhcPass p)
tc = XIEThingAll (GhcPass p)
-> LIEWrappedName (IdP (GhcPass p)) -> IE (GhcPass p)
forall pass.
XIEThingAll pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAll XIEThingAll (GhcPass p)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIEWrappedName (IdP (GhcPass p))
ii
where
ii :: LIEWrappedName (IdP (GhcPass p))
ii :: LIEWrappedName (IdP (GhcPass p))
ii = IEWrappedName (IdGhcP p)
-> LocatedAn AnnListItem (IEWrappedName (IdGhcP p))
forall a an. a -> LocatedAn an a
noLocA (LocatedN (IdGhcP p) -> IEWrappedName (IdGhcP p)
forall name. LocatedN name -> IEWrappedName name
IEName (LocatedN (IdGhcP p) -> IEWrappedName (IdGhcP p))
-> LocatedN (IdGhcP p) -> IEWrappedName (IdGhcP p)
forall a b. (a -> b) -> a -> b
$ IdGhcP p -> LocatedN (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
tc)
pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep Type
ty FixedRuntimeRepProvenance
prov =
let what :: SDoc
what = FixedRuntimeRepProvenance -> SDoc
pprFixedRuntimeRepProvenance FixedRuntimeRepProvenance
prov
in String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"does not have a fixed runtime representation:"
SDoc -> SDoc -> SDoc
$$ Type -> SDoc
format_frr_err Type
ty
format_frr_err :: Type
-> SDoc
format_frr_err :: Type -> SDoc
format_frr_err Type
ty
= (SDoc
bullet SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tidy_ty SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tidy_ki)
where
(TidyEnv
tidy_env, Type
tidy_ty) = TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType TidyEnv
emptyTidyEnv Type
ty
tidy_ki :: Type
tidy_ki = TidyEnv -> Type -> Type
tidyType TidyEnv
tidy_env ((() :: Constraint) => Type -> Type
Type -> Type
tcTypeKind Type
ty)
pprField :: (FieldLabelString, TcType) -> SDoc
pprField :: (FieldLabelString, Type) -> SDoc
pprField (FieldLabelString
f,Type
ty) = FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
f SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty
pprRecordFieldPart :: RecordFieldPart -> SDoc
pprRecordFieldPart :: RecordFieldPart -> SDoc
pprRecordFieldPart = \case
RecordFieldConstructor{} -> String -> SDoc
text String
"construction"
RecordFieldPattern{} -> String -> SDoc
text String
"pattern"
RecordFieldPart
RecordFieldUpdate -> String -> SDoc
text String
"update"
pprBindings :: [Name] -> SDoc
pprBindings :: [Name] -> SDoc
pprBindings = (Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (Name -> SDoc) -> Name -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr)
injectivityErrorHerald :: SDoc
injectivityErrorHerald :: SDoc
injectivityErrorHerald =
String -> SDoc
text String
"Type family equation violates the family's injectivity annotation."
formatExportItemError :: SDoc -> String -> SDoc
formatExportItemError :: SDoc -> String -> SDoc
formatExportItemError SDoc
exportedThing String
reason =
[SDoc] -> SDoc
hsep [ String -> SDoc
text String
"The export item"
, SDoc -> SDoc
quotes SDoc
exportedThing
, String -> SDoc
text String
reason ]
missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
missingSignatureWarningFlag (MissingTopLevelBindingSig {}) Exported
exported Bool
overridden
| Exported
IsExported <- Exported
exported
, Bool -> Bool
not Bool
overridden
= WarningFlag
Opt_WarnMissingExportedSignatures
| Bool
otherwise
= WarningFlag
Opt_WarnMissingSignatures
missingSignatureWarningFlag (MissingPatSynSig {}) Exported
exported Bool
overridden
| Exported
IsExported <- Exported
exported
, Bool -> Bool
not Bool
overridden
= WarningFlag
Opt_WarnMissingExportedPatternSynonymSignatures
| Bool
otherwise
= WarningFlag
Opt_WarnMissingPatternSynonymSignatures
missingSignatureWarningFlag (MissingTyConKindSig {}) Exported
_ Bool
_
= WarningFlag
Opt_WarnMissingKindSignatures
useDerivingStrategies :: GhcHint
useDerivingStrategies :: GhcHint
useDerivingStrategies =
SDoc -> Extension -> GhcHint
useExtensionInOrderTo (String -> SDoc
text String
"to pick a different strategy") Extension
LangExt.DerivingStrategies
useGND :: GhcHint
useGND :: GhcHint
useGND = let info :: SDoc
info = String -> SDoc
text String
"for GHC's" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"newtype-deriving extension"
in SDoc -> Extension -> GhcHint
suggestExtensionWithInfo SDoc
info Extension
LangExt.GeneralizedNewtypeDeriving
cannotMakeDerivedInstanceHerald :: Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald :: Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_args Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why =
if Bool
pprHerald
then [SDoc] -> SDoc
sep [(SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Can't make a derived instance of")
Int
2 (SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pred) SDoc -> SDoc -> SDoc
<+> SDoc
via_mechanism)
SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 SDoc
extra) SDoc -> SDoc -> SDoc
<> SDoc
colon,
Int -> SDoc -> SDoc
nest Int
2 SDoc
why]
else SDoc
why
where
strat_used :: Bool
strat_used = Maybe (DerivStrategy GhcTc) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (DerivStrategy GhcTc)
mb_strat
extra :: SDoc
extra | Bool -> Bool
not Bool
strat_used, (UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
YesGeneralizedNewtypeDeriving)
= String -> SDoc
text String
"(even with cunning GeneralizedNewtypeDeriving)"
| Bool
otherwise = SDoc
empty
pred :: Type
pred = Class -> [Type] -> Type
mkClassPred Class
cls [Type]
cls_args
via_mechanism :: SDoc
via_mechanism | Bool
strat_used
, Just DerivStrategy GhcTc
strat <- Maybe (DerivStrategy GhcTc)
mb_strat
= String -> SDoc
text String
"with the" SDoc -> SDoc -> SDoc
<+> (DerivStrategy GhcTc -> SDoc
forall a. DerivStrategy a -> SDoc
derivStrategyName DerivStrategy GhcTc
strat) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"strategy"
| Bool
otherwise
= SDoc
empty
badCon :: DataCon -> SDoc -> SDoc
badCon :: DataCon -> SDoc -> SDoc
badCon DataCon
con SDoc
msg = String -> SDoc
text String
"Constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con) SDoc -> SDoc -> SDoc
<+> SDoc
msg
derivErrDiagnosticMessage :: Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage :: Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald = \case
DerivErrNotWellKinded TyCon
tc Type
cls_kind Int
_
-> [SDoc] -> SDoc
sep [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Cannot derive well-kinded instance of form"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Class -> [Type] -> SDoc
pprClassPred Class
cls [Type]
cls_tys
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"...")))
Int
2 SDoc
empty
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"Class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"expects an argument of kind"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
cls_kind))
]
DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst
-> String -> SDoc
text String
"Generic instances can only be derived in"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"Safe Haskell using the stock strategy."
DerivErrDerivingViaWrongKind Type
cls_kind Type
via_ty Type
via_kind
-> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Cannot derive instance via" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
via_ty))
Int
2 (String -> SDoc
text String
"Class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"expects an argument of kind"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
cls_kind) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
','
SDoc -> SDoc -> SDoc
$+$ String -> SDoc
text String
"but" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
via_ty)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"has kind" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
via_kind))
DerivErrNoEtaReduce Type
inst_ty
-> [SDoc] -> SDoc
sep [String -> SDoc
text String
"Cannot eta-reduce to an instance of form",
Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"instance (...) =>"
SDoc -> SDoc -> SDoc
<+> Class -> [Type] -> SDoc
pprClassPred Class
cls ([Type]
cls_tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type
inst_ty]))]
DeriveInstanceErrReason
DerivErrBootFileFound
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(String -> SDoc
text String
"Cannot derive instances in hs-boot files"
SDoc -> SDoc -> SDoc
$+$ String -> SDoc
text String
"Write an instance declaration instead")
DerivErrDataConsNotAllInScope TyCon
tc
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"The data constructors of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"are not all in scope")
Int
2 (String -> SDoc
text String
"so you cannot derive an instance for it"))
DeriveInstanceErrReason
DerivErrGNDUsedOnData
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(String -> SDoc
text String
"GeneralizedNewtypeDeriving cannot be used on non-newtypes")
DeriveInstanceErrReason
DerivErrNullaryClasses
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(String -> SDoc
text String
"Cannot derive instances for nullary classes")
DeriveInstanceErrReason
DerivErrLastArgMustBeApp
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
( String -> SDoc
text String
"The last argument of the instance must be a"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"data or newtype application")
DerivErrNoFamilyInstance TyCon
tc [Type]
tc_args
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(String -> SDoc
text String
"No family instance for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> [Type] -> SDoc
pprTypeApp TyCon
tc [Type]
tc_args))
DerivErrNotStockDeriveable DeriveAnyClassEnabled
_
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not a stock derivable class (Eq, Show, etc.)")
DerivErrHasAssociatedDatatypes HasAssociatedDataFamInsts
hasAdfs AssociatedTyLastVarInKind
at_last_cls_tv_in_kinds AssociatedTyNotParamOverLastTyVar
at_without_last_cls_tv
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [ Bool -> SDoc -> SDoc
ppWhen (HasAssociatedDataFamInsts
hasAdfs HasAssociatedDataFamInsts -> HasAssociatedDataFamInsts -> Bool
forall a. Eq a => a -> a -> Bool
== HasAssociatedDataFamInsts
YesHasAdfs) SDoc
adfs_msg
, case AssociatedTyNotParamOverLastTyVar
at_without_last_cls_tv of
YesAssociatedTyNotParamOverLastTyVar TyCon
tc -> TyCon -> SDoc
at_without_last_cls_tv_msg TyCon
tc
AssociatedTyNotParamOverLastTyVar
NoAssociatedTyNotParamOverLastTyVar -> SDoc
empty
, case AssociatedTyLastVarInKind
at_last_cls_tv_in_kinds of
YesAssocTyLastVarInKind TyCon
tc -> TyCon -> SDoc
at_last_cls_tv_in_kinds_msg TyCon
tc
AssociatedTyLastVarInKind
NoAssocTyLastVarInKind -> SDoc
empty
]
where
adfs_msg :: SDoc
adfs_msg = String -> SDoc
text String
"the class has associated data types"
at_without_last_cls_tv_msg :: TyCon -> SDoc
at_without_last_cls_tv_msg TyCon
at_tc = SDoc -> Int -> SDoc -> SDoc
hang
(String -> SDoc
text String
"the associated type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not parameterized over the last type variable")
Int
2 (String -> SDoc
text String
"of the class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls))
at_last_cls_tv_in_kinds_msg :: TyCon -> SDoc
at_last_cls_tv_in_kinds_msg TyCon
at_tc = SDoc -> Int -> SDoc -> SDoc
hang
(String -> SDoc
text String
"the associated type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"contains the last type variable")
Int
2 (String -> SDoc
text String
"of the class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in a kind, which is not (yet) allowed")
DeriveInstanceErrReason
DerivErrNewtypeNonDeriveableClass
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald (DeriveAnyClassEnabled -> DeriveInstanceErrReason
DerivErrNotStockDeriveable DeriveAnyClassEnabled
NoDeriveAnyClassEnabled)
DerivErrCannotEtaReduceEnough Bool
eta_ok
-> let cant_derive_err :: SDoc
cant_derive_err = Bool -> SDoc -> SDoc
ppUnless Bool
eta_ok SDoc
eta_msg
eta_msg :: SDoc
eta_msg = String -> SDoc
text String
"cannot eta-reduce the representation type enough"
in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
SDoc
cant_derive_err
DerivErrOnlyAnyClassDeriveable TyCon
tc DeriveAnyClassEnabled
_
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is a type class,"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"and can only have a derived instance"
SDoc -> SDoc -> SDoc
$+$ String -> SDoc
text String
"if DeriveAnyClass is enabled")
DerivErrNotDeriveable DeriveAnyClassEnabled
_
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
empty
DerivErrNotAClass Type
predType
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
predType) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not a class")
DerivErrNoConstructors TyCon
rep_tc
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must have at least one data constructor")
DerivErrLangExtRequired Extension
ext
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(String -> SDoc
text String
"You need " SDoc -> SDoc -> SDoc
<> Extension -> SDoc
forall a. Outputable a => a -> SDoc
ppr Extension
ext
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"to derive an instance for this class")
DerivErrDunnoHowToDeriveForType Type
ty
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Don't know how to derive" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls))
Int
2 (String -> SDoc
text String
"for type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)))
DerivErrMustBeEnumType TyCon
rep_tc
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
([SDoc] -> SDoc
sep [ SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"must be an enumeration type"
, String -> SDoc
text String
"(an enumeration consists of one or more nullary, non-GADT constructors)" ])
DerivErrMustHaveExactlyOneConstructor TyCon
rep_tc
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must have precisely one constructor")
DerivErrMustHaveSomeParameters TyCon
rep_tc
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(String -> SDoc
text String
"Data type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must have some type parameters")
DerivErrMustNotHaveClassContext TyCon
rep_tc [Type]
bad_stupid_theta
-> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(String -> SDoc
text String
"Data type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must not have a class context:" SDoc -> SDoc -> SDoc
<+> [Type] -> SDoc
pprTheta [Type]
bad_stupid_theta)
DerivErrBadConstructor Maybe HasWildcard
_ [DeriveInstanceBadConstructor]
reasons
-> let why :: SDoc
why = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DeriveInstanceBadConstructor -> SDoc)
-> [DeriveInstanceBadConstructor] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map DeriveInstanceBadConstructor -> SDoc
renderReason [DeriveInstanceBadConstructor]
reasons
in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why
where
renderReason :: DeriveInstanceBadConstructor -> SDoc
renderReason = \case
DerivErrBadConExistential DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"must be truly polymorphic in the last argument of the data type"
DerivErrBadConCovariant DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"must not use the type variable in a function argument"
DerivErrBadConFunTypes DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"must not contain function types"
DerivErrBadConWrongArg DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"must use the type variable only as the last argument of a data type"
DerivErrBadConIsGADT DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"is a GADT"
DerivErrBadConHasExistentials DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"has existential type variables in its type"
DerivErrBadConHasConstraints DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"has constraints in its type"
DerivErrBadConHasHigherRankType DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"has a higher-rank type"
DerivErrGenerics [DeriveGenericsErrReason]
reasons
-> let why :: SDoc
why = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DeriveGenericsErrReason -> SDoc)
-> [DeriveGenericsErrReason] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map DeriveGenericsErrReason -> SDoc
renderReason [DeriveGenericsErrReason]
reasons
in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why
where
renderReason :: DeriveGenericsErrReason -> SDoc
renderReason = \case
DerivErrGenericsMustNotHaveDatatypeContext TyCon
tc_name
-> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc_name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must not have a datatype context"
DerivErrGenericsMustNotHaveExoticArgs DataCon
dc
-> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must not have exotic unlifted or polymorphic arguments"
DerivErrGenericsMustBeVanillaDataCon DataCon
dc
-> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must be a vanilla data constructor"
DerivErrGenericsMustHaveSomeTypeParams TyCon
rep_tc
-> String -> SDoc
text String
"Data type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"must have some type parameters"
DerivErrGenericsMustNotHaveExistentials DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"must not have existential arguments"
DerivErrGenericsWrongArgKind DataCon
con
-> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"applies a type to an argument involving the last parameter"
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"but the applied type is not of kind * -> *"
DerivErrEnumOrProduct DeriveInstanceErrReason
this DeriveInstanceErrReason
that
-> let ppr1 :: SDoc
ppr1 = Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
False DeriveInstanceErrReason
this
ppr2 :: SDoc
ppr2 = Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
False DeriveInstanceErrReason
that
in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
(SDoc
ppr1 SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
" or" SDoc -> SDoc -> SDoc
$$ SDoc
ppr2)
instance Outputable SolverReportErrCtxt where
ppr :: SolverReportErrCtxt -> SDoc
ppr (CEC { cec_binds :: SolverReportErrCtxt -> EvBindsVar
cec_binds = EvBindsVar
bvar
, cec_defer_type_errors :: SolverReportErrCtxt -> DiagnosticReason
cec_defer_type_errors = DiagnosticReason
dte
, cec_expr_holes :: SolverReportErrCtxt -> DiagnosticReason
cec_expr_holes = DiagnosticReason
eh
, cec_type_holes :: SolverReportErrCtxt -> DiagnosticReason
cec_type_holes = DiagnosticReason
th
, cec_out_of_scope_holes :: SolverReportErrCtxt -> DiagnosticReason
cec_out_of_scope_holes = DiagnosticReason
osh
, cec_warn_redundant :: SolverReportErrCtxt -> Bool
cec_warn_redundant = Bool
wr
, cec_expand_syns :: SolverReportErrCtxt -> Bool
cec_expand_syns = Bool
es
, cec_suppress :: SolverReportErrCtxt -> Bool
cec_suppress = Bool
sup })
= String -> SDoc
text String
"CEC" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat
[ String -> SDoc
text String
"cec_binds" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> EvBindsVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr EvBindsVar
bvar
, String -> SDoc
text String
"cec_defer_type_errors" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
dte
, String -> SDoc
text String
"cec_expr_holes" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
eh
, String -> SDoc
text String
"cec_type_holes" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
th
, String -> SDoc
text String
"cec_out_of_scope_holes" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
osh
, String -> SDoc
text String
"cec_warn_redundant" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
wr
, String -> SDoc
text String
"cec_expand_syns" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
es
, String -> SDoc
text String
"cec_suppress" SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
sup ])
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
pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (TcReportWithInfo TcSolverReportMsg
msg (TcSolverReportInfo
info :| [TcSolverReportInfo]
infos)) =
[SDoc] -> SDoc
vcat
( SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt TcSolverReportMsg
msg
SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
pprTcSolverReportInfo SolverReportErrCtxt
ctxt TcSolverReportInfo
info
SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (TcSolverReportInfo -> SDoc) -> [TcSolverReportInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SolverReportErrCtxt -> TcSolverReportInfo -> SDoc
pprTcSolverReportInfo SolverReportErrCtxt
ctxt) [TcSolverReportInfo]
infos )
pprTcSolverReportMsg SolverReportErrCtxt
_ (BadTelescope TyVarBndrs
telescope [TcTyVar]
skols) =
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"These kind and type variables:" SDoc -> SDoc -> SDoc
<+> TyVarBndrs -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVarBndrs
telescope SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"are out of dependency order. Perhaps try this ordering:")
Int
2 ([TcTyVar] -> SDoc
pprTyVars [TcTyVar]
sorted_tvs)
where
sorted_tvs :: [TcTyVar]
sorted_tvs = [TcTyVar] -> [TcTyVar]
scopedSort [TcTyVar]
skols
pprTcSolverReportMsg SolverReportErrCtxt
_ (UserTypeError Type
ty) =
Type -> SDoc
pprUserTypeErrorTy Type
ty
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (ReportHoleError Hole
hole HoleError
err) =
SolverReportErrCtxt -> Hole -> HoleError -> SDoc
pprHoleError SolverReportErrCtxt
ctxt Hole
hole HoleError
err
pprTcSolverReportMsg SolverReportErrCtxt
_ (CannotUnifyWithPolytype ErrorItem
item TcTyVar
tv1 Type
ty2) =
[SDoc] -> SDoc
vcat [ (if TcTyVar -> Bool
isSkolemTyVar TcTyVar
tv1
then String -> SDoc
text String
"Cannot equate type variable"
else String -> SDoc
text String
"Cannot instantiate unification variable")
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv1)
, SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"with a" SDoc -> SDoc -> SDoc
<+> SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"involving polytypes:") Int
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty2) ]
where
what :: SDoc
what = String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ TypeOrKind -> String
levelString (TypeOrKind -> String) -> TypeOrKind -> String
forall a b. (a -> b) -> a -> b
$
CtLoc -> Maybe TypeOrKind
ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel
pprTcSolverReportMsg SolverReportErrCtxt
_
(Mismatch { mismatch_ea :: TcSolverReportMsg -> Bool
mismatch_ea = Bool
add_ea
, mismatch_item :: TcSolverReportMsg -> ErrorItem
mismatch_item = ErrorItem
item
, mismatch_ty1 :: TcSolverReportMsg -> Type
mismatch_ty1 = Type
ty1
, mismatch_ty2 :: TcSolverReportMsg -> Type
mismatch_ty2 = Type
ty2 })
= CtOrigin -> SDoc -> SDoc
addArising (ErrorItem -> CtOrigin
errorItemOrigin ErrorItem
item) SDoc
msg
where
msg :: SDoc
msg
| (Type -> Bool
isLiftedRuntimeRep Type
ty1 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedRuntimeRep Type
ty2) Bool -> Bool -> Bool
||
(Type -> Bool
isLiftedRuntimeRep Type
ty2 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedRuntimeRep Type
ty1) Bool -> Bool -> Bool
||
(Type -> Bool
isLiftedLevity Type
ty1 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedLevity Type
ty2) Bool -> Bool -> Bool
||
(Type -> Bool
isLiftedLevity Type
ty2 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedLevity Type
ty1)
= String -> SDoc
text String
"Couldn't match a lifted type with an unlifted type"
| Type -> Bool
isAtomicTy Type
ty1 Bool -> Bool -> Bool
|| Type -> Bool
isAtomicTy Type
ty2
=
[SDoc] -> SDoc
sep [ String -> SDoc
text String
herald1 SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty1)
, Int -> SDoc -> SDoc
nest Int
padding (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
herald2 SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty2) ]
| Bool
otherwise
=
[SDoc] -> SDoc
vcat [ String -> SDoc
text String
herald1 SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty1
, Int -> SDoc -> SDoc
nest Int
padding (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
herald2 SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty2 ]
herald1 :: String
herald1 = [String] -> String
conc [ String
"Couldn't match"
, if Bool
is_repr then String
"representation of" else String
""
, if Bool
add_ea then String
"expected" else String
""
, String
what ]
herald2 :: String
herald2 = [String] -> String
conc [ String
"with"
, if Bool
is_repr then String
"that of" else String
""
, if