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