@@ -2,7 +2,10 @@
22module Reporting.Error.Type where
33
44import qualified Data.Maybe as Maybe
5−import Text.PrettyPrint.ANSI.Leijen (Doc, (<+>), equals, indent, text)
5+import Text.PrettyPrint.ANSI.Leijen
6+ ( Doc, (<>), (<+>), colon, dullyellow, equals
7+ , fillSep, hang, indent, text, underline, vcat
8+ )
69
710import qualified AST.Type as Type
811import qualified AST.Variable as Var
@@ -111,11 +114,11 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =
111114 report =
112115 Report.report "TYPE MISMATCH"
113116
114− reasonHints =
115− Maybe.maybeToList (fmap reasonToString maybeReason)
116−
117117 cmpHint leftWords rightWords extraHints =
118− comparisonHint localizer leftType rightType leftWords rightWords (extraHints ++ reasonHints)
118+ comparisonHint localizer leftType rightType leftWords rightWords
119+ ( map toHint extraHints
120+ ++ Maybe.maybeToList (fmap reasonToString maybeReason)
121+ )
119122 in
120123 case hint of
121124 CaseBranch branchNumber region ->
@@ -377,7 +380,7 @@ comparisonHint
377380 -> Type.Canonical
378381 -> String
379382 -> String
380− -> [String]
383+ -> [Doc]
381384 -> Doc
382385comparisonHint localizer leftType rightType leftWords rightWords finalHints =
383386 let
@@ -391,7 +394,11 @@ comparisonHint localizer leftType rightType leftWords rightWords finalHints =
391394 , indent 4 rightDoc
392395 ]
393396 ++
394− map Help.reflowParagraph finalHints
397+ finalHints
398+
399+
400+
401+-- MISMATCH HELPERS
395402
396403
397404ordinalPair :: Int -> String
@@ -399,33 +406,44 @@ ordinalPair number =
399406 Help.ordinalize (number -1 ) ++ " and " ++ Help.ordinalize number
400407
401408
409+prettyName :: Var.Canonical -> String
410+prettyName (Var.Canonical _ opName) =
411+ Help.functionName opName
402412
403−-- MISMTACH REASONS
404413
414+funcName :: Maybe Var.Canonical -> String
415+funcName maybeVar =
416+ case maybeVar of
417+ Nothing ->
418+ "this function"
405419
406−reasonToString :: Reason -> String
407−reasonToString reason =
408− case reason of
409− MessyFields expecteds [] ->
410− genericMissingFieldsMessage "former" expecteds
420+ Just var ->
421+ "function " ++ prettyName var
411422
412− MessyFields [] actuals ->
413− genericMissingFieldsMessage "latter" actuals
414423
415− MessyFields expecteds actuals ->
416− case concatMap (similarNames actuals) expecteds of
417− [] ->
418− "These records look pretty different."
419424
420− [(ex,ac)] ->
421− "Looks like a misspelling between field " ++ ex ++ " and " ++ ac ++ "."
425+-- MISMTACH REASONS
422426
423− potentialTypos ->
424− "There are some potential typos in the record field names.\n"
425− ++ concatMap (\(ex,ac) -> "\n " ++ ex ++ " <=> " ++ ac) potentialTypos
427+
428+reasonToString :: Reason -> Doc
429+reasonToString reason =
430+ case reason of
431+ MessyFields leftOnly rightOnly ->
432+ let
433+ maybeMessage =
434+ do let typos = RenderType.findPotentialTypos leftOnly rightOnly
435+ RenderType.vetTypos typos
436+ misspellingMessage typos
437+ in
438+ case maybeMessage of
439+ Just doc ->
440+ doc
441+
442+ Nothing ->
443+ error "TODO"
426444
427445 NotRecord ->
428− "A record cannot be merged with other types of values."
446+ toHint "A record cannot be merged with other types of values."
429447
430448 TooLongComparableTuple len ->
431449 error "TODO"
@@ -434,30 +452,38 @@ reasonToString reason =
434452 error "TODO"
435453
436454
437−similarNames :: [String] -> String -> [(String,String)]
438−similarNames otherKeys key =
439− map ((,) key) (filter (\key' -> Help.distance key key' == 1) otherKeys)
455+hintDoc :: Doc
456+hintDoc =
457+ underline (text "Hint") <> colon
440458
441459
442−genericMissingFieldsMessage :: String -> [String] -> String
443−genericMissingFieldsMessage latterOrFormer fields =
444− "A record in the " ++ latterOrFormer ++ " type is missing field"
445− ++ Help.commaSep fields
460+toHint :: String -> Doc
461+toHint str =
462+ fillSep (hintDoc : map text (words str))
446463
447464
448−prettyName :: Var.Canonical -> String
449−prettyName (Var.Canonical _ opName) =
450− Help.functionName opName
465+misspellingMessage :: [(String,String)] -> Maybe Doc
466+misspellingMessage typos =
467+ if null typos then
468+ Nothing
451469
470+ else
471+ let
472+ maxLen =
473+ maximum (map (length . fst) typos)
474+ in
475+ Just $ hang 4 $ vcat $
476+ toHint "I compared the record fields and found some potential typos."
477+ : text ""
478+ : map (pad maxLen) typos
452479
453−funcName :: Maybe Var.Canonical -> String
454−funcName maybeVar =
455− case maybeVar of
456− Nothing ->
457− "this function"
458480
459− Just var ->
460− "function " ++ prettyName var
481+pad :: Int -> (String, String) -> Doc
482+pad maxLen (leftField, rightField) =
483+ text (replicate (maxLen - length leftField) ' ')
484+ <> dullyellow (text leftField)
485+ <+> text "<->"
486+ <+> dullyellow (text rightField)
461487
462488
463489