@@ -1,11 +1,13 @@
11{-# OPTIONS_GHC -Wall #-}
22module Reporting.Error.Type where
33
4+import Control.Arrow (first, second)
5+import qualified Data.List as List
46import qualified Data.Map as Map
57import qualified Data.Maybe as Maybe
68import Text.PrettyPrint.ANSI.Leijen
79 ( Doc, (<>), (<+>), colon, dullyellow
8− , fillSep, hang, indent, text, underline, vcat
10+ , fillSep, indent, text, underline, vcat
911 )
1012
1113import qualified AST.Type as Type
@@ -36,7 +38,7 @@ data Mismatch = MismatchInfo
3638
3739
3840data Reason
39− = BadFields [String]
41+ = BadFields [(String, Maybe Reason)]
4042 | MessyFields [String] [String]
4143 | IntFloat
4244 | TooLongComparableTuple Int
@@ -585,7 +587,7 @@ flipReason :: Reason -> Reason
585587flipReason reason =
586588 case reason of
587589 BadFields fields ->
588− BadFields fields
590+ BadFields (map (second (fmap flipReason)) fields)
589591
590592 MessyFields leftOnly rightOnly ->
591593 MessyFields rightOnly leftOnly
@@ -606,15 +608,62 @@ flipReason reason =
606608reasonToString :: Reason -> Maybe Doc
607609reasonToString reason =
608610 let
609− go msg =
610− Just (toHint msg)
611+ (fields, maybeDeepReason) =
612+ collectFields reason
613+
614+ mabyeDocs =
615+ reasonToStringHelp =<< maybeDeepReason
616+
617+ starter =
618+ case fields of
619+ [] ->
620+ Nothing
621+
622+ [field] ->
623+ Just $ "Problem in the `" ++ field ++ "` field. "
624+
625+ _ ->
626+ Just $ "Problem at `" ++ List.intercalate "." fields ++ "`. "
611627 in
628+ case (starter, mabyeDocs) of
629+ (Nothing, Nothing) ->
630+ Nothing
631+
632+ (Just msg, Nothing) ->
633+ Just $ toHint (msg ++ badFieldElaboration)
634+
635+ (_, Just (firstLine, docs)) ->
636+ Just $ vcat $
637+ toHint (maybe firstLine (++firstLine) starter)
638+ : map (indent 4) docs
639+
640+
641+
642+collectFields :: Reason -> ([String], Maybe Reason)
643+collectFields reason =
612644 case reason of
613− BadFields [field] ->
614− go $ "It looks like a problem with the `" ++ field ++ "` field."
645+ BadFields [(field, Nothing)] ->
646+ ([field], Nothing)
647+
648+ BadFields [(field, Just subReason)] ->
649+ first (field:) (collectFields subReason)
615650
651+ _ ->
652+ ([], Just reason)
653+
654+
655+reasonToStringHelp :: Reason -> Maybe (String, [Doc])
656+reasonToStringHelp reason =
657+ let
658+ go msg =
659+ Just (msg, [])
660+ in
661+ case reason of
616662 BadFields fields ->
617− go $ "I found problems in these fields: " ++ Help.commaSep fields
663+ go $
664+ "I am seeing issues with the "
665+ ++ Help.commaSep (map fst fields) ++ " fields. "
666+ ++ badFieldElaboration
618667
619668 MessyFields leftOnly rightOnly ->
620669 do let typos = Help.findPotentialTypos leftOnly rightOnly
@@ -622,7 +671,7 @@ reasonToString reason =
622671 misspellingMessage typos
623672
624673 IntFloat ->
625− go
674+ go $
626675 "Elm does not automatically convert between Ints and Floats. Use\
627676 \ `toFloat` and `round` to do specific conversions.\
628677 \ <http://package.elm-lang.org/packages/elm-lang/core/latest/Basics#toFloat>"
@@ -659,6 +708,13 @@ reasonToString reason =
659708 Nothing
660709
661710
711+badFieldElaboration :: String
712+badFieldElaboration =
713+ "I always figure out field types in alphabetical order. If a field\
714+ \ seems fine, I assume it is \"correct\" in subsequent checks.\
715+ \ So the problem may actually be a weird interaction with previous fields."
716+
717+
662718singleRigidError :: String
663719singleRigidError =
664720 "A type annotation is too generic. You can probably just switch to the\
@@ -683,20 +739,20 @@ toHint str =
683739 fillSep (hintDoc : map text (words str))
684740
685741
686−misspellingMessage :: [(String,String)] -> Maybe Doc
742+misspellingMessage :: [(String,String)] -> Maybe (String, [Doc])
687743misspellingMessage typos =
688744 if null typos then
689− Nothing
745+ Nothing
690746
691747 else
692− let
693− maxLen =
694− maximum (map (length . fst) typos)
695− in
696− Just $ hang 4 $ vcat $
697− toHint "I compared the record fields and found some potential typos."
698− : text ""
699− : map (pad maxLen) typos
748+ let
749+ maxLen =
750+ maximum (map (length . fst) typos)
751+ in
752+ Just
753+ ( "I compared the record fields and found some potential typos."
754+ , text "" : map (pad maxLen) typos
755+ )
700756
701757
702758pad :: Int -> (String, String) -> Doc