never executed always true always false
1 {-# LANGUAGE LambdaCase #-}
2
3 {-# OPTIONS_GHC -Wno-orphans #-} -- instance Outputable GhcHint
4
5 module GHC.Types.Hint.Ppr (
6 perhapsAsPat
7 -- also, and more interesting: instance Outputable GhcHint
8 ) where
9
10 import GHC.Prelude
11
12 import GHC.Parser.Errors.Basic
13 import GHC.Types.Hint
14
15 import GHC.Hs.Expr () -- instance Outputable
16 import GHC.Types.Id
17 import GHC.Unit.Types
18 import GHC.Utils.Outputable
19
20 import Data.List (intersperse)
21 import qualified Data.List.NonEmpty as NE
22
23 instance Outputable GhcHint where
24 ppr = \case
25 UnknownHint m
26 -> ppr m
27 SuggestExtension extHint
28 -> case extHint of
29 SuggestSingleExtension extraUserInfo ext ->
30 (text "Perhaps you intended to use" <+> ppr ext) $$ extraUserInfo
31 SuggestAnyExtension extraUserInfo exts ->
32 let header = text "Enable any of the following extensions:"
33 in header <+> hcat (intersperse (text ", ") (map ppr exts)) $$ extraUserInfo
34 SuggestExtensions extraUserInfo exts ->
35 let header = text "Enable all of the following extensions:"
36 in header <+> hcat (intersperse (text ", ") (map ppr exts)) $$ extraUserInfo
37 SuggestExtensionInOrderTo extraUserInfo ext ->
38 (text "Use" <+> ppr ext) $$ extraUserInfo
39 SuggestMissingDo
40 -> text "Possibly caused by a missing 'do'?"
41 SuggestLetInDo
42 -> text "Perhaps you need a 'let' in a 'do' block?"
43 $$ text "e.g. 'let x = 5' instead of 'x = 5'"
44 SuggestAddSignatureCabalFile pi_mod_name
45 -> text "Try adding" <+> quotes (ppr pi_mod_name)
46 <+> text "to the"
47 <+> quotes (text "signatures")
48 <+> text "field in your Cabal file."
49 SuggestSignatureInstantiations pi_mod_name suggestions
50 -> let suggested_instantiated_with =
51 hcat (punctuate comma $
52 [ ppr k <> text "=" <> ppr v
53 | InstantiationSuggestion k v <- suggestions
54 ])
55 in text "Try passing -instantiated-with=\"" <>
56 suggested_instantiated_with <> text "\"" $$
57 text "replacing <" <> ppr pi_mod_name <> text "> as necessary."
58 SuggestUseSpaces
59 -> text "Please use spaces instead."
60 SuggestUseWhitespaceAfter sym
61 -> text "Add whitespace after the"
62 <+> quotes (pprOperatorWhitespaceSymbol sym) <> char '.'
63 SuggestUseWhitespaceAround sym _occurrence
64 -> text "Add whitespace around" <+> quotes (text sym) <> char '.'
65 SuggestParentheses
66 -> text "Use parentheses."
67 SuggestIncreaseMaxPmCheckModels
68 -> text "Increase the limit or resolve the warnings to suppress this message."
69 SuggestAddTypeSignatures bindings
70 -> case bindings of
71 -- This might happen when we have bindings which are /too complicated/,
72 -- see for example 'DsCannotMixPolyAndUnliftedBindings' in 'GHC.HsToCore.Errors.Types'.
73 -- In this case, we emit a generic message.
74 UnnamedBinding -> text "Add a type signature."
75 NamedBindings (x NE.:| xs) ->
76 let nameList = case xs of
77 [] -> quotes . ppr $ x
78 _ -> pprWithCommas (quotes . ppr) xs <+> text "and" <+> quotes (ppr x)
79 in hsep [ text "Consider giving"
80 , nameList
81 , text "a type signature"]
82 SuggestBindToWildcard rhs
83 -> hang (text "Suppress this warning by saying") 2 (quotes $ text "_ <-" <+> ppr rhs)
84 SuggestAddInlineOrNoInlinePragma lhs_id rule_act
85 -> vcat [ text "Add an INLINE[n] or NOINLINE[n] pragma for" <+> quotes (ppr lhs_id)
86 , whenPprDebug (ppr (idInlineActivation lhs_id) $$ ppr rule_act)
87 ]
88 SuggestAddPhaseToCompetingRule bad_rule
89 -> vcat [ text "Add phase [n] or [~n] to the competing rule"
90 , whenPprDebug (ppr bad_rule) ]
91 SuggestIncreaseSimplifierIterations
92 -> text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit"
93 SuggestUseTypeFromDataKind
94 -> text "Use" <+> quotes (text "Type")
95 <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead."
96 SuggestQualifiedAfterModuleName
97 -> text "Place" <+> quotes (text "qualified")
98 <+> text "after the module name."
99 SuggestThQuotationSyntax
100 -> vcat [ text "Perhaps you intended to use quotation syntax of TemplateHaskell,"
101 , text "but the type variable or constructor is missing"
102 ]
103 SuggestRoles nearby
104 -> case nearby of
105 [] -> empty
106 [r] -> text "Perhaps you meant" <+> quotes (ppr r)
107 -- will this last case ever happen??
108 _ -> hang (text "Perhaps you meant one of these:")
109 2 (pprWithCommas (quotes . ppr) nearby)
110 SuggestQualifyStarOperator
111 -> text "To use (or export) this operator in"
112 <+> text "modules with StarIsType,"
113 $$ text " including the definition module, you must qualify it."
114 SuggestTypeSignatureForm
115 -> text "A type signature should be of form <variables> :: <type>"
116 SuggestAddToHSigExportList _name mb_mod
117 -> let header = text "Try adding it to the export list of"
118 in case mb_mod of
119 Nothing -> header <+> text "the hsig file."
120 Just mod -> header <+> ppr (moduleName mod) <> text "'s hsig file."
121 SuggestFixOrphanInstance
122 -> vcat [ text "Move the instance declaration to the module of the class or of the type, or"
123 , text "wrap the type with a newtype and declare the instance on the new type."
124 ]
125 SuggestAddStandaloneDerivation
126 -> text "Use a standalone deriving declaration instead"
127 SuggestFillInWildcardConstraint
128 -> text "Fill in the wildcard constraint yourself"
129
130 perhapsAsPat :: SDoc
131 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"