git.iko.soy/elk
on f7c25d2 help sign in
elk/src/Reporting/Error/Syntax.hs
390 lines 13 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 error "TODO - DuplicateSettingOnEffectModule" name
131 BadSettingOnEffectModule name ->
132 error "TODO - BadSettingOnEffectModule" name
134 NoSettingsOnEffectModule ->
135 error "TODO - NoSettingsOnEffectModule"
137 MissingManagerOnEffectModule name ->
138 error "TODO - NoSettingsOnEffectModule" name
140 InfixDuplicate opName ->
141 Report.report
142 "INFIX OVERLAP"
143 Nothing
144 ("The infix declarations for " ++ Help.functionName opName ++ " must be removed.")
145 ( Help.reflowParagraph $
146 "The precedence and associativity of a particular operator can only be set in\
147 \ one place in a code base, and " ++ Help.functionName opName
148 ++ " has already been set somewhere else."
149 )
151 TypeWithoutDefinition valueName ->
152 Report.report
153 "MISSING DEFINITION"
154 Nothing
155 ("There is a type annotation for `" ++ valueName ++ "` but there"
156 ++ " is no corresponding definition!"
157 )
158 ( text $
159 "Directly below the type annotation, put a definition like:\n\n"
160 ++ " " ++ valueName ++ " = 42"
161 )
163 DuplicateFieldName name ->
164 Report.report
165 "DUPLICATE FIELD"
166 Nothing
167 ("This record has more than one field named `" ++ name ++ "`.")
168 (text "There can only be one. Do some renaming to make sure the names are distinct!")
170 DuplicateValueDeclaration name ->
171 Report.report
172 "DUPLICATE DEFINITION"
173 Nothing
174 ( "Naming multiple top-level values `" ++ name ++ "` makes things\n"
175 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"
176 )
177 ( Help.reflowParagraph $
178 "Find all the top-level values named " ++ Help.functionName name
179 ++ " and do some renaming. Make sure the names are distinct!"
180 )
182 DuplicateTypeDeclaration name ->
183 Report.report
184 "DUPLICATE DEFINITION"
185 Nothing
186 ( "There are multiple types named `" ++ name ++ "` in this module."
187 )
188 ( Help.reflowParagraph $
189 "Search through this module, find all the types named `" ++ name
190 ++ "`, and give each of them a unique name."
191 )
193 DuplicateDefinition name ->
194 Report.report
195 "DUPLICATE DEFINITION"
196 Nothing
197 ("There are multiple values named `" ++ name ++ "` in this let-expression."
198 )
199 ( Help.reflowParagraph $
200 "Search through this let-expression, find all the values named `" ++ name
201 ++ "`, and give each of them a unique name."
202 )
204 UnboundTypeVarsInUnion typeName givenVars unbound ->
205 unboundTypeVars "type" typeName givenVars unbound
207 UnboundTypeVarsInAlias typeName givenVars unbound ->
208 unboundTypeVars "type alias" typeName givenVars unbound
210 UnusedTypeVarsInAlias typeName givenVars unused ->
211 Report.report
212 "UNUSED TYPE VARIABLES"
213 Nothing
214 ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "
215 ++ Help.commaSep unused
216 )
217 ( Help.stack
218 [ text "You probably need to change the declaration like this:"
219 , dullyellow $ hsep $
220 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ ["=", "..."])
221 ]
222 )
224 MessyTypeVarsInAlias typeName givenVars unused unbound ->
225 Report.report
226 "TYPE VARIABLE PROBLEMS"
227 Nothing
228 ( "Type alias `" ++ typeName ++ "` has some problems with type variables."
229 )
230 ( Help.stack
231 [ Help.reflowParagraph $
232 "The declaration says it uses certain type variables ("
233 ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "
234 ++ "Furthermore, the aliased type says it uses type variables ("
235 ++ Help.commaSep unbound
236 ++ ") that do not appear in the declaration."
237 , text "You probably need to change the declaration like this:"
238 , dullyellow $ hsep $
239 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])
240 ]
241 )
244unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
245unboundTypeVars declKind typeName givenVars unboundVars =
246 Report.report
247 "UNBOUND TYPE VARIABLES"
248 Nothing
249 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
250 ++ Help.commaSep unboundVars
251 )
252 ( Help.stack
253 [ text "You probably need to change the declaration like this:"
254 , hsep $
255 map text (declKind : typeName : givenVars)
256 ++ map (dullyellow . text) unboundVars
257 ++ map text ["=", "..."]
258 , Help.reflowParagraph $
259 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++
260 "` is an Int and another where it is a Bool. When we explicitly list the type\
261 \ variables, type checker can see that they are actually different types."
262 ]
263 )
267-- TAGGING PARSE ERRORS
270newline :: String
271newline = "NEWLINE"
274freshLine :: String
275freshLine = "FRESH_LINE"
278whitespace :: String
279whitespace = "WHITESPACE"
282tab :: String
283tab = "TAB"
286keyword :: String -> String
287keyword kwd =
288 "KEYWORD=" ++ kwd
291data SpecialMessage
292 = MsgKeyword String
293 | MsgTab
296extractSpecialMessage :: String -> Maybe SpecialMessage
297extractSpecialMessage message =
298 if List.isPrefixOf "KEYWORD=" message then
299 Just $ MsgKeyword (drop (length "KEYWORD=") message)
301 else if tab == message then
302 Just MsgTab
304 else
305 Nothing
308-- REPORTING PARSE ERRORS
310parseErrorReport :: [Parsec.Message] -> Report.Report
311parseErrorReport messages =
312 let
313 addMsg message hint =
314 case message of
315 Parsec.SysUnExpect _msg ->
316 hint
318 Parsec.UnExpect _msg ->
319 hint
321 Parsec.Expect msg ->
322 let
323 msg' =
324 if msg `elem` [whitespace, newline, freshLine] then
325 "whitespace"
326 else
327 msg
328 in
329 if msg == tab then
330 -- Our parser looks for tab so it can throw a custom tab error message.
331 -- Exclude tabs from the list of expected tokens so that no one thinks they are supported.
332 hint
333 else
334 hint { _expected = Set.insert msg' (_expected hint) }
336 Parsec.Message msg ->
337 hint { _messages = msg : _messages hint }
339 (ParseHint msgs expects) =
340 foldr addMsg emptyHint messages
342 (preHint, maybePost) =
343 case msgs of
344 [msg] ->
345 case extractSpecialMessage msg of
346 Just (MsgKeyword kwd) ->
347 ( "It looks like the keyword `" ++ kwd ++ "` is being used as a variable."
348 , Just "Rename it to something else."
349 )
351 Just MsgTab ->
352 ( "A tab character was found, but all whitespace (including indentation) must be spaces not tabs."
353 , Just "I am looking for spaces, not tabs."
354 )
356 Nothing ->
357 ( msg
358 , Nothing
359 )
361 _ ->
362 ( "I ran into something unexpected when parsing your code!"
363 , Nothing
364 )
366 postHint =
367 if Set.null expects then
368 "Maybe <http://elm-lang.org/docs/syntax> can help you figure it out."
370 else
371 "I am looking for one of the following things:\n"
372 ++ concatMap ("\n "++) (Set.toList expects)
373 in
374 Report.report
375 "SYNTAX PROBLEM"
376 Nothing
377 preHint
378 (text (maybe postHint id maybePost))
381data ParseHint = ParseHint
382 { _messages :: [String]
383 , _expected :: Set.Set String
384 }
385 deriving (Show)
388emptyHint :: ParseHint
389emptyHint =
390 ParseHint [] Set.empty