on 8aa55e0 help sign in
elk/src/Reporting/Error/Syntax.hs
421 lines 14 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Syntax where
4import qualified Data.List as List
5import qualified Data.Set as Set
6import qualified Text.Parsec.Error as Parsec
7import Text.PrettyPrint.ANSI.Leijen (dullyellow, hsep, text)
9import qualified Reporting.Error.Helpers as Help
10import qualified Reporting.Render.Type as RenderType
11import qualified Reporting.Report as Report
14data Error
15 = Parse [Parsec.Message]
16 | BadFunctionName Int
17 | BadPattern String
19 | CommentAfterAnnotation String
20 | CommentOnComment
21 | CommentOnNothing
23 | SettingsOnNormalModule
24 | SettingsOnForeignModule
25 | DuplicateSettingOnEffectModule String
26 | BadSettingOnEffectModule String
27 | NoSettingsOnEffectModule
28 | MissingManagerOnEffectModule String
30 | InfixDuplicate String
31 | TypeWithoutDefinition String
32 | DuplicateFieldName String
33 | DuplicateValueDeclaration String
34 | DuplicateTypeDeclaration String
35 | DuplicateDefinition String
36 | UnboundTypeVarsInUnion String [String] [String]
37 | UnboundTypeVarsInAlias String [String] [String]
38 | UnusedTypeVarsInAlias String [String] [String]
39 | MessyTypeVarsInAlias String [String] [String] [String]
42-- TO REPORT
44toReport :: RenderType.Localizer -> Error -> Report.Report
45toReport _localizer err =
46 case err of
47 Parse messages ->
48 parseErrorReport messages
50 BadFunctionName arity ->
51 Report.report
52 "BAD FUNCTION DEFINITION"
53 Nothing
54 "Complex patterns cannot be used as function names."
55 ( Help.reflowParagraph $
56 "This function definition has " ++ show arity ++ " arguments, but instead\
57 \ of a normal name like `add` or `reverse` it has a pattern. There is no\
58 \ way to \"deconstruct\" a function with pattern matching, so this needs to\
59 \ be changed to a normal name."
60 )
62 BadPattern name ->
63 Report.report
64 "BAD PATTERN"
65 Nothing
66 ("The free variable `" ++ name ++ "` appears more than once in this pattern.")
67 ( Help.stack
68 [ text "Rename the variables so there are no duplicates."
69 , Help.reflowParagraph $
70 "In Elm, pattern matching works by binding these free variables to subsections\
71 \ of the matching value. It does not make sense to have the same name for two\
72 \ different subsections though! When you say `" ++ name ++ "` in some code, there\
73 \ is no way for me to know which subsection you mean!"
74 ]
75 )
77 CommentAfterAnnotation name ->
78 Report.report
79 "STRAY COMMENT"
80 Nothing
81 ("The type annotation for `" ++ name ++ "` is followed by a documentation comment.")
82 ( Help.reflowParagraph $
83 "Documentation comments need to be *before* type annotations. Furthermore,\
84 \ type annotations need to be right above the corresponding definition, no\
85 \ comments in between."
86 )
88 CommentOnComment ->
89 Report.report
90 "STRAY COMMENT"
91 Nothing
92 ("This comment is followed by another documentation comment.")
93 ( Help.reflowParagraph $
94 "All documentation comments need to be right above the declaration they\
95 \ describe. Maybe some code got deleted or commented out by accident?"
96 )
98 CommentOnNothing ->
99 Report.report
100 "STRAY COMMENT"
101 Nothing
102 ("This documentation comment is not followed by anything.")
103 ( text "What is it documenting? Maybe it should just be removed?" )
105 SettingsOnNormalModule ->
106 Report.report
107 "BAD MODULE DECLARATION"
108 Nothing
109 "A normal module can expose values, but not settings like this."
110 ( Help.reflowParagraph $
111 "If you want a normal module, just remove this stuff. If you want to create\
112 \ an `effect module` you just forgot to use the `effect` keyword. In that\
113 \ case, just change `module` to `effect module` and you should be headed in\
114 \ the right direction!"
115 )
117 SettingsOnForeignModule ->
118 Report.report
119 "BAD MODULE DECLARATION"
120 Nothing
121 "A foreign effect module can expose values, but not have settings like this."
122 ( Help.reflowParagraph $
123 "If you want a foreign effect module, just remove this stuff. If you want\
124 \ to create an `effect module` instead, just change `foreign effect module`\
125 \ to `effect module` and you should be headed in the right direction!"
126 )
128 DuplicateSettingOnEffectModule name ->
129 Report.report
130 "EFFECT MODULE PROBLEM"
131 Nothing
132 ("You have defined " ++ Help.functionName name ++ " multiple times.")
133 ( Help.reflowParagraph $
134 "There can only be one " ++ Help.functionName name
135 ++ " though! Remove until there is one left."
136 )
138 BadSettingOnEffectModule name ->
139 Report.report
140 "EFFECT MODULE PROBLEM"
141 Nothing
142 ("Setting " ++ Help.functionName name ++ " is not recognized.")
143 ( Help.reflowParagraph $
144 "Remove this entry and you should be all set!"
145 )
147 NoSettingsOnEffectModule ->
148 Report.report
149 "EFFECT MODULE PROBLEM"
150 Nothing
151 ("You are defining an effect module, but it has no settings.")
152 ( Help.reflowParagraph $
153 "If you just wanted a normal module, change the keywords `effect module`\
154 \ to `module` and you should be all set. If you want a proper effect module,\
155 \ you need to specify your commands and/or subscriptions. Read more about this\
156 \ here: <TODO> (please forgive me if I forgot to fill this in!)"
157 )
159 MissingManagerOnEffectModule name ->
160 Report.report
161 "EFFECT MODULE PROBLEM"
162 Nothing
163 ("You are defining an effect module, but there is no " ++ Help.functionName name ++ " defined.")
164 ( Help.reflowParagraph $
165 "There is a small set of top-level functions and values that must be defined\
166 \ in any complete effect module. The best thing is probably to just read more\
167 \ about effect modules here:\
168 \ <TODO> (please forgive me if I forgot to fill this in!)"
169 )
171 InfixDuplicate opName ->
172 Report.report
173 "INFIX OVERLAP"
174 Nothing
175 ("The infix declarations for " ++ Help.functionName opName ++ " must be removed.")
176 ( Help.reflowParagraph $
177 "The precedence and associativity of a particular operator can only be set in\
178 \ one place in a code base, and " ++ Help.functionName opName
179 ++ " has already been set somewhere else."
180 )
182 TypeWithoutDefinition valueName ->
183 Report.report
184 "MISSING DEFINITION"
185 Nothing
186 ("There is a type annotation for `" ++ valueName ++ "` but there"
187 ++ " is no corresponding definition!"
188 )
189 ( text $
190 "Directly below the type annotation, put a definition like:\n\n"
191 ++ " " ++ valueName ++ " = 42"
192 )
194 DuplicateFieldName name ->
195 Report.report
196 "DUPLICATE FIELD"
197 Nothing
198 ("This record has more than one field named `" ++ name ++ "`.")
199 (text "There can only be one. Do some renaming to make sure the names are distinct!")
201 DuplicateValueDeclaration name ->
202 Report.report
203 "DUPLICATE DEFINITION"
204 Nothing
205 ( "Naming multiple top-level values `" ++ name ++ "` makes things\n"
206 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"
207 )
208 ( Help.reflowParagraph $
209 "Find all the top-level values named " ++ Help.functionName name
210 ++ " and do some renaming. Make sure the names are distinct!"
211 )
213 DuplicateTypeDeclaration name ->
214 Report.report
215 "DUPLICATE DEFINITION"
216 Nothing
217 ( "There are multiple types named `" ++ name ++ "` in this module."
218 )
219 ( Help.reflowParagraph $
220 "Search through this module, find all the types named `" ++ name
221 ++ "`, and give each of them a unique name."
222 )
224 DuplicateDefinition name ->
225 Report.report
226 "DUPLICATE DEFINITION"
227 Nothing
228 ("There are multiple values named `" ++ name ++ "` in this let-expression."
229 )
230 ( Help.reflowParagraph $
231 "Search through this let-expression, find all the values named `" ++ name
232 ++ "`, and give each of them a unique name."
233 )
235 UnboundTypeVarsInUnion typeName givenVars unbound ->
236 unboundTypeVars "type" typeName givenVars unbound
238 UnboundTypeVarsInAlias typeName givenVars unbound ->
239 unboundTypeVars "type alias" typeName givenVars unbound
241 UnusedTypeVarsInAlias typeName givenVars unused ->
242 Report.report
243 "UNUSED TYPE VARIABLES"
244 Nothing
245 ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "
246 ++ Help.commaSep unused
247 )
248 ( Help.stack
249 [ text "You probably need to change the declaration like this:"
250 , dullyellow $ hsep $
251 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ ["=", "..."])
252 ]
253 )
255 MessyTypeVarsInAlias typeName givenVars unused unbound ->
256 Report.report
257 "TYPE VARIABLE PROBLEMS"
258 Nothing
259 ( "Type alias `" ++ typeName ++ "` has some problems with type variables."
260 )
261 ( Help.stack
262 [ Help.reflowParagraph $
263 "The declaration says it uses certain type variables ("
264 ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "
265 ++ "Furthermore, the aliased type says it uses type variables ("
266 ++ Help.commaSep unbound
267 ++ ") that do not appear in the declaration."
268 , text "You probably need to change the declaration like this:"
269 , dullyellow $ hsep $
270 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])
271 ]
272 )
275unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
276unboundTypeVars declKind typeName givenVars unboundVars =
277 Report.report
278 "UNBOUND TYPE VARIABLES"
279 Nothing
280 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
281 ++ Help.commaSep unboundVars
282 )
283 ( Help.stack
284 [ text "You probably need to change the declaration like this:"
285 , hsep $
286 map text (declKind : typeName : givenVars)
287 ++ map (dullyellow . text) unboundVars
288 ++ map text ["=", "..."]
289 , Help.reflowParagraph $
290 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++
291 "` is an Int and another where it is a Bool. When we explicitly list the type\
292 \ variables, type checker can see that they are actually different types."
293 ]
294 )
298-- TAGGING PARSE ERRORS
301newline :: String
302newline = "NEWLINE"
305freshLine :: String
306freshLine = "FRESH_LINE"
309whitespace :: String
310whitespace = "WHITESPACE"
313tab :: String
314tab = "TAB"
317keyword :: String -> String
318keyword kwd =
319 "KEYWORD=" ++ kwd
322data SpecialMessage
323 = MsgKeyword String
324 | MsgTab
327extractSpecialMessage :: String -> Maybe SpecialMessage
328extractSpecialMessage message =
329 if List.isPrefixOf "KEYWORD=" message then
330 Just $ MsgKeyword (drop (length "KEYWORD=") message)
332 else if tab == message then
333 Just MsgTab
335 else
336 Nothing
339-- REPORTING PARSE ERRORS
341parseErrorReport :: [Parsec.Message] -> Report.Report
342parseErrorReport messages =
343 let
344 addMsg message hint =
345 case message of
346 Parsec.SysUnExpect _msg ->
347 hint
349 Parsec.UnExpect _msg ->
350 hint
352 Parsec.Expect msg ->
353 let
354 msg' =
355 if msg `elem` [whitespace, newline, freshLine] then
356 "whitespace"
357 else
358 msg
359 in
360 if msg == tab then
361 -- Our parser looks for tab so it can throw a custom tab error message.
362 -- Exclude tabs from the list of expected tokens so that no one thinks they are supported.
363 hint
364 else
365 hint { _expected = Set.insert msg' (_expected hint) }
367 Parsec.Message msg ->
368 hint { _messages = msg : _messages hint }
370 (ParseHint msgs expects) =
371 foldr addMsg emptyHint messages
373 (preHint, maybePost) =
374 case msgs of
375 [msg] ->
376 case extractSpecialMessage msg of
377 Just (MsgKeyword kwd) ->
378 ( "It looks like the keyword `" ++ kwd ++ "` is being used as a variable."
379 , Just "Rename it to something else."
380 )
382 Just MsgTab ->
383 ( "A tab character was found, but all whitespace (including indentation) must be spaces not tabs."
384 , Just "I am looking for spaces, not tabs."
385 )
387 Nothing ->
388 ( msg
389 , Nothing
390 )
392 _ ->
393 ( "I ran into something unexpected when parsing your code!"
394 , Nothing
395 )
397 postHint =
398 if Set.null expects then
399 "Maybe <http://elm-lang.org/docs/syntax> can help you figure it out."
401 else
402 "I am looking for one of the following things:\n"
403 ++ concatMap ("\n "++) (Set.toList expects)
404 in
405 Report.report
406 "SYNTAX PROBLEM"
407 Nothing
408 preHint
409 (text (maybe postHint id maybePost))
412data ParseHint = ParseHint
413 { _messages :: [String]
414 , _expected :: Set.Set String
415 }
416 deriving (Show)
419emptyHint :: ParseHint
420emptyHint =
421 ParseHint [] Set.empty