@@ -2,17 +2,23 @@
22module Reporting.Error.Type where
33
44import qualified Data.Char as Char
5+import qualified Data.List as List
56import Text.PrettyPrint ((<+>))
67import qualified Text.PrettyPrint as P
78
8−import qualified AST.Helpers as Help
9+import qualified AST.Helpers as AstHelp
910import qualified AST.Type as Type
1011import qualified AST.Variable as Var
12+import qualified Reporting.Error.Helpers as Help
1113import qualified Reporting.PrettyPrint as P
1214import qualified Reporting.Region as Region
1315import qualified Reporting.Report as Report
1416
1517
18+
19+-- ERRORS
20+
21+
1622data Error
1723 = Mismatch Mismatch
1824 | BadMain Type.Canonical
@@ -25,7 +31,6 @@ data Error
2531
2632data Mismatch = MismatchInfo
2733 { _hint :: Hint
28− , _rootType :: Type.Canonical
2934 , _leftType :: Type.Canonical
3035 , _rightType :: Type.Canonical
3136 , _reason :: Maybe Reason
@@ -34,8 +39,6 @@ data Mismatch = MismatchInfo
3439
3540data Reason
3641 = MessyFields [String] [String]
37− | ExpectedFields [String]
38− | ActualFields [String]
3942 | NotRecord
4043 | TooLongComparableTuple Int
4144 | Rigid (Maybe String)
@@ -81,21 +84,8 @@ data Pattern
8184toReport :: P.Dealiaser -> Error -> Report.Report
8285toReport dealiaser err =
8386 case err of
84− Mismatch (MismatchInfo hint rootType leftType rightType maybeReason) ->
85− let
86− (subRegion, preHint, maybePostHint) = hintToString hint
87−
88− postHint =
89− "TODO explain what went wrong!\n\n" ++ show maybeReason ++ "\n\n"
90− ++ maybe "" (++"\n\n") maybePostHint
91− ++ P.render (P.nest 4 (P.pretty dealiaser False rootType)) ++ "\n\n"
92− ++ "As I infer the types of values flowing through your program, I see a conflict\n"
93− ++ "between these two types:\n\n"
94− ++ P.render (P.nest 4 (P.pretty dealiaser False leftType))
95− ++ "\n\n"
96− ++ P.render (P.nest 4 (P.pretty dealiaser False rightType))
97− in
98− Report.Report "TYPE MISMATCH" subRegion preHint postHint
87+ Mismatch info ->
88+ mismatchToReport dealiaser info
9989
10090 InfiniteType name var tipe ->
10191 let
@@ -125,119 +115,250 @@ toReport dealiaser err =
125115 ++ P.render (P.nest 4 (P.pretty dealiaser False tipe))
126116
127117
128−hintToString :: Hint -> (Maybe Region.Region, String, Maybe String)
129−hintToString hint =
118+mismatchToReport :: P.Dealiaser -> Mismatch -> Report.Report
119+mismatchToReport dealiaser (MismatchInfo hint leftType rightType maybeReason) =
120+ let
121+ report =
122+ Report.Report "TYPE MISMATCH"
123+
124+ pretty tipe =
125+ "\n\n"
126+ ++ P.render (P.nest 4 (P.pretty dealiaser False tipe))
127+ ++ "\n\n"
128+ in
130129 case hint of
131130 CaseBranch branchNumber region ->
132− ( Just region
133− , "The " ++ ordinalize branchNumber ++ " branch of this `case` results in an unexpected type of value."
134− , Just "All branches should match so that no matter which one we take, we always get\nback the same type of value."
135− )
131+ report
132+ (Just region)
133+ ( "The " ++ ordinalize (branchNumber -1) ++ " and " ++ ordinalize branchNumber
134+ ++ " branches of this `case` result in different types of values."
135+ )
136+ ( "The " ++ ordinalize (branchNumber -1) ++ " branch results in this type of value:\n"
137+
138+ ++ pretty leftType
139+
140+ ++ "And the " ++ ordinalize branchNumber ++ " branch results in this type:\n"
141+
142+ ++ pretty rightType
143+
144+ ++ "These branches should match so that no matter which one we take, we always get\n"
145+ ++ "back the same type of value."
146+ )
136147
137148 Case ->
138− ( Nothing
139− , "All the branches of this case-expression are consistent, but the overall\n"
140− ++ "type does not match how it is used elsewhere."
141− , Nothing
142− )
149+ report
150+ Nothing
151+ ( "All the branches of this case-expression are consistent, but the overall\n"
152+ ++ "type does not match how it is used elsewhere."
153+ )
154+ ( error "TODO generic error"
155+ )
143156
144157 IfCondition ->
145− ( Nothing
146− , "This condition does not evaluate to a boolean value, True or False."
147− , Just "Elm does not have \"truthiness\" such that ints and strings and lists are\nautomatically converted to booleans. Do that conversion explicitly."
148− )
158+ report
159+ Nothing
160+ ( "This condition does not evaluate to a boolean value, True or False."
161+ )
162+ ( "Instead of Bool, it is resulting in:\n"
163+
164+ ++ pretty rightType
165+
166+ ++ "Note: Elm does not have \"truthiness\" such that ints and strings and lists\n"
167+ ++ "are automatically converted to booleans. Do that conversion explicitly."
168+ )
149169
150170 IfBranches ->
151− ( Nothing
152− , "The branches of this `if` result in different types of values."
153− , Just "All branches should match so that no matter which one we take, we always get\nback the same type of value."
154− )
171+ report
172+ Nothing
173+ ( "The branches of this `if` result in different types of values."
174+ )
175+ ( "The `then` branch results in:\n"
176+
177+ ++ pretty leftType
178+
179+ ++ "And the `else` branch results in:\n"
180+
181+ ++ pretty rightType
182+
183+ ++ "These need to match so that no matter which one we take, we always get\n"
184+ ++ "back the same type of value."
185+ )
155186
156187 MultiIfBranch branchNumber region ->
157− ( Just region
158− , "The " ++ ordinalize branchNumber ++ " branch of this `if` results in an unexpected type of value."
159− , Just "All branches should match so that no matter which one we take, we always get\nback the same type of value."
160− )
188+ report
189+ (Just region)
190+ ( "The " ++ ordinalize branchNumber ++ " branch of this `if` results in an unexpected type of value."
191+ )
192+ ( "The " ++ ordinalize (branchNumber - 1) ++ " branch results in:\n"
193+
194+ ++ pretty leftType
195+
196+ ++ "And the "++ ordinalize branchNumber ++ " branch results in:\n"
197+
198+ ++ pretty rightType
199+
200+ ++ "All branches should match so that no matter which one we take, we always get\n"
201+ ++ "back the same type of value."
202+ )
161203
162204 If ->
163− ( Nothing
164− , "All the branches of this if-expression are consistent, but the overall\n"
165− ++ "type does not match how it is used elsewhere."
166− , Nothing
167− )
205+ report
206+ Nothing
207+ ( "All the branches of this if-expression are consistent, but the overall\n"
208+ ++ "type does not match how it is used elsewhere."
209+ )
210+ ( "The `if` evaluates to something of type:\n"
211+
212+ ++ pretty leftType
213+
214+ ++ "Which is fine, but the surrounding context wants it to be:\n"
215+
216+ ++ pretty rightType
217+
218+ )
168219
169220 ListElement elementNumber region ->
170− ( Just region
171− , "The " ++ ordinalize elementNumber ++ " element of this list is an unexpected type of value."
172− , Just "All elements should be the same type of value so that we can iterate over the\nlist without running into unexpected values."
173− )
221+ report
222+ (Just region)
223+ ( "The " ++ ordinalize elementNumber ++ " element of this list is an unexpected type of value."
224+ )
225+ ( "All elements should be the same type of value so that we can iterate over the\nlist without running into unexpected values."
226+ )
174227
175228 List ->
176− ( Nothing
177− , "All the elements in this list are the same type, but the overall\n"
178− ++ "type does not match how it is used elsewhere."
179− , Nothing
180− )
229+ report
230+ Nothing
231+ ( "All the elements in this list are the same type, but the overall\n"
232+ ++ "type does not match how it is used elsewhere."
233+ )
234+ ( "The list has type:\n"
235+
236+ ++ pretty leftType
237+
238+ ++ "Which is fine, but the surrounding context wants it to be:\n"
239+
240+ ++ pretty rightType
241+ )
181242
182243 BinopLeft op region ->
183− ( Just region
184− , "The left argument of " ++ prettyOperator op ++ " is causing a type mismatch."
185− , Nothing
186− )
244+ report
245+ (Just region)
246+ ("The left argument of " ++ prettyOperator op ++ " is causing a type mismatch.")
247+ ( prettyOperator op ++ " is expecting:"
248+
249+ ++ pretty leftType
250+
251+ ++ "But the value on the left has this type:"
252+
253+ ++ pretty rightType
254+ )
187255
188256 BinopRight op region ->
189− ( Just region
190− , "The right argument of " ++ prettyOperator op ++ " is causing a type mismatch."
191− , Nothing
192− )
257+ report
258+ (Just region)
259+ ( "The right argument of " ++ prettyOperator op ++ " is causing a type mismatch."
260+ )
261+ ( prettyOperator op ++ " is expecting:"
262+
263+ ++ pretty leftType
264+
265+ ++ "But the value on the right has this type:"
266+
267+ ++ pretty rightType
268+ )
193269
194270 Binop op ->
195− ( Nothing
196− , "The two arguments to " ++ prettyOperator op ++ " are fine, but the overall type of this expression\n"
197− ++ "does not match how it is used elsewhere."
198− , Nothing
199− )
271+ report
272+ Nothing
273+ ( "The two arguments to " ++ prettyOperator op ++ " are fine, but the overall type of this expression\n"
274+ ++ "does not match how it is used elsewhere."
275+ )
276+ ( "The result of this binary operation is:\n"
277+
278+ ++ pretty leftType
279+
280+ ++ "Which is fine, but the surrounding context wants it to be:\n"
281+
282+ ++ pretty rightType
283+
284+ )
200285
201286 Function maybeName ->
202− ( Nothing
203− , "The return type of " ++ funcName maybeName ++ " is being used in unexpected ways."
204− , Nothing
205− )
287+ report
288+ Nothing
289+ ( "The return type of " ++ funcName maybeName ++ " is being used in unexpected ways."
290+ )
291+ ( "The function results in a value with type:\n"
292+
293+ ++ pretty leftType
294+
295+ ++ "Which is fine, but the surrounding context wants it to be:\n"
296+
297+ ++ pretty rightType
298+ )
206299
207300 UnexpectedArg maybeName index region ->
208− ( Just region
209− , "The " ++ ordinalize index ++ " argument to " ++ funcName maybeName
210− ++ " has an unexpected type."
211− , Nothing
212− )
301+ report
302+ (Just region)
303+ ( "The " ++ ordinalize index ++ " argument to " ++ funcName maybeName
304+ ++ " is causing a mismatch."
305+ )
306+ ( "The " ++ ordinalize index ++ " to " ++ funcName maybeName ++ " should be:"
307+
308+ ++ pretty leftType
309+
310+ ++ "But it is:"
311+
312+ ++ pretty rightType
313+
314+ ++ maybe "" reasonToString maybeReason
315+ )
213316
214317 FunctionArity maybeName expected actual region ->
215318 let
216319 s = if expected <= 1 then "" else "s"
217320 in
218− ( Just region
219− , capitalize (funcName maybeName) ++ " is expecting " ++ show expected
220− ++ " argument" ++ s ++ ", but was given " ++ show actual ++ "."
221− , Nothing
222− )
321+ report
322+ (Just region)
323+ ( capitalize (funcName maybeName) ++ " is expecting " ++ show expected
324+ ++ " argument" ++ s ++ ", but was given " ++ show actual ++ "."
325+ )
326+ ( error "TODO are the types interesting here?"
327+ )
223328
224329 BadTypeAnnotation name ->
225− ( Nothing
226− , "The type annotation for `" ++ name ++ "` does not match its definition."
227− , Nothing
228− )
330+ report
331+ Nothing
332+ ( "The type annotation for `" ++ name ++ "` does not match its definition."
333+ )
334+ ( "Based on the actual definition, the type should be:\n"
335+
336+ ++ pretty rightType
337+ )
229338
230339 Instance name ->
231− ( Nothing
232− , "Given how `" ++ name ++ "` is defined, this use will not work out."
233− , Nothing
234− )
340+ report
341+ Nothing
342+ ( "This usage of `" ++ name ++ "` is causing a type mismatch."
343+ )
344+ ( "Based on its definition, `" ++ name ++ "` has this type:"
345+
346+ ++ pretty leftType
347+
348+ ++ "But you are trying to use it as:"
349+
350+ ++ pretty rightType
351+ )
235352
236353 Literal name ->
237− ( Nothing
238− , "This " ++ name ++ " value is being used as if it is some other type of value."
239− , Nothing
240− )
354+ report
355+ Nothing
356+ ( "This " ++ name ++ " value is being used as if it is some other type of value."
357+ )
358+ ( "You are trying to use this " ++ name ++ " as this type:"
359+
360+ ++ pretty rightType
361+ )
241362
242363 Pattern patErr ->
243364 let
@@ -248,41 +369,129 @@ hintToString hint =
248369 PData name -> "`" ++ name ++ "`"
249370 PRecord -> "a record"
250371 in
251− ( Nothing
252− , "Problem with " ++ thing ++ " in this pattern match."
253− , Nothing
254− )
372+ report
373+ Nothing
374+ ( "Problem with " ++ thing ++ " in this pattern match."
375+ )
376+ ( "This pattern matches things of type:"
377+
378+ ++ pretty leftType
379+
380+ ++ "But the values it will actually be trying to match are:"
381+
382+ ++ pretty rightType
383+ )
255384
256385 Shader ->
257− ( Nothing
258− , "There is some problem with this GLSL shader."
259− , Nothing
260− )
386+ report
387+ Nothing
388+ ( "There is some problem with this GLSL shader."
389+ )
390+ ( error "TODO generic error"
391+ )
261392
262393 Range ->
263− ( Nothing
264− , "The low and high members of this list range are not the same type of value."
265− , Nothing
266− )
394+ report
395+ Nothing
396+ ( "The low and high members of this list range are not the same type of value."
397+ )
398+ ( "The low end of the range has type:"
399+
400+ ++ pretty leftType
401+
402+ ++ "But the high end is:"
403+
404+ ++ pretty rightType
405+ )
267406
268407 Lambda ->
269− ( Nothing
270− , "This anonymous function is being used in an unexpected way."
271− , Nothing
272− )
408+ report
409+ Nothing
410+ ( "This anonymous function is being used in an unexpected way."
411+ )
412+ ( "The anonymous function has type:"
413+
414+ ++ pretty leftType
415+
416+ ++ "But you are trying to use it as:"
417+
418+ ++ pretty rightType
419+ )
273420
274421 Record ->
275− ( Nothing
276− , "This record is being used in an unexpected way."
277− , Nothing
278− )
422+ report
423+ Nothing
424+ ( "This record is being used in an unexpected way."
425+ )
426+ ( "The record has type:"
427+
428+ ++ pretty leftType
429+
430+ ++ "But you are trying to use it as:"
431+
432+ ++ pretty rightType
433+ )
434+
435+
436+reasonToString :: Reason -> String
437+reasonToString reason =
438+ case reason of
439+ MessyFields expecteds [] ->
440+ genericMissingFieldsMessage "former" expecteds
441+
442+ MessyFields [] actuals ->
443+ genericMissingFieldsMessage "latter" actuals
444+
445+ MessyFields expecteds actuals ->
446+ case concatMap (similarNames actuals) expecteds of
447+ [] ->
448+ "These records look pretty different."
449+
450+ [(exp,act)] ->
451+ "Looks like a misspelling between field " ++ exp ++ " and " ++ act ++ "."
452+
453+ potentialTypos ->
454+ "There are some potential typos in the record field names.\n"
455+ ++ concatMap (\(exp,act) -> "\n " ++ exp ++ " <=> " ++ act) potentialTypos
456+
457+ NotRecord ->
458+ "A record cannot be merged with other types of values."
459+
460+ TooLongComparableTuple len ->
461+ error "TODO"
462+
463+ Rigid maybeName ->
464+ error "TODO"
465+
466+
467+similarNames :: [String] -> String -> [(String,String)]
468+similarNames otherKeys key =
469+ map ((,) key) (filter (\key' -> Help.distance key key' == 1) otherKeys)
470+
471+
472+
473+genericMissingFieldsMessage :: String -> [String] -> String
474+genericMissingFieldsMessage latterOrFormer fields =
475+ "A record in the " ++ latterOrFormer ++ " type is missing "
476+ ++
477+ case fields of
478+ [key] ->
479+ "field `" ++ key ++ "`"
480+
481+ [key1,key2] ->
482+ "fields " ++ key1 ++ " and " ++ key2
483+
484+ keys ->
485+ "fields " ++ List.intercalate ", " (init keys) ++ ", and " ++ last keys
279486
280487
281488prettyOperator :: Var.Canonical -> String
282489prettyOperator (Var.Canonical _ opName) =
283− if Help.isOp opName
284− then "(" ++ opName ++ ")"
285− else "`" ++ opName ++ "`"
490+ if AstHelp.isOp opName then
491+ "(" ++ opName ++ ")"
492+
493+ else
494+ "`" ++ opName ++ "`"
286495
287496
288497funcName :: Maybe Var.Canonical -> String