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