git.iko.soy/elk
on fe1e5d2 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 AST.Declaration as Decl
10import qualified Reporting.Error.Helpers as Help
11import qualified Reporting.Render.Type as RenderType
12import qualified Reporting.Report as Report
15data Error
16 = Parse [Parsec.Message]
17 | BadFunctionName Int
18 | BadPattern String
20 | CommentAfterAnnotation String
21 | CommentOnComment
22 | CommentOnNothing
24 | BadDefineInNormalModule Decl.EffectType
25 | BadDefineInEffectModule Decl.EffectType
26 | BadDefineInForeignModule Decl.EffectType
27 | WithInEffectDefine Decl.EffectType String
28 | NoDefineInEffectModule
29 | NoDefineInForeignModule
30 | DuplicateDefines Decl.EffectType Int
32 | InfixDuplicate String
33 | TypeWithoutDefinition String
34 | DuplicateFieldName String
35 | DuplicateValueDeclaration String
36 | DuplicateTypeDeclaration String
37 | DuplicateDefinition String
38 | UnboundTypeVarsInUnion String [String] [String]
39 | UnboundTypeVarsInAlias String [String] [String]
40 | UnusedTypeVarsInAlias String [String] [String]
41 | MessyTypeVarsInAlias String [String] [String] [String]
44-- TO REPORT
46toReport :: RenderType.Localizer -> Error -> Report.Report
47toReport _localizer err =
48 case err of
49 Parse messages ->
50 parseErrorReport messages
52 BadFunctionName arity ->
53 Report.report
54 "BAD FUNCTION DEFINITION"
55 Nothing
56 "Complex patterns cannot be used as function names."
57 ( Help.reflowParagraph $
58 "This function definition has " ++ show arity ++ " arguments, but instead\
59 \ of a normal name like `add` or `reverse` it has a pattern. There is no\
60 \ way to \"deconstruct\" a function with pattern matching, so this needs to\
61 \ be changed to a normal name."
62 )
64 BadPattern name ->
65 Report.report
66 "BAD PATTERN"
67 Nothing
68 ("The free variable `" ++ name ++ "` appears more than once in this pattern.")
69 ( Help.stack
70 [ text "Rename the variables so there are no duplicates."
71 , Help.reflowParagraph $
72 "In Elm, pattern matching works by binding these free variables to subsections\
73 \ of the matching value. It does not make sense to have the same name for two\
74 \ different subsections though! When you say `" ++ name ++ "` in some code, there\
75 \ is no way for me to know which subsection you mean!"
76 ]
77 )
79 CommentAfterAnnotation name ->
80 Report.report
81 "STRAY COMMENT"
82 Nothing
83 ("The type annotation for `" ++ name ++ "` is followed by a documentation comment.")
84 ( Help.reflowParagraph $
85 "Documentation comments need to be *before* type annotations. Furthermore,\
86 \ type annotations need to be right above the corresponding definition, no\
87 \ comments in between."
88 )
90 CommentOnComment ->
91 Report.report
92 "STRAY COMMENT"
93 Nothing
94 ("This comment is followed by another documentation comment.")
95 ( Help.reflowParagraph $
96 "All documentation comments need to be right above the declaration they\
97 \ describe. Maybe some code got deleted or commented out by accident?"
98 )
100 CommentOnNothing ->
101 Report.report
102 "STRAY COMMENT"
103 Nothing
104 ("This documentation comment is not followed by anything.")
105 ( text "What is it documenting? Maybe it should just be removed?" )
107 DuplicateDefines effectType n ->
108 let
109 name =
110 Decl.effectTypeToString effectType
111 in
112 Report.report
113 "DUPLICATE DEFINE"
114 Nothing
115 ("There can only be one `define " ++ name ++ "` per module.")
116 ( Help.reflowParagraph $
117 "The `define` shown above is the last of " ++ show n ++ " in this module.\
118 \ They all say `define "++ name ++ "`, but maybe some are supposed to define\
119 \ something else? Could be a copy paste error. If they really are supposed\
120 \ to define the same kind of thing, just combine them and you should be all set!"
121 )
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