git.iko.soy/elk
on master help sign in
Track expected/actual for error reasons
ef59dd0Evan Czaplicki
src/Reporting/Error/Type.hs+55−29
compare with master
unifiedsplit
@@ -39,14 +39,17 @@ data Mismatch = MismatchInfo
39
39
40data Reason
40data Reason
41 = MessyFields [String] [String]
41 = MessyFields [String] [String]
42− | NotNumber
43− | NotComparable
44− | NotAppendable
45− | NotCompAppend
46 | IntFloat
42 | IntFloat
47 | TooLongComparableTuple Int
43 | TooLongComparableTuple Int
44+ | BadVar (Maybe VarType) (Maybe VarType)
45+
46+
47+data VarType
48+ = Number
49+ | Comparable
50+ | Appendable
51+ | CompAppend
48 | Rigid (Maybe String)
52 | Rigid (Maybe String)
49− | DoubleRigid
50
53
51
54
52data Hint
55data Hint
@@ -445,6 +448,22 @@ funcName maybeVar =
445-- MISMTACH REASONS
448-- MISMTACH REASONS
446
449
447
450
451+flipReason :: Reason -> Reason
452+flipReason reason =
453+ case reason of
454+ MessyFields leftOnly rightOnly ->
455+ MessyFields rightOnly leftOnly
456+
457+ IntFloat ->
458+ IntFloat
459+
460+ TooLongComparableTuple len ->
461+ TooLongComparableTuple len
462+
463+ BadVar left right ->
464+ BadVar right left
465+
466+
448reasonToString :: Reason -> Maybe Doc
467reasonToString :: Reason -> Maybe Doc
449reasonToString reason =
468reasonToString reason =
450 let
469 let
@@ -457,18 +476,6 @@ reasonToString reason =
457 _ <- Help.vetTypos typos
476 _ <- Help.vetTypos typos
458 misspellingMessage typos
477 misspellingMessage typos
459
478
460− NotNumber ->
461− go "Valid number types include Int and Float."
462−
463− NotComparable ->
464− go "Valid comparable types include Int, Float, Char, String, lists, and tuples."
465−
466− NotAppendable ->
467− go "Valid appendable types include String, Text, and List."
468−
469− NotCompAppend ->
470− go "Valid `number` types include Int and Float."
471−
472 IntFloat ->
479 IntFloat ->
473 go
480 go
474 "Elm does not automatically convert between Ints and Floats. Use\
481 "Elm does not automatically convert between Ints and Floats. Use\
@@ -480,20 +487,16 @@ reasonToString reason =
480 "Although tuples are comparable, this is currently only supported\
487 "Although tuples are comparable, this is currently only supported\
481 \ for tuples with 6 or fewer entries, not " ++ show len ++ "."
488 \ for tuples with 6 or fewer entries, not " ++ show len ++ "."
482
489
483− Rigid (Just name) ->
490+ BadVar (Just Comparable) _ ->
484− go $
491+ go "Only ints, floats, chars, strings, lists, and tuples are comparable."
485− "It is very likely that a type annotation is too generic. Type variable\
486− \ `" ++ name ++ "` is saying *many* kinds of value can be given, but the\
487− \ actual definition needs a more specific type. I am not sure whether the\
488− \ type annotation or the definition is \"right\" though, you may have to\
489− \ make the annotation more specific or make the definition more generic."
490
492
491− Rigid Nothing ->
493+ BadVar (Just Appendable) _ ->
492− go $
494+ go "Only strings, text, and lists are appendable."
493− "It is very likely that a type annotation is too generic. One type is saying\
495+
494− \ *many* kinds of value can be given, but the other needs a more specific type."
496+ BadVar (Just CompAppend) _ ->
497+ go "Only strings and lists are both comparable and appendable."
495
498
496− DoubleRigid ->
499+ BadVar (Just (Rigid _)) (Just (Rigid _)) ->
497 Just $ Help.stack $
500 Just $ Help.stack $
498 [ hintDoc <> text "This usually happens when a few factors come together."
501 [ hintDoc <> text "This usually happens when a few factors come together."
499 , indent 4 $ vcat $
502 , indent 4 $ vcat $
@@ -506,6 +509,29 @@ reasonToString reason =
506 \ commenting out the inner type annotations."
509 \ commenting out the inner type annotations."
507 ]
510 ]
508
511
512+ BadVar (Just (Rigid (Just name))) _ ->
513+ go $
514+ "Looks like the type annotation is too generic. Type variable\
515+ \ `" ++ name ++ "` is saying *many* kinds of value can be given, but the\
516+ \ actual definition needs a more specific type. I am not sure whether the\
517+ \ type annotation or the definition is \"right\" though, you may have to\
518+ \ make the annotation more specific or make the definition more generic."
519+
520+ BadVar (Just (Rigid _)) _ ->
521+ go genericRigidError
522+
523+ BadVar _ (Just (Rigid _)) ->
524+ go genericRigidError
525+
526+ BadVar _ _ ->
527+ Nothing
528+
529+
530+genericRigidError :: String
531+genericRigidError =
532+ "There is some problem with a rigid type variable. It is very likely that a\
533+ \ type annotation is too generic. One type is saying *many* kinds of value\
534+ \ can be given, but the other needs a more specific type."
509
535
510
536
511hintDoc :: Doc
537hintDoc :: Doc
src/Type/Unify.hs+69−57
@@ -78,20 +78,46 @@ data Mismatch
78mismatch :: Context -> Maybe Error.Reason -> Unify a
78mismatch :: Context -> Maybe Error.Reason -> Unify a
79mismatch (Context orientation first _ second _) maybeReason =
79mismatch (Context orientation first _ second _) maybeReason =
80 let
80 let
81− (expected, actual) =
81+ (expected, actual, orientedReason) =
82 case orientation of
82 case orientation of
83 ExpectedActual ->
83 ExpectedActual ->
84− (first, second)
84+ (first, second, maybeReason)
85
85
86 ActualExpected ->
86 ActualExpected ->
87− (second, first)
87+ (second, first, Error.flipReason <$> maybeReason)
88 in
88 in
89− throwError (Mismatch expected actual maybeReason)
89+ throwError (Mismatch expected actual orientedReason)
90
90
91
91
92−rigidityError :: Context -> Maybe String -> Unify ()
92+badRigid :: Maybe String -> Error.Reason
93−rigidityError context maybeName =
93+badRigid maybeName =
94− mismatch context (Just (Error.Rigid maybeName))
94+ Error.BadVar (Just (Error.Rigid maybeName)) Nothing
95+
96+
97+badSuper :: Super -> Error.Reason
98+badSuper super =
99+ Error.BadVar (Just (errorSuper super)) Nothing
100+
101+
102+doubleBad :: Error.VarType -> Error.VarType -> Error.Reason
103+doubleBad vt1 vt2 =
104+ Error.BadVar (Just vt1) (Just vt2)
105+
106+
107+errorSuper :: Super -> Error.VarType
108+errorSuper super =
109+ case super of
110+ Number ->
111+ Error.Number
112+
113+ Comparable ->
114+ Error.Comparable
115+
116+ Appendable ->
117+ Error.Appendable
118+
119+ CompAppend ->
120+ Error.CompAppend
95
121
96
122
97
123
@@ -218,19 +244,20 @@ unifyRigid context maybeSuper maybeName otherContent =
218 if maybeSuper == otherMaybeSuper then
244 if maybeSuper == otherMaybeSuper then
219 merge context (Var Rigid maybeSuper maybeName)
245 merge context (Var Rigid maybeSuper maybeName)
220 else
246 else
221− rigidityError context maybeName
247+ mismatch context (Just (badRigid maybeName))
222
248
223− Var Rigid _ _ ->
249+ Var Rigid _ otherMaybeName ->
224− mismatch context (Just Error.DoubleRigid)
250+ mismatch context $ Just $
251+ doubleBad (Error.Rigid maybeName) (Error.Rigid otherMaybeName)
225
252
226 Atom _ ->
253 Atom _ ->
227− rigidityError context maybeName
254+ mismatch context (Just (badRigid maybeName))
228
255
229 Alias _ _ _ ->
256 Alias _ _ _ ->
230− rigidityError context maybeName
257+ mismatch context (Just (badRigid maybeName))
231
258
232 Structure _ ->
259 Structure _ ->
233− rigidityError context maybeName
260+ mismatch context (Just (badRigid maybeName))
234
261
235
262
236-- UNIFY SUPER VARIABLES
263-- UNIFY SUPER VARIABLES
@@ -246,26 +273,26 @@ unifySuper context super otherContent =
246 if atomMatchesSuper super name then
273 if atomMatchesSuper super name then
247 merge context otherContent
274 merge context otherContent
248 else
275 else
249− mismatch context (Just (superReason super))
276+ mismatch context (Just (badSuper super))
250
277
251 Var Rigid Nothing maybeName ->
278 Var Rigid Nothing maybeName ->
252− rigidityError context maybeName
279+ mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
253
280
254 Var Rigid (Just otherSuper) maybeName ->
281 Var Rigid (Just otherSuper) maybeName ->
255 if super == otherSuper then
282 if super == otherSuper then
256 merge context otherContent
283 merge context otherContent
257 else
284 else
258− rigidityError context maybeName
285+ mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
259
286
260 Var Flex Nothing _ ->
287 Var Flex Nothing _ ->
261 merge context (Var Flex (Just super) Nothing)
288 merge context (Var Flex (Just super) Nothing)
262
289
263 Var Flex (Just otherSuper) _ ->
290 Var Flex (Just otherSuper) _ ->
264 case combineSupers super otherSuper of
291 case combineSupers super otherSuper of
265− Nothing ->
292+ Left reason ->
266− mismatch context Nothing
293+ mismatch context (Just reason)
267
294
268− Just newSuper ->
295+ Right newSuper ->
269 merge context (Var Flex (Just newSuper) Nothing)
296 merge context (Var Flex (Just newSuper) Nothing)
270
297
271 Alias _ _ realVar ->
298 Alias _ _ realVar ->
@@ -275,42 +302,27 @@ unifySuper context super otherContent =
275 return ()
302 return ()
276
303
277
304
278−combineSupers :: Super -> Super -> Maybe Super
305+combineSupers :: Super -> Super -> Either Error.Reason Super
279combineSupers firstSuper secondSuper =
306combineSupers firstSuper secondSuper =
280 case (firstSuper, secondSuper) of
307 case (firstSuper, secondSuper) of
281− (Number , Number ) -> Just Number
308+ (Number , Number ) -> Right Number
282− (Comparable, Number ) -> Just Number
309+ (Comparable, Number ) -> Right Number
283− (Number , Comparable) -> Just Number
310+ (Number , Comparable) -> Right Number
284−
285− (Comparable, Comparable) -> Just Comparable
286− (Appendable, Appendable) -> Just Appendable
287
311
288− (Appendable, Comparable) -> Just CompAppend
312+ (Comparable, Comparable) -> Right Comparable
289− (Comparable, Appendable) -> Just CompAppend
313+ (Appendable, Appendable) -> Right Appendable
290
314
291− (CompAppend, CompAppend) -> Just CompAppend
292− (CompAppend, Comparable) -> Just CompAppend
315+ (Appendable, Comparable) -> Right CompAppend
293− (Comparable, CompAppend) -> Just CompAppend
316+ (Comparable, Appendable) -> Right CompAppend
294− (CompAppend, Appendable) -> Just CompAppend
295− (Appendable, CompAppend) -> Just CompAppend
296
317
297− (_ , _ ) -> Nothing
318+ (CompAppend, CompAppend) -> Right CompAppend
319+ (CompAppend, Comparable) -> Right CompAppend
320+ (Comparable, CompAppend) -> Right CompAppend
321+ (CompAppend, Appendable) -> Right CompAppend
322+ (Appendable, CompAppend) -> Right CompAppend
298
323
299−
324+ (_ , _ ) ->
300−superReason :: Super -> Error.Reason
325+ Left $ doubleBad (errorSuper firstSuper) (errorSuper secondSuper)
301−superReason super =
302− case super of
303− Number ->
304− Error.NotNumber
305−
306− Comparable ->
307− Error.NotComparable
308−
309− Appendable ->
310− Error.NotAppendable
311−
312− CompAppend ->
313− Error.NotCompAppend
314
326
315
327
316isPrimitiveFrom :: [String] -> Var.Canonical -> Bool
328isPrimitiveFrom :: [String] -> Var.Canonical -> Bool
@@ -339,12 +351,12 @@ unifySuperStructure context super term =
339 do appStructure <- liftIO (collectApps (Structure term))
351 do appStructure <- liftIO (collectApps (Structure term))
340 case appStructure of
352 case appStructure of
341 Other ->
353 Other ->
342− mismatch context (Just (superReason super))
354+ mismatch context (Just (badSuper super))
343
355
344 List variable ->
356 List variable ->
345 case super of
357 case super of
346 Number ->
358 Number ->
347− mismatch context (Just Error.NotNumber)
359+ mismatch context (Just (badSuper super))
348
360
349 Appendable ->
361 Appendable ->
350 merge context (Structure term)
362 merge context (Structure term)
@@ -360,10 +372,10 @@ unifySuperStructure context super term =
360 Tuple entries ->
372 Tuple entries ->
361 case super of
373 case super of
362 Number ->
374 Number ->
363− mismatch context (Just Error.NotNumber)
375+ mismatch context (Just (badSuper super))
364
376
365 Appendable ->
377 Appendable ->
366− mismatch context (Just Error.NotAppendable)
378+ mismatch context (Just (badSuper super))
367
379
368 Comparable ->
380 Comparable ->
369 if length entries > 6 then
381 if length entries > 6 then
@@ -374,7 +386,7 @@ unifySuperStructure context super term =
374 mapM_ (unifyComparableRecursive (_orientation context)) entries
386 mapM_ (unifyComparableRecursive (_orientation context)) entries
375
387
376 CompAppend ->
388 CompAppend ->
377− mismatch context (Just Error.NotCompAppend)
389+ mismatch context (Just (badSuper super))
378
390
379
391
380unifyComparableRecursive :: Orientation -> Variable -> Unify ()
392unifyComparableRecursive :: Orientation -> Variable -> Unify ()
@@ -443,10 +455,10 @@ unifyAtom context name otherContent =
443 merge context (Atom name)
455 merge context (Atom name)
444
456
445 else
457 else
446− mismatch context (Just (superReason super))
458+ mismatch context (Just ((Error.flipReason (badSuper super))))
447
459
448 Var Rigid _ maybeName ->
460 Var Rigid _ maybeName ->
449− rigidityError context maybeName
461+ mismatch context (Just (Error.flipReason (badRigid maybeName)))
450
462
451 Atom otherName ->
463 Atom otherName ->
452 if name == otherName then
464 if name == otherName then
@@ -519,7 +531,7 @@ unifyStructure context term otherContent =
519 unifySuper (reorient context) super (Structure term)
531 unifySuper (reorient context) super (Structure term)
520
532
521 Var Rigid _ maybeName ->
533 Var Rigid _ maybeName ->
522− rigidityError context maybeName
534+ mismatch context (Just (Error.flipReason (badRigid maybeName)))
523
535
524 Atom _ ->
536 Atom _ ->
525 mismatch context Nothing
537 mismatch context Nothing