blob: 650befdd8f79445a124165bbbc81b7cadf8d0e0d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage
module GHC.Tc.Errors.Ppr (
) where
import GHC.Prelude
import GHC.Tc.Errors.Types
import GHC.Types.Error
import GHC.Driver.Flags
import GHC.Hs
import GHC.Utils.Outputable
instance Diagnostic TcRnMessage where
diagnosticMessage = \case
TcRnUnknownMessage m
-> diagnosticMessage m
TcRnImplicitLift id_or_name errInfo
-> mkDecorated [text "The variable" <+> quotes (ppr id_or_name) <+>
text "is implicitly lifted in the TH quotation"
, getErrInfo errInfo
]
TcRnUnusedPatternBinds bind
-> mkDecorated [hang (text "This pattern-binding binds no variables:") 2 (ppr bind)]
TcRnDodgyImports name
-> mkDecorated [dodgy_msg (text "import") name (dodgy_msg_insert name :: IE GhcPs)]
TcRnDodgyExports name
-> mkDecorated [dodgy_msg (text "export") name (dodgy_msg_insert name :: IE GhcRn)]
TcRnMissingImportList ie
-> mkDecorated [ text "The import item" <+> quotes (ppr ie) <+>
text "does not have an explicit import list"
]
diagnosticReason = \case
TcRnUnknownMessage m
-> diagnosticReason m
TcRnImplicitLift{}
-> WarningWithFlag Opt_WarnImplicitLift
TcRnUnusedPatternBinds{}
-> WarningWithFlag Opt_WarnUnusedPatternBinds
TcRnDodgyImports{}
-> WarningWithFlag Opt_WarnDodgyImports
TcRnDodgyExports{}
-> WarningWithFlag Opt_WarnDodgyExports
TcRnMissingImportList{}
-> WarningWithFlag Opt_WarnMissingImportList
diagnosticHints = \case
TcRnUnknownMessage m
-> diagnosticHints m
TcRnImplicitLift{}
-> noHints
TcRnUnusedPatternBinds{}
-> noHints
TcRnDodgyImports{}
-> noHints
TcRnDodgyExports{}
-> noHints
TcRnMissingImportList{}
-> noHints
dodgy_msg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg kind tc ie
= sep [ text "The" <+> kind <+> text "item"
<+> quotes (ppr ie)
<+> text "suggests that",
quotes (ppr tc) <+> text "has (in-scope) constructors or class methods,",
text "but it has none" ]
dodgy_msg_insert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert tc = IEThingAll noAnn ii
where
ii :: LIEWrappedName (IdP (GhcPass p))
ii = noLocA (IEName $ noLocA tc)
|
