never executed always true always false
1 {-# LANGUAGE ExistentialQuantification #-}
2
3 module GHC.Types.Hint (
4 GhcHint(..)
5 , AvailableBindings(..)
6 , InstantiationSuggestion(..)
7 , LanguageExtensionHint(..)
8 , suggestExtension
9 , suggestExtensionWithInfo
10 , suggestExtensions
11 , suggestExtensionsWithInfo
12 , suggestAnyExtension
13 , suggestAnyExtensionWithInfo
14 , useExtensionInOrderTo
15 ) where
16
17 import GHC.Prelude
18
19 import qualified Data.List.NonEmpty as NE
20
21 import GHC.Utils.Outputable
22 import qualified GHC.LanguageExtensions as LangExt
23 import Data.Typeable
24 import GHC.Unit.Module (ModuleName, Module)
25 import GHC.Hs.Extension (GhcTc)
26 import GHC.Core.Coercion
27 import GHC.Types.Name (Name)
28 import GHC.Types.Basic (Activation, RuleName)
29 import GHC.Parser.Errors.Basic
30 import {-# SOURCE #-} Language.Haskell.Syntax.Expr
31 -- This {-# SOURCE #-} import should be removable once
32 -- 'Language.Haskell.Syntax.Bind' no longer depends on 'GHC.Tc.Types.Evidence'.
33
34 -- | The bindings we have available in scope when
35 -- suggesting an explicit type signature.
36 data AvailableBindings
37 = NamedBindings (NE.NonEmpty Name)
38 | UnnamedBinding
39 -- ^ An unknown binding (i.e. too complicated to turn into a 'Name')
40
41 data LanguageExtensionHint
42 = -- | Suggest to enable the input extension. This is the hint that
43 -- GHC emits if this is not a \"known\" fix, i.e. this is GHC giving
44 -- its best guess on what extension might be necessary to make a
45 -- certain program compile. For example, GHC might suggests to
46 -- enable 'BlockArguments' when the user simply formatted incorrectly
47 -- the input program, so GHC here is trying to be as helpful as
48 -- possible.
49 -- If the input 'SDoc' is not empty, it will contain some extra
50 -- information about the why the extension is required, but
51 -- it's totally irrelevant/redundant for IDEs and other tools.
52 SuggestSingleExtension !SDoc !LangExt.Extension
53 -- | Suggest to enable the input extensions. The list
54 -- is to be intended as /disjuctive/ i.e. the user is
55 -- suggested to enable /any/ of the extensions listed. If
56 -- the input 'SDoc' is not empty, it will contain some extra
57 -- information about the why the extensions are required, but
58 -- it's totally irrelevant/redundant for IDEs and other tools.
59 | SuggestAnyExtension !SDoc [LangExt.Extension]
60 -- | Suggest to enable the input extensions. The list
61 -- is to be intended as /conjunctive/ i.e. the user is
62 -- suggested to enable /all/ the extensions listed. If
63 -- the input 'SDoc' is not empty, it will contain some extra
64 -- information about the why the extensions are required, but
65 -- it's totally irrelevant/redundant for IDEs and other tools.
66 | SuggestExtensions !SDoc [LangExt.Extension]
67 -- | Suggest to enable the input extension in order to fix
68 -- a certain problem. This is the suggestion that GHC emits when
69 -- is more-or-less clear \"what's going on\". For example, if
70 -- both 'DeriveAnyClass' and 'GeneralizedNewtypeDeriving' are
71 -- turned on, the right thing to do is to enabled 'DerivingStrategies',
72 -- so in contrast to 'SuggestSingleExtension' GHC will be a bit more
73 -- \"imperative\" (i.e. \"Use X Y Z in order to ... \").
74 -- If the input 'SDoc' is not empty, it will contain some extra
75 -- information about the why the extensions are required, but
76 -- it's totally irrelevant/redundant for IDEs and other tools.
77 | SuggestExtensionInOrderTo !SDoc !LangExt.Extension
78
79 -- | Suggests a single extension without extra user info.
80 suggestExtension :: LangExt.Extension -> GhcHint
81 suggestExtension ext = SuggestExtension (SuggestSingleExtension empty ext)
82
83 -- | Like 'suggestExtension' but allows supplying extra info for the user.
84 suggestExtensionWithInfo :: SDoc -> LangExt.Extension -> GhcHint
85 suggestExtensionWithInfo extraInfo ext = SuggestExtension (SuggestSingleExtension extraInfo ext)
86
87 -- | Suggests to enable /every/ extension in the list.
88 suggestExtensions :: [LangExt.Extension] -> GhcHint
89 suggestExtensions exts = SuggestExtension (SuggestExtensions empty exts)
90
91 -- | Like 'suggestExtensions' but allows supplying extra info for the user.
92 suggestExtensionsWithInfo :: SDoc -> [LangExt.Extension] -> GhcHint
93 suggestExtensionsWithInfo extraInfo exts = SuggestExtension (SuggestExtensions extraInfo exts)
94
95 -- | Suggests to enable /any/ extension in the list.
96 suggestAnyExtension :: [LangExt.Extension] -> GhcHint
97 suggestAnyExtension exts = SuggestExtension (SuggestAnyExtension empty exts)
98
99 -- | Like 'suggestAnyExtension' but allows supplying extra info for the user.
100 suggestAnyExtensionWithInfo :: SDoc -> [LangExt.Extension] -> GhcHint
101 suggestAnyExtensionWithInfo extraInfo exts = SuggestExtension (SuggestAnyExtension extraInfo exts)
102
103 useExtensionInOrderTo :: SDoc -> LangExt.Extension -> GhcHint
104 useExtensionInOrderTo extraInfo ext = SuggestExtension (SuggestExtensionInOrderTo extraInfo ext)
105
106 -- | A type for hints emitted by GHC.
107 -- A /hint/ suggests a possible way to deal with a particular warning or error.
108 data GhcHint
109 =
110 {-| An \"unknown\" hint. This type constructor allows arbitrary
111 -- hints to be embedded. The typical use case would be GHC plugins
112 -- willing to emit hints alongside their custom diagnostics.
113 -}
114 forall a. (Outputable a, Typeable a) => UnknownHint a
115 {-| Suggests adding a particular language extension. GHC will do its best trying
116 to guess when the user is using the syntax of a particular language extension
117 without having the relevant extension enabled.
118
119 Example: If the user uses the keyword \"mdo\" (and we are in a monadic block), but
120 the relevant extension is not enabled, GHC will emit a 'SuggestExtension RecursiveDo'.
121
122 Test case(s): parser/should_fail/T12429, parser/should_fail/T8501c,
123 parser/should_fail/T18251e, ... (and many more)
124
125 -}
126 | SuggestExtension !LanguageExtensionHint
127 {-| Suggests that a monadic code block is probably missing a \"do\" keyword.
128
129 Example:
130 main =
131 putStrLn "hello"
132 putStrLn "world"
133
134 Test case(s): parser/should_fail/T8501a, parser/should_fail/readFail007,
135 parser/should_fail/InfixAppPatErr, parser/should_fail/T984
136 -}
137 | SuggestMissingDo
138 {-| Suggests that a \"let\" expression is needed in a \"do\" block.
139
140 Test cases: None (that explicitly test this particular hint is emitted).
141 -}
142 | SuggestLetInDo
143 {-| Suggests to add an \".hsig\" signature file to the Cabal manifest.
144
145 Triggered by: 'GHC.Driver.Errors.Types.DriverUnexpectedSignature', if Cabal
146 is being used.
147
148 Example: See comment of 'DriverUnexpectedSignature'.
149
150 Test case(s): driver/T12955
151
152 -}
153 | SuggestAddSignatureCabalFile !ModuleName
154 {-| Suggests to explicitly list the instantiations for the signatures in
155 the GHC invocation command.
156
157 Triggered by: 'GHC.Driver.Errors.Types.DriverUnexpectedSignature', if Cabal
158 is /not/ being used.
159
160 Example: See comment of 'DriverUnexpectedSignature'.
161
162 Test case(s): driver/T12955
163 -}
164 | SuggestSignatureInstantiations !ModuleName [InstantiationSuggestion]
165 {-| Suggests to use spaces instead of tabs.
166
167 Triggered by: 'GHC.Parser.Errors.Types.PsWarnTab'.
168
169 Examples: None
170 Test Case(s): None
171 -}
172 | SuggestUseSpaces
173 {-| Suggests adding a whitespace after the given symbol.
174
175 Examples: None
176 Test Case(s): parser/should_compile/T18834a.hs
177 -}
178 | SuggestUseWhitespaceAfter !OperatorWhitespaceSymbol
179 {-| Suggests adding a whitespace around the given operator symbol,
180 as it might be repurposed as special syntax by a future language extension.
181 The second parameter is how such operator occurred, if in a prefix, suffix
182 or tight infix position.
183
184 Triggered by: 'GHC.Parser.Errors.Types.PsWarnOperatorWhitespace'.
185
186 Example:
187 h a b = a+b -- not OK, no spaces around '+'.
188
189 Test Case(s): parser/should_compile/T18834b.hs
190 -}
191 | SuggestUseWhitespaceAround !String !OperatorWhitespaceOccurrence
192 {-| Suggests wrapping an expression in parentheses
193
194 Examples: None
195 Test Case(s): None
196 -}
197 | SuggestParentheses
198 {-| Suggests to increase the -fmax-pmcheck-models limit for the pattern match checker.
199
200 Triggered by: 'GHC.HsToCore.Errors.Types.DsMaxPmCheckModelsReached'
201
202 Test case(s): pmcheck/should_compile/TooManyDeltas
203 pmcheck/should_compile/TooManyDeltas
204 pmcheck/should_compile/T11822
205 -}
206 | SuggestIncreaseMaxPmCheckModels
207 {-| Suggests adding a type signature, typically to resolve ambiguity or help GHC inferring types.
208
209 -}
210 | SuggestAddTypeSignatures AvailableBindings
211 {-| Suggests to explicitly discard the result of a monadic action by binding the result to
212 the '_' wilcard.
213
214 Example:
215 main = do
216 _ <- getCurrentTime
217
218 -}
219 | SuggestBindToWildcard !(LHsExpr GhcTc)
220
221 | SuggestAddInlineOrNoInlinePragma !Var !Activation
222
223 | SuggestAddPhaseToCompetingRule !RuleName
224 {-| Suggests adding an identifier to the export list of a signature.
225 -}
226 | SuggestAddToHSigExportList !Name !(Maybe Module)
227 {-| Suggests increasing the limit for the number of iterations in the simplifier.
228
229 -}
230 | SuggestIncreaseSimplifierIterations
231 {-| Suggests to explicitly import 'Type' from the 'Data.Kind' module, because
232 using "*" to mean 'Data.Kind.Type' relies on the StarIsType extension, which
233 will become deprecated in the future.
234
235 Triggered by: 'GHC.Parser.Errors.Types.PsWarnStarIsType'
236 Example: None
237 Test case(s): wcompat-warnings/WCompatWarningsOn.hs
238
239 -}
240 | SuggestUseTypeFromDataKind
241
242 {-| Suggests placing the 'qualified' keyword /after/ the module name.
243
244 Triggered by: 'GHC.Parser.Errors.Types.PsWarnImportPreQualified'
245 Example: None
246 Test case(s): module/mod184.hs
247
248 -}
249 | SuggestQualifiedAfterModuleName
250
251 {-| Suggests using TemplateHaskell quotation syntax.
252
253 Triggered by: 'GHC.Parser.Errors.Types.PsErrEmptyDoubleQuotes' only if TemplateHaskell
254 is enabled.
255 Example: None
256 Test case(s): parser/should_fail/T13450TH.hs
257
258 -}
259 | SuggestThQuotationSyntax
260
261 {-| Suggests alternative roles in case we found an illegal one.
262
263 Triggered by: 'GHC.Parser.Errors.Types.PsErrIllegalRoleName'
264 Example: None
265 Test case(s): roles/should_fail/Roles7.hs
266
267 -}
268 | SuggestRoles [Role]
269
270 {-| Suggests qualifying the '*' operator in modules where StarIsType is enabled.
271
272 Triggered by: 'GHC.Parser.Errors.Types.PsWarnStarBinder'
273 Test case(s): warnings/should_compile/StarBinder.hs
274 -}
275 | SuggestQualifyStarOperator
276
277 {-| Suggests that a type signature should have form <variable> :: <type>
278 in order to be accepted by GHC.
279
280 Triggered by: 'GHC.Parser.Errors.Types.PsErrInvalidTypeSignature'
281 Test case(s): parser/should_fail/T3811
282 -}
283 | SuggestTypeSignatureForm
284
285 {-| Suggests to move an orphan instance or to newtype-wrap it.
286
287 Triggered by: 'GHC.Tc.Errors.Types.TcRnOrphanInstance'
288 Test cases(s): warnings/should_compile/T9178
289 typecheck/should_compile/T4912
290 -}
291 | SuggestFixOrphanInstance
292
293 {-| Suggests to use a standalone deriving declaration when GHC
294 can't derive a typeclass instance in a trivial way.
295
296 Triggered by: 'GHC.Tc.Errors.Types.DerivBadErrConstructor'
297 Test cases(s): typecheck/should_fail/tcfail086
298 -}
299 | SuggestAddStandaloneDerivation
300
301 {-| Suggests the user to fill in the wildcard constraint to
302 disambiguate which constraint that is.
303
304 Example:
305 deriving instance _ => Eq (Foo f a)
306
307 Triggered by: 'GHC.Tc.Errors.Types.DerivBadErrConstructor'
308 Test cases(s): partial-sigs/should_fail/T13324_fail2
309 -}
310 | SuggestFillInWildcardConstraint
311
312 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
313 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
314 -- to instantiate a particular signature, where the first argument is
315 -- the signature name and the second is the module where the signature
316 -- was defined.
317 -- Example:
318 --
319 -- src/MyStr.hsig:2:11: error:
320 -- Unexpected signature: ‘MyStr’
321 -- (Try passing -instantiated-with="MyStr=<MyStr>"
322 -- replacing <MyStr> as necessary.)
323 data InstantiationSuggestion = InstantiationSuggestion !ModuleName !Module