git.iko.soy/elk
on bbb6583 help sign in
elk/src/Reporting/Error/Syntax.hs
373 lines 12 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
28 | InfixDuplicate String
29 | TypeWithoutDefinition String
30 | DuplicateFieldName String
31 | DuplicateValueDeclaration String
32 | DuplicateTypeDeclaration String
33 | DuplicateDefinition String
34 | UnboundTypeVarsInUnion String [String] [String]
35 | UnboundTypeVarsInAlias String [String] [String]
36 | UnusedTypeVarsInAlias String [String] [String]
37 | MessyTypeVarsInAlias String [String] [String] [String]
40-- TO REPORT
42toReport :: RenderType.Localizer -> Error -> Report.Report
43toReport _localizer err =
44 case err of
45 Parse messages ->
46 parseErrorReport messages
48 BadFunctionName arity ->
49 Report.report
50 "BAD FUNCTION DEFINITION"
51 Nothing
52 "Complex patterns cannot be used as function names."
53 ( Help.reflowParagraph $
54 "This function definition has " ++ show arity ++ " arguments, but instead\
55 \ of a normal name like `add` or `reverse` it has a pattern. There is no\
56 \ way to \"deconstruct\" a function with pattern matching, so this needs to\
57 \ be changed to a normal name."
58 )
60 BadPattern name ->
61 Report.report
62 "BAD PATTERN"
63 Nothing
64 ("The free variable `" ++ name ++ "` appears more than once in this pattern.")
65 ( Help.stack
66 [ text "Rename the variables so there are no duplicates."
67 , Help.reflowParagraph $
68 "In Elm, pattern matching works by binding these free variables to subsections\
69 \ of the matching value. It does not make sense to have the same name for two\
70 \ different subsections though! When you say `" ++ name ++ "` in some code, there\
71 \ is no way for me to know which subsection you mean!"
72 ]
73 )
75 CommentAfterAnnotation name ->
76 Report.report
77 "STRAY COMMENT"
78 Nothing
79 ("The type annotation for `" ++ name ++ "` is followed by a documentation comment.")
80 ( Help.reflowParagraph $
81 "Documentation comments need to be *before* type annotations. Furthermore,\
82 \ type annotations need to be right above the corresponding definition, no\
83 \ comments in between."
84 )
86 CommentOnComment ->
87 Report.report
88 "STRAY COMMENT"
89 Nothing
90 ("This comment is followed by another documentation comment.")
91 ( Help.reflowParagraph $
92 "All documentation comments need to be right above the declaration they\
93 \ describe. Maybe some code got deleted or commented out by accident?"
94 )
96 CommentOnNothing ->
97 Report.report
98 "STRAY COMMENT"
99 Nothing
100 ("This documentation comment is not followed by anything.")
101 ( text "What is it documenting? Maybe it should just be removed?" )
103 SettingsOnNormalModule ->
104 Report.report
105 "BAD MODULE DECLARATION"
106 Nothing
107 "A normal module can expose values, but not register commands and subscriptions."
108 ( Help.reflowParagraph $
109 "If you want a normal module, just remove this stuff. If you want to create\
110 \ an `effect module` you just forgot to use the `effect` keyword. In that\
111 \ case, just change `module` to `effect module` and you should be all set!"
112 )
114 SettingsOnForeignModule ->
115 error "TODO - SettingsOnForeignModule"
117 DuplicateSettingOnEffectModule name ->
118 error "TODO - DuplicateSettingOnEffectModule" name
120 BadSettingOnEffectModule name ->
121 error "TODO - BadSettingOnEffectModule" name
123 InfixDuplicate opName ->
124 Report.report
125 "INFIX OVERLAP"
126 Nothing
127 ("The infix declarations for " ++ Help.functionName opName ++ " must be removed.")
128 ( Help.reflowParagraph $
129 "The precedence and associativity of a particular operator can only be set in\
130 \ one place in a code base, and " ++ Help.functionName opName
131 ++ " has already been set somewhere else."
132 )
134 TypeWithoutDefinition valueName ->
135 Report.report
136 "MISSING DEFINITION"
137 Nothing
138 ("There is a type annotation for `" ++ valueName ++ "` but there"
139 ++ " is no corresponding definition!"
140 )
141 ( text $
142 "Directly below the type annotation, put a definition like:\n\n"
143 ++ " " ++ valueName ++ " = 42"
144 )
146 DuplicateFieldName name ->
147 Report.report
148 "DUPLICATE FIELD"
149 Nothing
150 ("This record has more than one field named `" ++ name ++ "`.")
151 (text "There can only be one. Do some renaming to make sure the names are distinct!")
153 DuplicateValueDeclaration name ->
154 Report.report
155 "DUPLICATE DEFINITION"
156 Nothing
157 ( "Naming multiple top-level values `" ++ name ++ "` makes things\n"
158 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"
159 )
160 ( Help.reflowParagraph $
161 "Find all the top-level values named " ++ Help.functionName name
162 ++ " and do some renaming. Make sure the names are distinct!"
163 )
165 DuplicateTypeDeclaration name ->
166 Report.report
167 "DUPLICATE DEFINITION"
168 Nothing
169 ( "There are multiple types named `" ++ name ++ "` in this module."
170 )
171 ( Help.reflowParagraph $
172 "Search through this module, find all the types named `" ++ name
173 ++ "`, and give each of them a unique name."
174 )
176 DuplicateDefinition name ->
177 Report.report
178 "DUPLICATE DEFINITION"
179 Nothing
180 ("There are multiple values named `" ++ name ++ "` in this let-expression."
181 )
182 ( Help.reflowParagraph $
183 "Search through this let-expression, find all the values named `" ++ name
184 ++ "`, and give each of them a unique name."
185 )
187 UnboundTypeVarsInUnion typeName givenVars unbound ->
188 unboundTypeVars "type" typeName givenVars unbound
190 UnboundTypeVarsInAlias typeName givenVars unbound ->
191 unboundTypeVars "type alias" typeName givenVars unbound
193 UnusedTypeVarsInAlias typeName givenVars unused ->
194 Report.report
195 "UNUSED TYPE VARIABLES"
196 Nothing
197 ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "
198 ++ Help.commaSep unused
199 )
200 ( Help.stack
201 [ text "You probably need to change the declaration like this:"
202 , dullyellow $ hsep $
203 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ ["=", "..."])
204 ]
205 )
207 MessyTypeVarsInAlias typeName givenVars unused unbound ->
208 Report.report
209 "TYPE VARIABLE PROBLEMS"
210 Nothing
211 ( "Type alias `" ++ typeName ++ "` has some problems with type variables."
212 )
213 ( Help.stack
214 [ Help.reflowParagraph $
215 "The declaration says it uses certain type variables ("
216 ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "
217 ++ "Furthermore, the aliased type says it uses type variables ("
218 ++ Help.commaSep unbound
219 ++ ") that do not appear in the declaration."
220 , text "You probably need to change the declaration like this:"
221 , dullyellow $ hsep $
222 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])
223 ]
224 )
227unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
228unboundTypeVars declKind typeName givenVars unboundVars =
229 Report.report
230 "UNBOUND TYPE VARIABLES"
231 Nothing
232 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
233 ++ Help.commaSep unboundVars
234 )
235 ( Help.stack
236 [ text "You probably need to change the declaration like this:"
237 , hsep $
238 map text (declKind : typeName : givenVars)
239 ++ map (dullyellow . text) unboundVars
240 ++ map text ["=", "..."]
241 , Help.reflowParagraph $
242 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++
243 "` is an Int and another where it is a Bool. When we explicitly list the type\
244 \ variables, type checker can see that they are actually different types."
245 ]
246 )
250-- TAGGING PARSE ERRORS
253newline :: String
254newline = "NEWLINE"
257freshLine :: String
258freshLine = "FRESH_LINE"
261whitespace :: String
262whitespace = "WHITESPACE"
265tab :: String
266tab = "TAB"
269keyword :: String -> String
270keyword kwd =
271 "KEYWORD=" ++ kwd
274data SpecialMessage
275 = MsgKeyword String
276 | MsgTab
279extractSpecialMessage :: String -> Maybe SpecialMessage
280extractSpecialMessage message =
281 if List.isPrefixOf "KEYWORD=" message then
282 Just $ MsgKeyword (drop (length "KEYWORD=") message)
284 else if tab == message then
285 Just MsgTab
287 else
288 Nothing
291-- REPORTING PARSE ERRORS
293parseErrorReport :: [Parsec.Message] -> Report.Report
294parseErrorReport messages =
295 let
296 addMsg message hint =
297 case message of
298 Parsec.SysUnExpect _msg ->
299 hint
301 Parsec.UnExpect _msg ->
302 hint
304 Parsec.Expect msg ->
305 let
306 msg' =
307 if msg `elem` [whitespace, newline, freshLine] then
308 "whitespace"
309 else
310 msg
311 in
312 if msg == tab then
313 -- Our parser looks for tab so it can throw a custom tab error message.
314 -- Exclude tabs from the list of expected tokens so that no one thinks they are supported.
315 hint
316 else
317 hint { _expected = Set.insert msg' (_expected hint) }
319 Parsec.Message msg ->
320 hint { _messages = msg : _messages hint }
322 (ParseHint msgs expects) =
323 foldr addMsg emptyHint messages
325 (preHint, maybePost) =
326 case msgs of
327 [msg] ->
328 case extractSpecialMessage msg of
329 Just (MsgKeyword kwd) ->
330 ( "It looks like the keyword `" ++ kwd ++ "` is being used as a variable."
331 , Just "Rename it to something else."
332 )
334 Just MsgTab ->
335 ( "A tab character was found, but all whitespace (including indentation) must be spaces not tabs."
336 , Just "I am looking for spaces, not tabs."
337 )
339 Nothing ->
340 ( msg
341 , Nothing
342 )
344 _ ->
345 ( "I ran into something unexpected when parsing your code!"
346 , Nothing
347 )
349 postHint =
350 if Set.null expects then
351 "Maybe <http://elm-lang.org/docs/syntax> can help you figure it out."
353 else
354 "I am looking for one of the following things:\n"
355 ++ concatMap ("\n "++) (Set.toList expects)
356 in
357 Report.report
358 "SYNTAX PROBLEM"
359 Nothing
360 preHint
361 (text (maybe postHint id maybePost))
364data ParseHint = ParseHint
365 { _messages :: [String]
366 , _expected :: Set.Set String
367 }
368 deriving (Show)
371emptyHint :: ParseHint
372emptyHint =
373 ParseHint [] Set.empty