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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-orphans #-} -- instance Outputable GhcHint
module GHC.Types.Hint.Ppr (
perhapsAsPat
-- also, and more interesting: instance Outputable GhcHint
) where
import GHC.Prelude
import GHC.Parser.Errors.Basic
import GHC.Types.Hint
import GHC.Hs.Expr () -- instance Outputable
import GHC.Types.Id
import GHC.Unit.Types
import GHC.Utils.Outputable
import Data.List (intersperse)
import qualified Data.List.NonEmpty as NE
instance Outputable GhcHint where
ppr = \case
UnknownHint m
-> ppr m
SuggestExtension extHint
-> case extHint of
SuggestSingleExtension extraUserInfo ext ->
(text "Perhaps you intended to use" <+> ppr ext) $$ extraUserInfo
SuggestAnyExtension extraUserInfo exts ->
let header = text "Enable any of the following extensions:"
in header <+> hcat (intersperse (text ", ") (map ppr exts)) $$ extraUserInfo
SuggestExtensions extraUserInfo exts ->
let header = text "Enable all of the following extensions:"
in header <+> hcat (intersperse (text ", ") (map ppr exts)) $$ extraUserInfo
SuggestMissingDo
-> text "Possibly caused by a missing 'do'?"
SuggestLetInDo
-> text "Perhaps you need a 'let' in a 'do' block?"
$$ text "e.g. 'let x = 5' instead of 'x = 5'"
SuggestAddSignatureCabalFile pi_mod_name
-> text "Try adding" <+> quotes (ppr pi_mod_name)
<+> text "to the"
<+> quotes (text "signatures")
<+> text "field in your Cabal file."
SuggestSignatureInstantiations pi_mod_name suggestions
-> let suggested_instantiated_with =
hcat (punctuate comma $
[ ppr k <> text "=" <> ppr v
| InstantiationSuggestion k v <- suggestions
])
in text "Try passing -instantiated-with=\"" <>
suggested_instantiated_with <> text "\"" $$
text "replacing <" <> ppr pi_mod_name <> text "> as necessary."
SuggestUseSpaces
-> text "Please use spaces instead."
SuggestUseWhitespaceAfter sym
-> text "Add whitespace after the"
<+> quotes (pprOperatorWhitespaceSymbol sym) <> char '.'
SuggestUseWhitespaceAround sym _occurrence
-> text "Add whitespace around" <+> quotes (text sym) <> char '.'
SuggestParentheses
-> text "Use parentheses."
SuggestIncreaseMaxPmCheckModels
-> text "Increase the limit or resolve the warnings to suppress this message."
SuggestAddTypeSignatures bindings
-> case bindings of
-- This might happen when we have bindings which are /too complicated/,
-- see for example 'DsCannotMixPolyAndUnliftedBindings' in 'GHC.HsToCore.Errors.Types'.
-- In this case, we emit a generic message.
UnnamedBinding -> text "Add a type signature."
NamedBindings (x NE.:| xs) ->
let nameList = case xs of
[] -> quotes . ppr $ x
_ -> pprWithCommas (quotes . ppr) xs <+> text "and" <+> quotes (ppr x)
in hsep [ text "Consider giving"
, nameList
, text "a type signature"]
SuggestBindToWildcard rhs
-> hang (text "Suppress this warning by saying") 2 (quotes $ text "_ <-" <+> ppr rhs)
SuggestAddInlineOrNoInlinePragma lhs_id rule_act
-> vcat [ text "Add an INLINE[n] or NOINLINE[n] pragma for" <+> quotes (ppr lhs_id)
, whenPprDebug (ppr (idInlineActivation lhs_id) $$ ppr rule_act)
]
SuggestAddPhaseToCompetingRule bad_rule
-> vcat [ text "Add phase [n] or [~n] to the competing rule"
, whenPprDebug (ppr bad_rule) ]
SuggestIncreaseSimplifierIterations
-> text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit"
SuggestUseTypeFromDataKind
-> text "Use" <+> quotes (text "Type")
<+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
SuggestQualifiedAfterModuleName
-> text "Place" <+> quotes (text "qualified")
<+> text "after the module name."
SuggestThQuotationSyntax
-> vcat [ text "Perhaps you intended to use quotation syntax of TemplateHaskell,"
, text "but the type variable or constructor is missing"
]
SuggestRoles nearby
-> case nearby of
[] -> empty
[r] -> text "Perhaps you meant" <+> quotes (ppr r)
-- will this last case ever happen??
_ -> hang (text "Perhaps you meant one of these:")
2 (pprWithCommas (quotes . ppr) nearby)
SuggestQualifyStarOperator
-> text "To use (or export) this operator in"
<+> text "modules with StarIsType,"
$$ text " including the definition module, you must qualify it."
SuggestTypeSignatureForm
-> text "A type signature should be of form <variables> :: <type>"
SuggestAddToHSigExportList _name mb_mod
-> let header = text "Try adding it to the export list of"
in case mb_mod of
Nothing -> header <+> text "the hsig file."
Just mod -> header <+> ppr (moduleName mod) <> text "'s hsig file."
SuggestFixOrphanInstance
-> vcat [ text "Move the instance declaration to the module of the class or of the type, or"
, text "wrap the type with a newtype and declare the instance on the new type."
]
perhapsAsPat :: SDoc
perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
|
