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