on 74bc3f2 help sign in
elk/src/Reporting/Error/Syntax.hs
354 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 | InfixDuplicate String
19 | TypeWithoutDefinition String
20 | PortWithoutAnnotation String
21 | UnexpectedPort
22 | DuplicateArgument String String
23 | DuplicateFieldName String
24 | DuplicateValueDeclaration String
25 | DuplicateTypeDeclaration String
26 | DuplicateDefinition String
27 | UnboundTypeVarsInUnion String [String] [String]
28 | UnboundTypeVarsInAlias String [String] [String]
29 | UnusedTypeVarsInAlias String [String] [String]
30 | MessyTypeVarsInAlias String [String] [String] [String]
33-- TO REPORT
35toReport :: RenderType.Localizer -> Error -> Report.Report
36toReport _localizer err =
37 case err of
38 Parse messages ->
39 parseErrorReport messages
41 BadFunctionName arity ->
42 Report.report
43 "BAD FUNCTION DEFINITION"
44 Nothing
45 "Complex patterns cannot be used as function names."
46 ( Help.reflowParagraph $
47 "This function definition has " ++ show arity ++ " arguments, but instead\
48 \ of a normal name like `add` or `reverse` it has a pattern. There is no\
49 \ way to \"deconstruct\" a function with pattern matching, so this needs to\
50 \ be changed to a normal name."
51 )
53 BadPattern name ->
54 Report.report
55 "BAD PATTERN"
56 Nothing
57 ("The free variable `" ++ name ++ "` appears more than once in this pattern.")
58 ( Help.stack
59 [ text "Rename the variables so there are no duplicates."
60 , Help.reflowParagraph $
61 "In Elm, pattern matching works by binding these free variables to subsections\
62 \ of the matching value. It does not make sense to have the same name for two\
63 \ different subsections though! When you say `" ++ name ++ "` in some code, there\
64 \ is no way for me to know which subsection you mean!"
65 ]
66 )
68 InfixDuplicate opName ->
69 Report.report
70 "INFIX OVERLAP"
71 Nothing
72 ("The infix declarations for " ++ Help.functionName opName ++ " must be removed.")
73 ( Help.reflowParagraph $
74 "The precedence and associativity of a particular operator can only be set in\
75 \ one place in a code base, and " ++ Help.functionName opName
76 ++ " has already been set somewhere else."
77 )
79 TypeWithoutDefinition valueName ->
80 Report.report
81 "MISSING DEFINITION"
82 Nothing
83 ("There is a type annotation for `" ++ valueName ++ "` but there"
84 ++ " is no corresponding definition!"
85 )
86 ( text $
87 "Directly below the type annotation, put a definition like:\n\n"
88 ++ " " ++ valueName ++ " = 42"
89 )
91 PortWithoutAnnotation portName ->
92 Report.report
93 "PORT ERROR"
94 Nothing
95 ("Port `" ++ portName ++ "` does not have a type annotation!")
96 ( text $
97 "Directly above the port definition, I need something like this:\n\n"
98 ++ " port " ++ portName ++ " : Signal Int"
99 )
102 UnexpectedPort ->
103 Report.report
104 "PORT ERROR"
105 Nothing
106 "This module has ports, but ports can only appear in the main module."
107 ( Help.reflowParagraph $
108 "Ports in library code would create hidden dependencies where importing a\
109 \ module could bring in constraints not captured in the public API. Furthermore,\
110 \ if the module is imported twice, do we send values out the port twice?"
111 )
113 DuplicateArgument funcName argName ->
114 Report.report
115 "DUPLICATE ARGUMENT"
116 Nothing
117 ( "The name `" ++ argName
118 ++ "` is used more than once in the arguments of `"
119 ++ funcName ++ "`."
120 )
121 ( Help.reflowParagraph $
122 "Rename things until `" ++ argName ++ "` is used only once.\
123 \ Otherwise how can we tell which one you want when you\
124 \ say `" ++ argName ++ "` it in the body of your function?"
125 )
127 DuplicateFieldName name ->
128 Report.report
129 "DUPLICATE FIELD"
130 Nothing
131 ("This record has more than one field named `" ++ name ++ "`.")
132 (text "There can only be one. Do some renaming to make sure the names are distinct!")
134 DuplicateValueDeclaration name ->
135 Report.report
136 "DUPLICATE DEFINITION"
137 Nothing
138 ( "Naming multiple top-level values `" ++ name ++ "` makes things\n"
139 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"
140 )
141 ( Help.reflowParagraph $
142 "Find all the top-level values named " ++ Help.functionName name
143 ++ " and do some renaming. Make sure the names are distinct!"
144 )
146 DuplicateTypeDeclaration name ->
147 Report.report
148 "DUPLICATE DEFINITION"
149 Nothing
150 ( "There are multiple types named `" ++ name ++ "` in this module."
151 )
152 ( Help.reflowParagraph $
153 "Search through this module, find all the types named `" ++ name
154 ++ "`, and give each of them a unique name."
155 )
157 DuplicateDefinition name ->
158 Report.report
159 "DUPLICATE DEFINITION"
160 Nothing
161 ("There are multiple values named `" ++ name ++ "` in this let-expression."
162 )
163 ( Help.reflowParagraph $
164 "Search through this let-expression, find all the values named `" ++ name
165 ++ "`, and give each of them a unique name."
166 )
168 UnboundTypeVarsInUnion typeName givenVars unbound ->
169 unboundTypeVars "type" typeName givenVars unbound
171 UnboundTypeVarsInAlias typeName givenVars unbound ->
172 unboundTypeVars "type alias" typeName givenVars unbound
174 UnusedTypeVarsInAlias typeName givenVars unused ->
175 Report.report
176 "UNUSED TYPE VARIABLES"
177 Nothing
178 ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "
179 ++ Help.commaSep unused
180 )
181 ( Help.stack
182 [ text "You probably need to change the declaration like this:"
183 , dullyellow $ hsep $
184 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ ["=", "..."])
185 ]
186 )
188 MessyTypeVarsInAlias typeName givenVars unused unbound ->
189 Report.report
190 "TYPE VARIABLE PROBLEMS"
191 Nothing
192 ( "Type alias `" ++ typeName ++ "` has some problems with type variables."
193 )
194 ( Help.stack
195 [ Help.reflowParagraph $
196 "The declaration says it uses certain type variables ("
197 ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "
198 ++ "Furthermore, the aliased type says it uses type variables ("
199 ++ Help.commaSep unbound
200 ++ ") that do not appear in the declaration."
201 , text "You probably need to change the declaration like this:"
202 , dullyellow $ hsep $
203 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])
204 ]
205 )
208unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
209unboundTypeVars declKind typeName givenVars unboundVars@(tvar:_) =
210 Report.report
211 "UNBOUND TYPE VARIABLES"
212 Nothing
213 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
214 ++ Help.commaSep unboundVars
215 )
216 ( Help.stack
217 [ text "You probably need to change the declaration like this:"
218 , hsep $
219 map text (declKind : typeName : givenVars)
220 ++ map (dullyellow . text) unboundVars
221 ++ map text ["=", "..."]
222 , Help.reflowParagraph $
223 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ tvar ++ "` is an Int and\
224 \ another where it is a Bool. When we explicitly list the type variables, type\
225 \ checker can see that they are actually different types."
226 ]
227 )
231-- TAGGING PARSE ERRORS
234newline :: String
235newline = "NEWLINE"
238freshLine :: String
239freshLine = "FRESH_LINE"
242whitespace :: String
243whitespace = "WHITESPACE"
246tab :: String
247tab = "TAB"
250keyword :: String -> String
251keyword kwd =
252 "KEYWORD=" ++ kwd
255data SpecialMessage
256 = MsgKeyword String
257 | MsgTab
260extractSpecialMessage :: String -> Maybe SpecialMessage
261extractSpecialMessage message =
262 if List.isPrefixOf "KEYWORD=" message then
263 Just $ MsgKeyword (drop (length "KEYWORD=") message)
265 else if tab == message then
266 Just MsgTab
268 else
269 Nothing
272-- REPORTING PARSE ERRORS
274parseErrorReport :: [Parsec.Message] -> Report.Report
275parseErrorReport messages =
276 let
277 addMsg message hint =
278 case message of
279 Parsec.SysUnExpect _msg ->
280 hint
282 Parsec.UnExpect _msg ->
283 hint
285 Parsec.Expect msg ->
286 let
287 msg' =
288 if msg `elem` [whitespace, newline, freshLine] then
289 "whitespace"
290 else
291 msg
292 in
293 if msg == tab then
294 -- Our parser looks for tab so it can throw a custom tab error message.
295 -- Exclude tabs from the list of expected tokens so that no one thinks they are supported.
296 hint
297 else
298 hint { _expected = Set.insert msg' (_expected hint) }
300 Parsec.Message msg ->
301 hint { _messages = msg : _messages hint }
303 (ParseHint msgs expects) =
304 foldr addMsg emptyHint messages
306 (preHint, maybePost) =
307 case msgs of
308 [msg] ->
309 case extractSpecialMessage msg of
310 Just (MsgKeyword kwd) ->
311 ( "It looks like the keyword `" ++ kwd ++ "` is being used as a variable."
312 , Just "Rename it to something else."
313 )
315 Just MsgTab ->
316 ( "A tab character was found, but all whitespace (including indentation) must be spaces not tabs."
317 , Just "I am looking for spaces, not tabs."
318 )
320 Nothing ->
321 ( msg
322 , Nothing
323 )
325 _ ->
326 ( "I ran into something unexpected when parsing your code!"
327 , Nothing
328 )
330 postHint =
331 if Set.null expects then
332 "Maybe <http://elm-lang.org/docs/syntax> can help you figure it out."
334 else
335 "I am looking for one of the following things:\n"
336 ++ concatMap ("\n "++) (Set.toList expects)
337 in
338 Report.report
339 "SYNTAX PROBLEM"
340 Nothing
341 preHint
342 (text (maybe postHint id maybePost))
345data ParseHint = ParseHint
346 { _messages :: [String]
347 , _expected :: Set.Set String
348 }
349 deriving (Show)
352emptyHint :: ParseHint
353emptyHint =
354 ParseHint [] Set.empty