git.iko.soy/elk
on 3e8eb7b help sign in
elk/src/Reporting/Error/Syntax.hs
348 lines 11 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 | 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 InfixDuplicate opName ->
99 Report.report
100 "INFIX OVERLAP"
101 Nothing
102 ("The infix declarations for " ++ Help.functionName opName ++ " must be removed.")
103 ( Help.reflowParagraph $
104 "The precedence and associativity of a particular operator can only be set in\
105 \ one place in a code base, and " ++ Help.functionName opName
106 ++ " has already been set somewhere else."
107 )
109 TypeWithoutDefinition valueName ->
110 Report.report
111 "MISSING DEFINITION"
112 Nothing
113 ("There is a type annotation for `" ++ valueName ++ "` but there"
114 ++ " is no corresponding definition!"
115 )
116 ( text $
117 "Directly below the type annotation, put a definition like:\n\n"
118 ++ " " ++ valueName ++ " = 42"
119 )
121 DuplicateFieldName name ->
122 Report.report
123 "DUPLICATE FIELD"
124 Nothing
125 ("This record has more than one field named `" ++ name ++ "`.")
126 (text "There can only be one. Do some renaming to make sure the names are distinct!")
128 DuplicateValueDeclaration name ->
129 Report.report
130 "DUPLICATE DEFINITION"
131 Nothing
132 ( "Naming multiple top-level values `" ++ name ++ "` makes things\n"
133 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"
134 )
135 ( Help.reflowParagraph $
136 "Find all the top-level values named " ++ Help.functionName name
137 ++ " and do some renaming. Make sure the names are distinct!"
138 )
140 DuplicateTypeDeclaration name ->
141 Report.report
142 "DUPLICATE DEFINITION"
143 Nothing
144 ( "There are multiple types named `" ++ name ++ "` in this module."
145 )
146 ( Help.reflowParagraph $
147 "Search through this module, find all the types named `" ++ name
148 ++ "`, and give each of them a unique name."
149 )
151 DuplicateDefinition name ->
152 Report.report
153 "DUPLICATE DEFINITION"
154 Nothing
155 ("There are multiple values named `" ++ name ++ "` in this let-expression."
156 )
157 ( Help.reflowParagraph $
158 "Search through this let-expression, find all the values named `" ++ name
159 ++ "`, and give each of them a unique name."
160 )
162 UnboundTypeVarsInUnion typeName givenVars unbound ->
163 unboundTypeVars "type" typeName givenVars unbound
165 UnboundTypeVarsInAlias typeName givenVars unbound ->
166 unboundTypeVars "type alias" typeName givenVars unbound
168 UnusedTypeVarsInAlias typeName givenVars unused ->
169 Report.report
170 "UNUSED TYPE VARIABLES"
171 Nothing
172 ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "
173 ++ Help.commaSep unused
174 )
175 ( Help.stack
176 [ text "You probably need to change the declaration like this:"
177 , dullyellow $ hsep $
178 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ ["=", "..."])
179 ]
180 )
182 MessyTypeVarsInAlias typeName givenVars unused unbound ->
183 Report.report
184 "TYPE VARIABLE PROBLEMS"
185 Nothing
186 ( "Type alias `" ++ typeName ++ "` has some problems with type variables."
187 )
188 ( Help.stack
189 [ Help.reflowParagraph $
190 "The declaration says it uses certain type variables ("
191 ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "
192 ++ "Furthermore, the aliased type says it uses type variables ("
193 ++ Help.commaSep unbound
194 ++ ") that do not appear in the declaration."
195 , text "You probably need to change the declaration like this:"
196 , dullyellow $ hsep $
197 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])
198 ]
199 )
202unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
203unboundTypeVars declKind typeName givenVars unboundVars =
204 Report.report
205 "UNBOUND TYPE VARIABLES"
206 Nothing
207 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
208 ++ Help.commaSep unboundVars
209 )
210 ( Help.stack
211 [ text "You probably need to change the declaration like this:"
212 , hsep $
213 map text (declKind : typeName : givenVars)
214 ++ map (dullyellow . text) unboundVars
215 ++ map text ["=", "..."]
216 , Help.reflowParagraph $
217 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++
218 "` is an Int and another where it is a Bool. When we explicitly list the type\
219 \ variables, type checker can see that they are actually different types."
220 ]
221 )
225-- TAGGING PARSE ERRORS
228newline :: String
229newline = "NEWLINE"
232freshLine :: String
233freshLine = "FRESH_LINE"
236whitespace :: String
237whitespace = "WHITESPACE"
240tab :: String
241tab = "TAB"
244keyword :: String -> String
245keyword kwd =
246 "KEYWORD=" ++ kwd
249data SpecialMessage
250 = MsgKeyword String
251 | MsgTab
254extractSpecialMessage :: String -> Maybe SpecialMessage
255extractSpecialMessage message =
256 if List.isPrefixOf "KEYWORD=" message then
257 Just $ MsgKeyword (drop (length "KEYWORD=") message)
259 else if tab == message then
260 Just MsgTab
262 else
263 Nothing
266-- REPORTING PARSE ERRORS
268parseErrorReport :: [Parsec.Message] -> Report.Report
269parseErrorReport messages =
270 let
271 addMsg message hint =
272 case message of
273 Parsec.SysUnExpect _msg ->
274 hint
276 Parsec.UnExpect _msg ->
277 hint
279 Parsec.Expect msg ->
280 let
281 msg' =
282 if msg `elem` [whitespace, newline, freshLine] then
283 "whitespace"
284 else
285 msg
286 in
287 if msg == tab then
288 -- Our parser looks for tab so it can throw a custom tab error message.
289 -- Exclude tabs from the list of expected tokens so that no one thinks they are supported.
290 hint
291 else
292 hint { _expected = Set.insert msg' (_expected hint) }
294 Parsec.Message msg ->
295 hint { _messages = msg : _messages hint }
297 (ParseHint msgs expects) =
298 foldr addMsg emptyHint messages
300 (preHint, maybePost) =
301 case msgs of
302 [msg] ->
303 case extractSpecialMessage msg of
304 Just (MsgKeyword kwd) ->
305 ( "It looks like the keyword `" ++ kwd ++ "` is being used as a variable."
306 , Just "Rename it to something else."
307 )
309 Just MsgTab ->
310 ( "A tab character was found, but all whitespace (including indentation) must be spaces not tabs."
311 , Just "I am looking for spaces, not tabs."
312 )
314 Nothing ->
315 ( msg
316 , Nothing
317 )
319 _ ->
320 ( "I ran into something unexpected when parsing your code!"
321 , Nothing
322 )
324 postHint =
325 if Set.null expects then
326 "Maybe <http://elm-lang.org/docs/syntax> can help you figure it out."
328 else
329 "I am looking for one of the following things:\n"
330 ++ concatMap ("\n "++) (Set.toList expects)
331 in
332 Report.report
333 "SYNTAX PROBLEM"
334 Nothing
335 preHint
336 (text (maybe postHint id maybePost))
339data ParseHint = ParseHint
340 { _messages :: [String]
341 , _expected :: Set.Set String
342 }
343 deriving (Show)
346emptyHint :: ParseHint
347emptyHint =
348 ParseHint [] Set.empty