git.iko.soy/elk
on fa09513 help sign in
elk/src/Reporting/Error/Syntax.hs
377 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
27 | NoSettingsOnEffectModule
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 CommentAfterAnnotation name ->
77 Report.report
78 "STRAY COMMENT"
79 Nothing
80 ("The type annotation for `" ++ name ++ "` is followed by a documentation comment.")
81 ( Help.reflowParagraph $
82 "Documentation comments need to be *before* type annotations. Furthermore,\
83 \ type annotations need to be right above the corresponding definition, no\
84 \ comments in between."
85 )
87 CommentOnComment ->
88 Report.report
89 "STRAY COMMENT"
90 Nothing
91 ("This comment is followed by another documentation comment.")
92 ( Help.reflowParagraph $
93 "All documentation comments need to be right above the declaration they\
94 \ describe. Maybe some code got deleted or commented out by accident?"
95 )
97 CommentOnNothing ->
98 Report.report
99 "STRAY COMMENT"
100 Nothing
101 ("This documentation comment is not followed by anything.")
102 ( text "What is it documenting? Maybe it should just be removed?" )
104 SettingsOnNormalModule ->
105 Report.report
106 "BAD MODULE DECLARATION"
107 Nothing
108 "A normal module can expose values, but not register commands and subscriptions."
109 ( Help.reflowParagraph $
110 "If you want a normal module, just remove this stuff. If you want to create\
111 \ an `effect module` you just forgot to use the `effect` keyword. In that\
112 \ case, just change `module` to `effect module` and you should be all set!"
113 )
115 SettingsOnForeignModule ->
116 error "TODO - SettingsOnForeignModule"
118 DuplicateSettingOnEffectModule name ->
119 error "TODO - DuplicateSettingOnEffectModule" name
121 BadSettingOnEffectModule name ->
122 error "TODO - BadSettingOnEffectModule" name
124 NoSettingsOnEffectModule ->
125 error "TODO - NoSettingsOnEffectModule"
127 InfixDuplicate opName ->
128 Report.report
129 "INFIX OVERLAP"
130 Nothing
131 ("The infix declarations for " ++ Help.functionName opName ++ " must be removed.")
132 ( Help.reflowParagraph $
133 "The precedence and associativity of a particular operator can only be set in\
134 \ one place in a code base, and " ++ Help.functionName opName
135 ++ " has already been set somewhere else."
136 )
138 TypeWithoutDefinition valueName ->
139 Report.report
140 "MISSING DEFINITION"
141 Nothing
142 ("There is a type annotation for `" ++ valueName ++ "` but there"
143 ++ " is no corresponding definition!"
144 )
145 ( text $
146 "Directly below the type annotation, put a definition like:\n\n"
147 ++ " " ++ valueName ++ " = 42"
148 )
150 DuplicateFieldName name ->
151 Report.report
152 "DUPLICATE FIELD"
153 Nothing
154 ("This record has more than one field named `" ++ name ++ "`.")
155 (text "There can only be one. Do some renaming to make sure the names are distinct!")
157 DuplicateValueDeclaration name ->
158 Report.report
159 "DUPLICATE DEFINITION"
160 Nothing
161 ( "Naming multiple top-level values `" ++ name ++ "` makes things\n"
162 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"
163 )
164 ( Help.reflowParagraph $
165 "Find all the top-level values named " ++ Help.functionName name
166 ++ " and do some renaming. Make sure the names are distinct!"
167 )
169 DuplicateTypeDeclaration name ->
170 Report.report
171 "DUPLICATE DEFINITION"
172 Nothing
173 ( "There are multiple types named `" ++ name ++ "` in this module."
174 )
175 ( Help.reflowParagraph $
176 "Search through this module, find all the types named `" ++ name
177 ++ "`, and give each of them a unique name."
178 )
180 DuplicateDefinition name ->
181 Report.report
182 "DUPLICATE DEFINITION"
183 Nothing
184 ("There are multiple values named `" ++ name ++ "` in this let-expression."
185 )
186 ( Help.reflowParagraph $
187 "Search through this let-expression, find all the values named `" ++ name
188 ++ "`, and give each of them a unique name."
189 )
191 UnboundTypeVarsInUnion typeName givenVars unbound ->
192 unboundTypeVars "type" typeName givenVars unbound
194 UnboundTypeVarsInAlias typeName givenVars unbound ->
195 unboundTypeVars "type alias" typeName givenVars unbound
197 UnusedTypeVarsInAlias typeName givenVars unused ->
198 Report.report
199 "UNUSED TYPE VARIABLES"
200 Nothing
201 ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "
202 ++ Help.commaSep unused
203 )
204 ( Help.stack
205 [ text "You probably need to change the declaration like this:"
206 , dullyellow $ hsep $
207 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ ["=", "..."])
208 ]
209 )
211 MessyTypeVarsInAlias typeName givenVars unused unbound ->
212 Report.report
213 "TYPE VARIABLE PROBLEMS"
214 Nothing
215 ( "Type alias `" ++ typeName ++ "` has some problems with type variables."
216 )
217 ( Help.stack
218 [ Help.reflowParagraph $
219 "The declaration says it uses certain type variables ("
220 ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "
221 ++ "Furthermore, the aliased type says it uses type variables ("
222 ++ Help.commaSep unbound
223 ++ ") that do not appear in the declaration."
224 , text "You probably need to change the declaration like this:"
225 , dullyellow $ hsep $
226 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])
227 ]
228 )
231unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
232unboundTypeVars declKind typeName givenVars unboundVars =
233 Report.report
234 "UNBOUND TYPE VARIABLES"
235 Nothing
236 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
237 ++ Help.commaSep unboundVars
238 )
239 ( Help.stack
240 [ text "You probably need to change the declaration like this:"
241 , hsep $
242 map text (declKind : typeName : givenVars)
243 ++ map (dullyellow . text) unboundVars
244 ++ map text ["=", "..."]
245 , Help.reflowParagraph $
246 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++
247 "` is an Int and another where it is a Bool. When we explicitly list the type\
248 \ variables, type checker can see that they are actually different types."
249 ]
250 )
254-- TAGGING PARSE ERRORS
257newline :: String
258newline = "NEWLINE"
261freshLine :: String
262freshLine = "FRESH_LINE"
265whitespace :: String
266whitespace = "WHITESPACE"
269tab :: String
270tab = "TAB"
273keyword :: String -> String
274keyword kwd =
275 "KEYWORD=" ++ kwd
278data SpecialMessage
279 = MsgKeyword String
280 | MsgTab
283extractSpecialMessage :: String -> Maybe SpecialMessage
284extractSpecialMessage message =
285 if List.isPrefixOf "KEYWORD=" message then
286 Just $ MsgKeyword (drop (length "KEYWORD=") message)
288 else if tab == message then
289 Just MsgTab
291 else
292 Nothing
295-- REPORTING PARSE ERRORS
297parseErrorReport :: [Parsec.Message] -> Report.Report
298parseErrorReport messages =
299 let
300 addMsg message hint =
301 case message of
302 Parsec.SysUnExpect _msg ->
303 hint
305 Parsec.UnExpect _msg ->
306 hint
308 Parsec.Expect msg ->
309 let
310 msg' =
311 if msg `elem` [whitespace, newline, freshLine] then
312 "whitespace"
313 else
314 msg
315 in
316 if msg == tab then
317 -- Our parser looks for tab so it can throw a custom tab error message.
318 -- Exclude tabs from the list of expected tokens so that no one thinks they are supported.
319 hint
320 else
321 hint { _expected = Set.insert msg' (_expected hint) }
323 Parsec.Message msg ->
324 hint { _messages = msg : _messages hint }
326 (ParseHint msgs expects) =
327 foldr addMsg emptyHint messages
329 (preHint, maybePost) =
330 case msgs of
331 [msg] ->
332 case extractSpecialMessage msg of
333 Just (MsgKeyword kwd) ->
334 ( "It looks like the keyword `" ++ kwd ++ "` is being used as a variable."
335 , Just "Rename it to something else."
336 )
338 Just MsgTab ->
339 ( "A tab character was found, but all whitespace (including indentation) must be spaces not tabs."
340 , Just "I am looking for spaces, not tabs."
341 )
343 Nothing ->
344 ( msg
345 , Nothing
346 )
348 _ ->
349 ( "I ran into something unexpected when parsing your code!"
350 , Nothing
351 )
353 postHint =
354 if Set.null expects then
355 "Maybe <http://elm-lang.org/docs/syntax> can help you figure it out."
357 else
358 "I am looking for one of the following things:\n"
359 ++ concatMap ("\n "++) (Set.toList expects)
360 in
361 Report.report
362 "SYNTAX PROBLEM"
363 Nothing
364 preHint
365 (text (maybe postHint id maybePost))
368data ParseHint = ParseHint
369 { _messages :: [String]
370 , _expected :: Set.Set String
371 }
372 deriving (Show)
375emptyHint :: ParseHint
376emptyHint =
377 ParseHint [] Set.empty