never executed always true always false
1 module GHC.Driver.Flags
2 ( DumpFlag(..)
3 , GeneralFlag(..)
4 , Language(..)
5 , optimisationFlags
6
7 -- * Warnings
8 , WarningFlag(..)
9 , warnFlagNames
10 , warningGroups
11 , warningHierarchies
12 , smallestWarningGroups
13 , standardWarnings
14 , minusWOpts
15 , minusWallOpts
16 , minusWeverythingOpts
17 , minusWcompatOpts
18 , unusedBindsFlags
19 )
20 where
21
22 import GHC.Prelude
23 import GHC.Utils.Outputable
24 import GHC.Data.EnumSet as EnumSet
25
26 import Control.Monad (guard)
27 import Data.List.NonEmpty (NonEmpty(..))
28 import Data.Maybe (fromMaybe,mapMaybe)
29
30
31 data Language = Haskell98 | Haskell2010 | GHC2021
32 deriving (Eq, Enum, Show, Bounded)
33
34 instance Outputable Language where
35 ppr = text . show
36
37 -- | Debugging flags
38 data DumpFlag
39 -- See Note [Updating flag description in the User's Guide]
40
41 -- debugging flags
42 = Opt_D_dump_cmm
43 | Opt_D_dump_cmm_from_stg
44 | Opt_D_dump_cmm_raw
45 | Opt_D_dump_cmm_verbose_by_proc
46 -- All of the cmm subflags (there are a lot!) automatically
47 -- enabled if you run -ddump-cmm-verbose-by-proc
48 -- Each flag corresponds to exact stage of Cmm pipeline.
49 | Opt_D_dump_cmm_verbose
50 -- same as -ddump-cmm-verbose-by-proc but writes each stage
51 -- to a separate file (if used with -ddump-to-file)
52 | Opt_D_dump_cmm_cfg
53 | Opt_D_dump_cmm_cbe
54 | Opt_D_dump_cmm_switch
55 | Opt_D_dump_cmm_proc
56 | Opt_D_dump_cmm_sp
57 | Opt_D_dump_cmm_sink
58 | Opt_D_dump_cmm_caf
59 | Opt_D_dump_cmm_procmap
60 | Opt_D_dump_cmm_split
61 | Opt_D_dump_cmm_info
62 | Opt_D_dump_cmm_cps
63 -- end cmm subflags
64 | Opt_D_dump_cfg_weights -- ^ Dump the cfg used for block layout.
65 | Opt_D_dump_asm
66 | Opt_D_dump_asm_native
67 | Opt_D_dump_asm_liveness
68 | Opt_D_dump_asm_regalloc
69 | Opt_D_dump_asm_regalloc_stages
70 | Opt_D_dump_asm_conflicts
71 | Opt_D_dump_asm_stats
72 | Opt_D_dump_asm_expanded
73 | Opt_D_dump_c_backend
74 | Opt_D_dump_llvm
75 | Opt_D_dump_core_stats
76 | Opt_D_dump_deriv
77 | Opt_D_dump_ds
78 | Opt_D_dump_ds_preopt
79 | Opt_D_dump_foreign
80 | Opt_D_dump_inlinings
81 | Opt_D_dump_verbose_inlinings
82 | Opt_D_dump_rule_firings
83 | Opt_D_dump_rule_rewrites
84 | Opt_D_dump_simpl_trace
85 | Opt_D_dump_occur_anal
86 | Opt_D_dump_parsed
87 | Opt_D_dump_parsed_ast
88 | Opt_D_dump_rn
89 | Opt_D_dump_rn_ast
90 | Opt_D_dump_simpl
91 | Opt_D_dump_simpl_iterations
92 | Opt_D_dump_spec
93 | Opt_D_dump_prep
94 | Opt_D_dump_stg_from_core -- ^ Initial STG (CoreToStg output)
95 | Opt_D_dump_stg_unarised -- ^ STG after unarise
96 | Opt_D_dump_stg_final -- ^ Final STG (after stg2stg)
97 | Opt_D_dump_call_arity
98 | Opt_D_dump_exitify
99 | Opt_D_dump_stranal
100 | Opt_D_dump_str_signatures
101 | Opt_D_dump_cpranal
102 | Opt_D_dump_cpr_signatures
103 | Opt_D_dump_tc
104 | Opt_D_dump_tc_ast
105 | Opt_D_dump_hie
106 | Opt_D_dump_types
107 | Opt_D_dump_rules
108 | Opt_D_dump_cse
109 | Opt_D_dump_worker_wrapper
110 | Opt_D_dump_rn_trace
111 | Opt_D_dump_rn_stats
112 | Opt_D_dump_opt_cmm
113 | Opt_D_dump_simpl_stats
114 | Opt_D_dump_cs_trace -- Constraint solver in type checker
115 | Opt_D_dump_tc_trace
116 | Opt_D_dump_ec_trace -- Pattern match exhaustiveness checker
117 | Opt_D_dump_if_trace
118 | Opt_D_dump_splices
119 | Opt_D_th_dec_file
120 | Opt_D_dump_BCOs
121 | Opt_D_dump_ticked
122 | Opt_D_dump_rtti
123 | Opt_D_source_stats
124 | Opt_D_verbose_stg2stg
125 | Opt_D_dump_hi
126 | Opt_D_dump_hi_diffs
127 | Opt_D_dump_mod_cycles
128 | Opt_D_dump_mod_map
129 | Opt_D_dump_timings
130 | Opt_D_dump_view_pattern_commoning
131 | Opt_D_verbose_core2core
132 | Opt_D_dump_debug
133 | Opt_D_dump_json
134 | Opt_D_ppr_debug
135 | Opt_D_no_debug_output
136 | Opt_D_dump_faststrings
137 | Opt_D_faststring_stats
138 deriving (Eq, Show, Enum)
139
140 -- | Enumerates the simple on-or-off dynamic flags
141 data GeneralFlag
142 -- See Note [Updating flag description in the User's Guide]
143
144 = Opt_DumpToFile -- ^ Append dump output to files instead of stdout.
145 | Opt_D_dump_minimal_imports
146 | Opt_DoCoreLinting
147 | Opt_DoLinearCoreLinting
148 | Opt_DoStgLinting
149 | Opt_DoCmmLinting
150 | Opt_DoAsmLinting
151 | Opt_DoAnnotationLinting
152 | Opt_NoLlvmMangler -- hidden flag
153 | Opt_FastLlvm -- hidden flag
154 | Opt_NoTypeableBinds
155
156 | Opt_DistinctConstructorTables
157 | Opt_InfoTableMap
158
159 | Opt_WarnIsError -- -Werror; makes warnings fatal
160 | Opt_ShowWarnGroups -- Show the group a warning belongs to
161 | Opt_HideSourcePaths -- Hide module source/object paths
162
163 | Opt_PrintExplicitForalls
164 | Opt_PrintExplicitKinds
165 | Opt_PrintExplicitCoercions
166 | Opt_PrintExplicitRuntimeReps
167 | Opt_PrintEqualityRelations
168 | Opt_PrintAxiomIncomps
169 | Opt_PrintUnicodeSyntax
170 | Opt_PrintExpandedSynonyms
171 | Opt_PrintPotentialInstances
172 | Opt_PrintTypecheckerElaboration
173
174 -- optimisation opts
175 | Opt_CallArity
176 | Opt_Exitification
177 | Opt_Strictness
178 | Opt_LateDmdAnal -- #6087
179 | Opt_KillAbsence
180 | Opt_KillOneShot
181 | Opt_FullLaziness
182 | Opt_FloatIn
183 | Opt_LateSpecialise
184 | Opt_Specialise
185 | Opt_SpecialiseAggressively
186 | Opt_CrossModuleSpecialise
187 | Opt_InlineGenerics
188 | Opt_InlineGenericsAggressively
189 | Opt_StaticArgumentTransformation
190 | Opt_CSE
191 | Opt_StgCSE
192 | Opt_StgLiftLams
193 | Opt_LiberateCase
194 | Opt_SpecConstr
195 | Opt_SpecConstrKeen
196 | Opt_DoLambdaEtaExpansion
197 | Opt_IgnoreAsserts
198 | Opt_DoEtaReduction
199 | Opt_CaseMerge
200 | Opt_CaseFolding -- Constant folding through case-expressions
201 | Opt_UnboxStrictFields
202 | Opt_UnboxSmallStrictFields
203 | Opt_DictsCheap
204 | Opt_EnableRewriteRules -- Apply rewrite rules during simplification
205 | Opt_EnableThSpliceWarnings -- Enable warnings for TH splices
206 | Opt_RegsGraph -- do graph coloring register allocation
207 | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
208 | Opt_PedanticBottoms -- Be picky about how we treat bottom
209 | Opt_LlvmTBAA -- Use LLVM TBAA infrastructure for improving AA (hidden flag)
210 | Opt_LlvmFillUndefWithGarbage -- Testing for undef bugs (hidden flag)
211 | Opt_IrrefutableTuples
212 | Opt_CmmSink
213 | Opt_CmmStaticPred
214 | Opt_CmmElimCommonBlocks
215 | Opt_AsmShortcutting
216 | Opt_OmitYields
217 | Opt_FunToThunk -- allow GHC.Core.Opt.WorkWrap.Utils.mkWorkerArgs to remove all value lambdas
218 | Opt_DictsStrict -- be strict in argument dictionaries
219 | Opt_DmdTxDictSel -- ^ deprecated, no effect and behaviour is now default.
220 -- Allowed switching of a special demand transformer for dictionary selectors
221 | Opt_Loopification -- See Note [Self-recursive tail calls]
222 | Opt_CfgBlocklayout -- ^ Use the cfg based block layout algorithm.
223 | Opt_WeightlessBlocklayout -- ^ Layout based on last instruction per block.
224 | Opt_CprAnal
225 | Opt_WorkerWrapper
226 | Opt_SolveConstantDicts
227 | Opt_AlignmentSanitisation
228 | Opt_CatchBottoms
229 | Opt_NumConstantFolding
230
231 -- PreInlining is on by default. The option is there just to see how
232 -- bad things get if you turn it off!
233 | Opt_SimplPreInlining
234
235 -- Interface files
236 | Opt_IgnoreInterfacePragmas
237 | Opt_OmitInterfacePragmas
238 | Opt_ExposeAllUnfoldings
239 | Opt_WriteInterface -- forces .hi files to be written even with -fno-code
240 | Opt_WriteHie -- generate .hie files
241
242 -- profiling opts
243 | Opt_AutoSccsOnIndividualCafs
244 | Opt_ProfCountEntries
245
246 -- misc opts
247 | Opt_Pp
248 | Opt_ForceRecomp
249 | Opt_IgnoreOptimChanges
250 | Opt_IgnoreHpcChanges
251 | Opt_ExcessPrecision
252 | Opt_EagerBlackHoling
253 | Opt_NoHsMain
254 | Opt_SplitSections
255 | Opt_StgStats
256 | Opt_HideAllPackages
257 | Opt_HideAllPluginPackages
258 | Opt_PrintBindResult
259 | Opt_Haddock
260 | Opt_HaddockOptions
261 | Opt_BreakOnException
262 | Opt_BreakOnError
263 | Opt_PrintEvldWithShow
264 | Opt_PrintBindContents
265 | Opt_GenManifest
266 | Opt_EmbedManifest
267 | Opt_SharedImplib
268 | Opt_BuildingCabalPackage
269 | Opt_IgnoreDotGhci
270 | Opt_GhciSandbox
271 | Opt_GhciHistory
272 | Opt_GhciLeakCheck
273 | Opt_ValidateHie
274 | Opt_LocalGhciHistory
275 | Opt_NoIt
276 | Opt_HelpfulErrors
277 | Opt_DeferTypeErrors
278 | Opt_DeferTypedHoles
279 | Opt_DeferOutOfScopeVariables
280 | Opt_PIC -- ^ @-fPIC@
281 | Opt_PIE -- ^ @-fPIE@
282 | Opt_PICExecutable -- ^ @-pie@
283 | Opt_ExternalDynamicRefs
284 | Opt_Ticky
285 | Opt_Ticky_Allocd
286 | Opt_Ticky_LNE
287 | Opt_Ticky_Dyn_Thunk
288 | Opt_RPath
289 | Opt_RelativeDynlibPaths
290 | Opt_Hpc
291 | Opt_FamAppCache
292 | Opt_ExternalInterpreter
293 | Opt_OptimalApplicativeDo
294 | Opt_VersionMacros
295 | Opt_WholeArchiveHsLibs
296 -- copy all libs into a single folder prior to linking binaries
297 -- this should elivate the excessive command line limit restrictions
298 -- on windows, by only requiring a single -L argument instead of
299 -- one for each dependency. At the time of this writing, gcc
300 -- forwards all -L flags to the collect2 command without using a
301 -- response file and as such breaking apart.
302 | Opt_SingleLibFolder
303 | Opt_ExposeInternalSymbols
304 | Opt_KeepCAFs
305 | Opt_KeepGoing
306 | Opt_ByteCode
307 | Opt_LinkRts
308
309 -- output style opts
310 | Opt_ErrorSpans -- Include full span info in error messages,
311 -- instead of just the start position.
312 | Opt_DeferDiagnostics
313 | Opt_DiagnosticsShowCaret -- Show snippets of offending code
314 | Opt_PprCaseAsLet
315 | Opt_PprShowTicks
316 | Opt_ShowHoleConstraints
317 -- Options relating to the display of valid hole fits
318 -- when generating an error message for a typed hole
319 -- See Note [Valid hole fits include] in GHC.Tc.Errors.Hole
320 | Opt_ShowValidHoleFits
321 | Opt_SortValidHoleFits
322 | Opt_SortBySizeHoleFits
323 | Opt_SortBySubsumHoleFits
324 | Opt_AbstractRefHoleFits
325 | Opt_UnclutterValidHoleFits
326 | Opt_ShowTypeAppOfHoleFits
327 | Opt_ShowTypeAppVarsOfHoleFits
328 | Opt_ShowDocsOfHoleFits
329 | Opt_ShowTypeOfHoleFits
330 | Opt_ShowProvOfHoleFits
331 | Opt_ShowMatchesOfHoleFits
332
333 | Opt_ShowLoadedModules
334 | Opt_HexWordLiterals -- See Note [Print Hexadecimal Literals]
335
336 -- Suppress all coercions, them replacing with '...'
337 | Opt_SuppressCoercions
338 | Opt_SuppressVarKinds
339 -- Suppress module id prefixes on variables.
340 | Opt_SuppressModulePrefixes
341 -- Suppress type applications.
342 | Opt_SuppressTypeApplications
343 -- Suppress info such as arity and unfoldings on identifiers.
344 | Opt_SuppressIdInfo
345 -- Suppress separate type signatures in core, but leave types on
346 -- lambda bound vars
347 | Opt_SuppressUnfoldings
348 -- Suppress the details of even stable unfoldings
349 | Opt_SuppressTypeSignatures
350 -- Suppress unique ids on variables.
351 -- Except for uniques, as some simplifier phases introduce new
352 -- variables that have otherwise identical names.
353 | Opt_SuppressUniques
354 | Opt_SuppressStgExts
355 | Opt_SuppressTicks -- Replaces Opt_PprShowTicks
356 | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps
357 | Opt_SuppressCoreSizes -- ^ Suppress per binding Core size stats in dumps
358
359 -- temporary flags
360 | Opt_AutoLinkPackages
361 | Opt_ImplicitImportQualified
362
363 -- keeping stuff
364 | Opt_KeepHscppFiles
365 | Opt_KeepHiDiffs
366 | Opt_KeepHcFiles
367 | Opt_KeepSFiles
368 | Opt_KeepTmpFiles
369 | Opt_KeepRawTokenStream
370 | Opt_KeepLlvmFiles
371 | Opt_KeepHiFiles
372 | Opt_KeepOFiles
373
374 | Opt_BuildDynamicToo
375
376 -- safe haskell flags
377 | Opt_DistrustAllPackages
378 | Opt_PackageTrust
379 | Opt_PluginTrustworthy
380
381 | Opt_G_NoStateHack
382 | Opt_G_NoOptCoercion
383 deriving (Eq, Show, Enum)
384
385 -- Check whether a flag should be considered an "optimisation flag"
386 -- for purposes of recompilation avoidance (see
387 -- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is
388 -- not a guarantee that the flag has no other effect. We could, and
389 -- perhaps should, separate out the flags that have some minor impact on
390 -- program semantics and/or error behavior (e.g., assertions), but
391 -- then we'd need to go to extra trouble (and an additional flag)
392 -- to allow users to ignore the optimisation level even though that
393 -- means ignoring some change.
394 optimisationFlags :: EnumSet GeneralFlag
395 optimisationFlags = EnumSet.fromList
396 [ Opt_CallArity
397 , Opt_Strictness
398 , Opt_LateDmdAnal
399 , Opt_KillAbsence
400 , Opt_KillOneShot
401 , Opt_FullLaziness
402 , Opt_FloatIn
403 , Opt_LateSpecialise
404 , Opt_Specialise
405 , Opt_SpecialiseAggressively
406 , Opt_CrossModuleSpecialise
407 , Opt_StaticArgumentTransformation
408 , Opt_CSE
409 , Opt_StgCSE
410 , Opt_StgLiftLams
411 , Opt_LiberateCase
412 , Opt_SpecConstr
413 , Opt_SpecConstrKeen
414 , Opt_DoLambdaEtaExpansion
415 , Opt_IgnoreAsserts
416 , Opt_DoEtaReduction
417 , Opt_CaseMerge
418 , Opt_CaseFolding
419 , Opt_UnboxStrictFields
420 , Opt_UnboxSmallStrictFields
421 , Opt_DictsCheap
422 , Opt_EnableRewriteRules
423 , Opt_RegsGraph
424 , Opt_RegsIterative
425 , Opt_PedanticBottoms
426 , Opt_LlvmTBAA
427 , Opt_LlvmFillUndefWithGarbage
428 , Opt_IrrefutableTuples
429 , Opt_CmmSink
430 , Opt_CmmElimCommonBlocks
431 , Opt_AsmShortcutting
432 , Opt_OmitYields
433 , Opt_FunToThunk
434 , Opt_DictsStrict
435 , Opt_DmdTxDictSel
436 , Opt_Loopification
437 , Opt_CfgBlocklayout
438 , Opt_WeightlessBlocklayout
439 , Opt_CprAnal
440 , Opt_WorkerWrapper
441 , Opt_SolveConstantDicts
442 , Opt_CatchBottoms
443 , Opt_IgnoreAsserts
444 ]
445
446 data WarningFlag =
447 -- See Note [Updating flag description in the User's Guide]
448 Opt_WarnDuplicateExports
449 | Opt_WarnDuplicateConstraints
450 | Opt_WarnRedundantConstraints
451 | Opt_WarnHiShadows
452 | Opt_WarnImplicitPrelude
453 | Opt_WarnIncompletePatterns
454 | Opt_WarnIncompleteUniPatterns
455 | Opt_WarnIncompletePatternsRecUpd
456 | Opt_WarnOverflowedLiterals
457 | Opt_WarnEmptyEnumerations
458 | Opt_WarnMissingFields
459 | Opt_WarnMissingImportList
460 | Opt_WarnMissingMethods
461 | Opt_WarnMissingSignatures
462 | Opt_WarnMissingLocalSignatures
463 | Opt_WarnNameShadowing
464 | Opt_WarnOverlappingPatterns
465 | Opt_WarnTypeDefaults
466 | Opt_WarnMonomorphism
467 | Opt_WarnUnusedTopBinds
468 | Opt_WarnUnusedLocalBinds
469 | Opt_WarnUnusedPatternBinds
470 | Opt_WarnUnusedImports
471 | Opt_WarnUnusedMatches
472 | Opt_WarnUnusedTypePatterns
473 | Opt_WarnUnusedForalls
474 | Opt_WarnUnusedRecordWildcards
475 | Opt_WarnRedundantBangPatterns
476 | Opt_WarnRedundantRecordWildcards
477 | Opt_WarnWarningsDeprecations
478 | Opt_WarnDeprecatedFlags
479 | Opt_WarnMissingMonadFailInstances -- since 8.0, has no effect since 8.8
480 | Opt_WarnSemigroup -- since 8.0
481 | Opt_WarnDodgyExports
482 | Opt_WarnDodgyImports
483 | Opt_WarnOrphans
484 | Opt_WarnAutoOrphans
485 | Opt_WarnIdentities
486 | Opt_WarnTabs
487 | Opt_WarnUnrecognisedPragmas
488 | Opt_WarnDodgyForeignImports
489 | Opt_WarnUnusedDoBind
490 | Opt_WarnWrongDoBind
491 | Opt_WarnAlternativeLayoutRuleTransitional
492 | Opt_WarnUnsafe
493 | Opt_WarnSafe
494 | Opt_WarnTrustworthySafe
495 | Opt_WarnMissedSpecs
496 | Opt_WarnAllMissedSpecs
497 | Opt_WarnUnsupportedCallingConventions
498 | Opt_WarnUnsupportedLlvmVersion
499 | Opt_WarnMissedExtraSharedLib
500 | Opt_WarnInlineRuleShadowing
501 | Opt_WarnTypedHoles
502 | Opt_WarnPartialTypeSignatures
503 | Opt_WarnMissingExportedSignatures
504 | Opt_WarnUntickedPromotedConstructors
505 | Opt_WarnDerivingTypeable
506 | Opt_WarnDeferredTypeErrors
507 | Opt_WarnDeferredOutOfScopeVariables
508 | Opt_WarnNonCanonicalMonadInstances -- since 8.0
509 | Opt_WarnNonCanonicalMonadFailInstances -- since 8.0, removed 8.8
510 | Opt_WarnNonCanonicalMonoidInstances -- since 8.0
511 | Opt_WarnMissingPatternSynonymSignatures -- since 8.0
512 | Opt_WarnUnrecognisedWarningFlags -- since 8.0
513 | Opt_WarnSimplifiableClassConstraints -- Since 8.2
514 | Opt_WarnCPPUndef -- Since 8.2
515 | Opt_WarnUnbangedStrictPatterns -- Since 8.2
516 | Opt_WarnMissingHomeModules -- Since 8.2
517 | Opt_WarnPartialFields -- Since 8.4
518 | Opt_WarnMissingExportList
519 | Opt_WarnInaccessibleCode
520 | Opt_WarnStarIsType -- Since 8.6
521 | Opt_WarnStarBinder -- Since 8.6
522 | Opt_WarnImplicitKindVars -- Since 8.6
523 | Opt_WarnSpaceAfterBang
524 | Opt_WarnMissingDerivingStrategies -- Since 8.8
525 | Opt_WarnPrepositiveQualifiedModule -- Since 8.10
526 | Opt_WarnUnusedPackages -- Since 8.10
527 | Opt_WarnInferredSafeImports -- Since 8.10
528 | Opt_WarnMissingSafeHaskellMode -- Since 8.10
529 | Opt_WarnCompatUnqualifiedImports -- Since 8.10
530 | Opt_WarnDerivingDefaults
531 | Opt_WarnInvalidHaddock -- Since 9.0
532 | Opt_WarnOperatorWhitespaceExtConflict -- Since 9.2
533 | Opt_WarnOperatorWhitespace -- Since 9.2
534 | Opt_WarnAmbiguousFields -- Since 9.2
535 | Opt_WarnImplicitLift -- Since 9.2
536 | Opt_WarnMissingKindSignatures -- Since 9.2
537 | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2
538 | Opt_WarnRedundantStrictnessFlags -- Since 9.4
539 | Opt_WarnUnicodeBidirectionalFormatCharacters -- Since 9.0.2
540 deriving (Eq, Ord, Show, Enum)
541
542 -- | Return the names of a WarningFlag
543 --
544 -- One flag may have several names because of US/UK spelling. The first one is
545 -- the "preferred one" that will be displayed in warning messages.
546 warnFlagNames :: WarningFlag -> NonEmpty String
547 warnFlagNames wflag = case wflag of
548 Opt_WarnAlternativeLayoutRuleTransitional -> "alternative-layout-rule-transitional" :| []
549 Opt_WarnAmbiguousFields -> "ambiguous-fields" :| []
550 Opt_WarnAutoOrphans -> "auto-orphans" :| []
551 Opt_WarnCPPUndef -> "cpp-undef" :| []
552 Opt_WarnUnbangedStrictPatterns -> "unbanged-strict-patterns" :| []
553 Opt_WarnDeferredTypeErrors -> "deferred-type-errors" :| []
554 Opt_WarnDeferredOutOfScopeVariables -> "deferred-out-of-scope-variables" :| []
555 Opt_WarnWarningsDeprecations -> "deprecations" :| ["warnings-deprecations"]
556 Opt_WarnDeprecatedFlags -> "deprecated-flags" :| []
557 Opt_WarnDerivingDefaults -> "deriving-defaults" :| []
558 Opt_WarnDerivingTypeable -> "deriving-typeable" :| []
559 Opt_WarnDodgyExports -> "dodgy-exports" :| []
560 Opt_WarnDodgyForeignImports -> "dodgy-foreign-imports" :| []
561 Opt_WarnDodgyImports -> "dodgy-imports" :| []
562 Opt_WarnEmptyEnumerations -> "empty-enumerations" :| []
563 Opt_WarnDuplicateConstraints -> "duplicate-constraints" :| []
564 Opt_WarnRedundantConstraints -> "redundant-constraints" :| []
565 Opt_WarnDuplicateExports -> "duplicate-exports" :| []
566 Opt_WarnHiShadows -> "hi-shadowing" :| []
567 Opt_WarnInaccessibleCode -> "inaccessible-code" :| []
568 Opt_WarnImplicitPrelude -> "implicit-prelude" :| []
569 Opt_WarnImplicitKindVars -> "implicit-kind-vars" :| []
570 Opt_WarnIncompletePatterns -> "incomplete-patterns" :| []
571 Opt_WarnIncompletePatternsRecUpd -> "incomplete-record-updates" :| []
572 Opt_WarnIncompleteUniPatterns -> "incomplete-uni-patterns" :| []
573 Opt_WarnInlineRuleShadowing -> "inline-rule-shadowing" :| []
574 Opt_WarnIdentities -> "identities" :| []
575 Opt_WarnMissingFields -> "missing-fields" :| []
576 Opt_WarnMissingImportList -> "missing-import-lists" :| []
577 Opt_WarnMissingExportList -> "missing-export-lists" :| []
578 Opt_WarnMissingLocalSignatures -> "missing-local-signatures" :| []
579 Opt_WarnMissingMethods -> "missing-methods" :| []
580 Opt_WarnMissingMonadFailInstances -> "missing-monadfail-instances" :| []
581 Opt_WarnSemigroup -> "semigroup" :| []
582 Opt_WarnMissingSignatures -> "missing-signatures" :| []
583 Opt_WarnMissingKindSignatures -> "missing-kind-signatures" :| []
584 Opt_WarnMissingExportedSignatures -> "missing-exported-signatures" :| []
585 Opt_WarnMonomorphism -> "monomorphism-restriction" :| []
586 Opt_WarnNameShadowing -> "name-shadowing" :| []
587 Opt_WarnNonCanonicalMonadInstances -> "noncanonical-monad-instances" :| []
588 Opt_WarnNonCanonicalMonadFailInstances -> "noncanonical-monadfail-instances" :| []
589 Opt_WarnNonCanonicalMonoidInstances -> "noncanonical-monoid-instances" :| []
590 Opt_WarnOrphans -> "orphans" :| []
591 Opt_WarnOverflowedLiterals -> "overflowed-literals" :| []
592 Opt_WarnOverlappingPatterns -> "overlapping-patterns" :| []
593 Opt_WarnMissedSpecs -> "missed-specialisations" :| ["missed-specializations"]
594 Opt_WarnAllMissedSpecs -> "all-missed-specialisations" :| ["all-missed-specializations"]
595 Opt_WarnSafe -> "safe" :| []
596 Opt_WarnTrustworthySafe -> "trustworthy-safe" :| []
597 Opt_WarnInferredSafeImports -> "inferred-safe-imports" :| []
598 Opt_WarnMissingSafeHaskellMode -> "missing-safe-haskell-mode" :| []
599 Opt_WarnTabs -> "tabs" :| []
600 Opt_WarnTypeDefaults -> "type-defaults" :| []
601 Opt_WarnTypedHoles -> "typed-holes" :| []
602 Opt_WarnPartialTypeSignatures -> "partial-type-signatures" :| []
603 Opt_WarnUnrecognisedPragmas -> "unrecognised-pragmas" :| []
604 Opt_WarnUnsafe -> "unsafe" :| []
605 Opt_WarnUnsupportedCallingConventions -> "unsupported-calling-conventions" :| []
606 Opt_WarnUnsupportedLlvmVersion -> "unsupported-llvm-version" :| []
607 Opt_WarnMissedExtraSharedLib -> "missed-extra-shared-lib" :| []
608 Opt_WarnUntickedPromotedConstructors -> "unticked-promoted-constructors" :| []
609 Opt_WarnUnusedDoBind -> "unused-do-bind" :| []
610 Opt_WarnUnusedForalls -> "unused-foralls" :| []
611 Opt_WarnUnusedImports -> "unused-imports" :| []
612 Opt_WarnUnusedLocalBinds -> "unused-local-binds" :| []
613 Opt_WarnUnusedMatches -> "unused-matches" :| []
614 Opt_WarnUnusedPatternBinds -> "unused-pattern-binds" :| []
615 Opt_WarnUnusedTopBinds -> "unused-top-binds" :| []
616 Opt_WarnUnusedTypePatterns -> "unused-type-patterns" :| []
617 Opt_WarnUnusedRecordWildcards -> "unused-record-wildcards" :| []
618 Opt_WarnRedundantBangPatterns -> "redundant-bang-patterns" :| []
619 Opt_WarnRedundantRecordWildcards -> "redundant-record-wildcards" :| []
620 Opt_WarnRedundantStrictnessFlags -> "redundant-strictness-flags" :| []
621 Opt_WarnWrongDoBind -> "wrong-do-bind" :| []
622 Opt_WarnMissingPatternSynonymSignatures -> "missing-pattern-synonym-signatures" :| []
623 Opt_WarnMissingDerivingStrategies -> "missing-deriving-strategies" :| []
624 Opt_WarnSimplifiableClassConstraints -> "simplifiable-class-constraints" :| []
625 Opt_WarnMissingHomeModules -> "missing-home-modules" :| []
626 Opt_WarnUnrecognisedWarningFlags -> "unrecognised-warning-flags" :| []
627 Opt_WarnStarBinder -> "star-binder" :| []
628 Opt_WarnStarIsType -> "star-is-type" :| []
629 Opt_WarnSpaceAfterBang -> "missing-space-after-bang" :| []
630 Opt_WarnPartialFields -> "partial-fields" :| []
631 Opt_WarnPrepositiveQualifiedModule -> "prepositive-qualified-module" :| []
632 Opt_WarnUnusedPackages -> "unused-packages" :| []
633 Opt_WarnCompatUnqualifiedImports -> "compat-unqualified-imports" :| []
634 Opt_WarnInvalidHaddock -> "invalid-haddock" :| []
635 Opt_WarnOperatorWhitespaceExtConflict -> "operator-whitespace-ext-conflict" :| []
636 Opt_WarnOperatorWhitespace -> "operator-whitespace" :| []
637 Opt_WarnImplicitLift -> "implicit-lift" :| []
638 Opt_WarnMissingExportedPatternSynonymSignatures -> "missing-exported-pattern-synonym-signatures" :| []
639 Opt_WarnUnicodeBidirectionalFormatCharacters -> "unicode-bidirectional-format-characters" :| []
640
641 -- -----------------------------------------------------------------------------
642 -- Standard sets of warning options
643
644 -- Note [Documenting warning flags]
645 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
646 --
647 -- If you change the list of warning enabled by default
648 -- please remember to update the User's Guide. The relevant file is:
649 --
650 -- docs/users_guide/using-warnings.rst
651
652 -- | Warning groups.
653 --
654 -- As all warnings are in the Weverything set, it is ignored when
655 -- displaying to the user which group a warning is in.
656 warningGroups :: [(String, [WarningFlag])]
657 warningGroups =
658 [ ("compat", minusWcompatOpts)
659 , ("unused-binds", unusedBindsFlags)
660 , ("default", standardWarnings)
661 , ("extra", minusWOpts)
662 , ("all", minusWallOpts)
663 , ("everything", minusWeverythingOpts)
664 ]
665
666 -- | Warning group hierarchies, where there is an explicit inclusion
667 -- relation.
668 --
669 -- Each inner list is a hierarchy of warning groups, ordered from
670 -- smallest to largest, where each group is a superset of the one
671 -- before it.
672 --
673 -- Separating this from 'warningGroups' allows for multiple
674 -- hierarchies with no inherent relation to be defined.
675 --
676 -- The special-case Weverything group is not included.
677 warningHierarchies :: [[String]]
678 warningHierarchies = hierarchies ++ map (:[]) rest
679 where
680 hierarchies = [["default", "extra", "all"]]
681 rest = filter (`notElem` "everything" : concat hierarchies) $
682 map fst warningGroups
683
684 -- | Find the smallest group in every hierarchy which a warning
685 -- belongs to, excluding Weverything.
686 smallestWarningGroups :: WarningFlag -> [String]
687 smallestWarningGroups flag = mapMaybe go warningHierarchies where
688 -- Because each hierarchy is arranged from smallest to largest,
689 -- the first group we find in a hierarchy which contains the flag
690 -- is the smallest.
691 go (group:rest) = fromMaybe (go rest) $ do
692 flags <- lookup group warningGroups
693 guard (flag `elem` flags)
694 pure (Just group)
695 go [] = Nothing
696
697 -- | Warnings enabled unless specified otherwise
698 standardWarnings :: [WarningFlag]
699 standardWarnings -- see Note [Documenting warning flags]
700 = [ Opt_WarnOverlappingPatterns,
701 Opt_WarnWarningsDeprecations,
702 Opt_WarnDeprecatedFlags,
703 Opt_WarnDeferredTypeErrors,
704 Opt_WarnTypedHoles,
705 Opt_WarnDeferredOutOfScopeVariables,
706 Opt_WarnPartialTypeSignatures,
707 Opt_WarnUnrecognisedPragmas,
708 Opt_WarnDuplicateExports,
709 Opt_WarnDerivingDefaults,
710 Opt_WarnOverflowedLiterals,
711 Opt_WarnEmptyEnumerations,
712 Opt_WarnAmbiguousFields,
713 Opt_WarnMissingFields,
714 Opt_WarnMissingMethods,
715 Opt_WarnWrongDoBind,
716 Opt_WarnUnsupportedCallingConventions,
717 Opt_WarnDodgyForeignImports,
718 Opt_WarnInlineRuleShadowing,
719 Opt_WarnAlternativeLayoutRuleTransitional,
720 Opt_WarnUnsupportedLlvmVersion,
721 Opt_WarnMissedExtraSharedLib,
722 Opt_WarnTabs,
723 Opt_WarnUnrecognisedWarningFlags,
724 Opt_WarnSimplifiableClassConstraints,
725 Opt_WarnStarBinder,
726 Opt_WarnInaccessibleCode,
727 Opt_WarnSpaceAfterBang,
728 Opt_WarnNonCanonicalMonadInstances,
729 Opt_WarnNonCanonicalMonoidInstances,
730 Opt_WarnOperatorWhitespaceExtConflict,
731 Opt_WarnUnicodeBidirectionalFormatCharacters
732 ]
733
734 -- | Things you get with -W
735 minusWOpts :: [WarningFlag]
736 minusWOpts
737 = standardWarnings ++
738 [ Opt_WarnUnusedTopBinds,
739 Opt_WarnUnusedLocalBinds,
740 Opt_WarnUnusedPatternBinds,
741 Opt_WarnUnusedMatches,
742 Opt_WarnUnusedForalls,
743 Opt_WarnUnusedImports,
744 Opt_WarnIncompletePatterns,
745 Opt_WarnDodgyExports,
746 Opt_WarnDodgyImports,
747 Opt_WarnUnbangedStrictPatterns
748 ]
749
750 -- | Things you get with -Wall
751 minusWallOpts :: [WarningFlag]
752 minusWallOpts
753 = minusWOpts ++
754 [ Opt_WarnTypeDefaults,
755 Opt_WarnNameShadowing,
756 Opt_WarnMissingSignatures,
757 Opt_WarnHiShadows,
758 Opt_WarnOrphans,
759 Opt_WarnUnusedDoBind,
760 Opt_WarnTrustworthySafe,
761 Opt_WarnUntickedPromotedConstructors,
762 Opt_WarnMissingPatternSynonymSignatures,
763 Opt_WarnUnusedRecordWildcards,
764 Opt_WarnRedundantRecordWildcards,
765 Opt_WarnStarIsType,
766 Opt_WarnIncompleteUniPatterns,
767 Opt_WarnIncompletePatternsRecUpd
768 ]
769
770 -- | Things you get with -Weverything, i.e. *all* known warnings flags
771 minusWeverythingOpts :: [WarningFlag]
772 minusWeverythingOpts = [ toEnum 0 .. ]
773
774 -- | Things you get with -Wcompat.
775 --
776 -- This is intended to group together warnings that will be enabled by default
777 -- at some point in the future, so that library authors eager to make their
778 -- code future compatible to fix issues before they even generate warnings.
779 minusWcompatOpts :: [WarningFlag]
780 minusWcompatOpts
781 = [ Opt_WarnSemigroup
782 , Opt_WarnNonCanonicalMonoidInstances
783 , Opt_WarnStarIsType
784 , Opt_WarnCompatUnqualifiedImports
785 ]
786
787 -- | Things you get with -Wunused-binds
788 unusedBindsFlags :: [WarningFlag]
789 unusedBindsFlags = [ Opt_WarnUnusedTopBinds
790 , Opt_WarnUnusedLocalBinds
791 , Opt_WarnUnusedPatternBinds
792 ]