git.iko.soy/elk
on master help sign in
Track expected/actual for error reasons
commitef59dd0cdda10cfa0c2558ff990333819f271bb3 authorEvan Czaplicki <info@elm-lang.org> dateThu 22 Oct 2015, 15:46 (11 years ago) parente83bdc3
2 files changed+124−86
compare with master
unifiedsplit
src/Reporting/Error/Type.hs+55−29 src/Type/Unify.hs+69−57
src/Reporting/Error/Type.hs+55−29
@@ -39,14 +39,17 @@ data Mismatch = MismatchInfo
3939
4040data Reason
4141 = MessyFields [String] [String]
42− | NotNumber
43− | NotComparable
44− | NotAppendable
45− | NotCompAppend
4642 | IntFloat
4743 | TooLongComparableTuple Int
44+ | BadVar (Maybe VarType) (Maybe VarType)
45+
46+
47+data VarType
48+ = Number
49+ | Comparable
50+ | Appendable
51+ | CompAppend
4852 | Rigid (Maybe String)
49− | DoubleRigid
5053
5154
5255data Hint
@@ -445,6 +448,22 @@ funcName maybeVar =
445448-- MISMTACH REASONS
446449
447450
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+
448467reasonToString :: Reason -> Maybe Doc
449468reasonToString reason =
450469 let
@@ -457,18 +476,6 @@ reasonToString reason =
457476 _ <- Help.vetTypos typos
458477 misspellingMessage typos
459478
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−
472479 IntFloat ->
473480 go
474481 "Elm does not automatically convert between Ints and Floats. Use\
@@ -480,20 +487,16 @@ reasonToString reason =
480487 "Although tuples are comparable, this is currently only supported\
481488 \ for tuples with 6 or fewer entries, not " ++ show len ++ "."
482489
483− Rigid (Just name) ->
484− go $
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+ BadVar (Just Comparable) _ ->
491+ go "Only ints, floats, chars, strings, lists, and tuples are comparable."
490492
491− Rigid Nothing ->
492− go $
493− "It is very likely that a type annotation is too generic. One type is saying\
494− \ *many* kinds of value can be given, but the other needs a more specific type."
493+ BadVar (Just Appendable) _ ->
494+ go "Only strings, text, and lists are appendable."
495+
496+ BadVar (Just CompAppend) _ ->
497+ go "Only strings and lists are both comparable and appendable."
495498
496− DoubleRigid ->
499+ BadVar (Just (Rigid _)) (Just (Rigid _)) ->
497500 Just $ Help.stack $
498501 [ hintDoc <> text "This usually happens when a few factors come together."
499502 , indent 4 $ vcat $
@@ -506,6 +509,29 @@ reasonToString reason =
506509 \ commenting out the inner type annotations."
507510 ]
508511
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."
509535
510536
511537hintDoc :: Doc
src/Type/Unify.hs+69−57
@@ -78,20 +78,46 @@ data Mismatch
7878mismatch :: Context -> Maybe Error.Reason -> Unify a
7979mismatch (Context orientation first _ second _) maybeReason =
8080 let
81− (expected, actual) =
81+ (expected, actual, orientedReason) =
8282 case orientation of
8383 ExpectedActual ->
84− (first, second)
84+ (first, second, maybeReason)
8585
8686 ActualExpected ->
87− (second, first)
87+ (second, first, Error.flipReason <$> maybeReason)
8888 in
89− throwError (Mismatch expected actual maybeReason)
89+ throwError (Mismatch expected actual orientedReason)
9090
9191
92−rigidityError :: Context -> Maybe String -> Unify ()
93−rigidityError context maybeName =
94− mismatch context (Just (Error.Rigid maybeName))
92+badRigid :: Maybe String -> Error.Reason
93+badRigid 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
95121
96122
97123
@@ -218,19 +244,20 @@ unifyRigid context maybeSuper maybeName otherContent =
218244 if maybeSuper == otherMaybeSuper then
219245 merge context (Var Rigid maybeSuper maybeName)
220246 else
221− rigidityError context maybeName
247+ mismatch context (Just (badRigid maybeName))
222248
223− Var Rigid _ _ ->
224− mismatch context (Just Error.DoubleRigid)
249+ Var Rigid _ otherMaybeName ->
250+ mismatch context $ Just $
251+ doubleBad (Error.Rigid maybeName) (Error.Rigid otherMaybeName)
225252
226253 Atom _ ->
227− rigidityError context maybeName
254+ mismatch context (Just (badRigid maybeName))
228255
229256 Alias _ _ _ ->
230− rigidityError context maybeName
257+ mismatch context (Just (badRigid maybeName))
231258
232259 Structure _ ->
233− rigidityError context maybeName
260+ mismatch context (Just (badRigid maybeName))
234261
235262
236263-- UNIFY SUPER VARIABLES
@@ -246,26 +273,26 @@ unifySuper context super otherContent =
246273 if atomMatchesSuper super name then
247274 merge context otherContent
248275 else
249− mismatch context (Just (superReason super))
276+ mismatch context (Just (badSuper super))
250277
251278 Var Rigid Nothing maybeName ->
252− rigidityError context maybeName
279+ mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
253280
254281 Var Rigid (Just otherSuper) maybeName ->
255282 if super == otherSuper then
256283 merge context otherContent
257284 else
258− rigidityError context maybeName
285+ mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
259286
260287 Var Flex Nothing _ ->
261288 merge context (Var Flex (Just super) Nothing)
262289
263290 Var Flex (Just otherSuper) _ ->
264291 case combineSupers super otherSuper of
265− Nothing ->
266− mismatch context Nothing
292+ Left reason ->
293+ mismatch context (Just reason)
267294
268− Just newSuper ->
295+ Right newSuper ->
269296 merge context (Var Flex (Just newSuper) Nothing)
270297
271298 Alias _ _ realVar ->
@@ -275,42 +302,27 @@ unifySuper context super otherContent =
275302 return ()
276303
277304
278−combineSupers :: Super -> Super -> Maybe Super
305+combineSupers :: Super -> Super -> Either Error.Reason Super
279306combineSupers firstSuper secondSuper =
280307 case (firstSuper, secondSuper) of
281− (Number , Number ) -> Just Number
282− (Comparable, Number ) -> Just Number
283− (Number , Comparable) -> Just Number
284−
285− (Comparable, Comparable) -> Just Comparable
286− (Appendable, Appendable) -> Just Appendable
308+ (Number , Number ) -> Right Number
309+ (Comparable, Number ) -> Right Number
310+ (Number , Comparable) -> Right Number
287311
288− (Appendable, Comparable) -> Just CompAppend
289− (Comparable, Appendable) -> Just CompAppend
312+ (Comparable, Comparable) -> Right Comparable
313+ (Appendable, Appendable) -> Right Appendable
290314
291− (CompAppend, CompAppend) -> Just CompAppend
292− (CompAppend, Comparable) -> Just CompAppend
293− (Comparable, CompAppend) -> Just CompAppend
294− (CompAppend, Appendable) -> Just CompAppend
295− (Appendable, CompAppend) -> Just CompAppend
315+ (Appendable, Comparable) -> Right CompAppend
316+ (Comparable, Appendable) -> Right CompAppend
296317
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
298323
299−
300−superReason :: Super -> Error.Reason
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
324+ (_ , _ ) ->
325+ Left $ doubleBad (errorSuper firstSuper) (errorSuper secondSuper)
314326
315327
316328isPrimitiveFrom :: [String] -> Var.Canonical -> Bool
@@ -339,12 +351,12 @@ unifySuperStructure context super term =
339351 do appStructure <- liftIO (collectApps (Structure term))
340352 case appStructure of
341353 Other ->
342− mismatch context (Just (superReason super))
354+ mismatch context (Just (badSuper super))
343355
344356 List variable ->
345357 case super of
346358 Number ->
347− mismatch context (Just Error.NotNumber)
359+ mismatch context (Just (badSuper super))
348360
349361 Appendable ->
350362 merge context (Structure term)
@@ -360,10 +372,10 @@ unifySuperStructure context super term =
360372 Tuple entries ->
361373 case super of
362374 Number ->
363− mismatch context (Just Error.NotNumber)
375+ mismatch context (Just (badSuper super))
364376
365377 Appendable ->
366− mismatch context (Just Error.NotAppendable)
378+ mismatch context (Just (badSuper super))
367379
368380 Comparable ->
369381 if length entries > 6 then
@@ -374,7 +386,7 @@ unifySuperStructure context super term =
374386 mapM_ (unifyComparableRecursive (_orientation context)) entries
375387
376388 CompAppend ->
377− mismatch context (Just Error.NotCompAppend)
389+ mismatch context (Just (badSuper super))
378390
379391
380392unifyComparableRecursive :: Orientation -> Variable -> Unify ()
@@ -443,10 +455,10 @@ unifyAtom context name otherContent =
443455 merge context (Atom name)
444456
445457 else
446− mismatch context (Just (superReason super))
458+ mismatch context (Just ((Error.flipReason (badSuper super))))
447459
448460 Var Rigid _ maybeName ->
449− rigidityError context maybeName
461+ mismatch context (Just (Error.flipReason (badRigid maybeName)))
450462
451463 Atom otherName ->
452464 if name == otherName then
@@ -519,7 +531,7 @@ unifyStructure context term otherContent =
519531 unifySuper (reorient context) super (Structure term)
520532
521533 Var Rigid _ maybeName ->
522− rigidityError context maybeName
534+ mismatch context (Just (Error.flipReason (badRigid maybeName)))
523535
524536 Atom _ ->
525537 mismatch context Nothing