git.iko.soy/elk
on master help sign in
Make hinting aware of position in record
d5f706fEvan Czaplicki
src/Reporting/Error/Type.hs+75−19
compare with master
unifiedsplit
@@ -1,11 +1,13 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Type where
2module Reporting.Error.Type where
3
3
4+import Control.Arrow (first, second)
5+import qualified Data.List as List
4import qualified Data.Map as Map
6import qualified Data.Map as Map
5import qualified Data.Maybe as Maybe
7import qualified Data.Maybe as Maybe
6import Text.PrettyPrint.ANSI.Leijen
8import Text.PrettyPrint.ANSI.Leijen
7 ( Doc, (<>), (<+>), colon, dullyellow
9 ( Doc, (<>), (<+>), colon, dullyellow
8− , fillSep, hang, indent, text, underline, vcat
10+ , fillSep, indent, text, underline, vcat
9 )
11 )
10
12
11import qualified AST.Type as Type
13import qualified AST.Type as Type
@@ -36,7 +38,7 @@ data Mismatch = MismatchInfo
36
38
37
39
38data Reason
40data Reason
39− = BadFields [String]
41+ = BadFields [(String, Maybe Reason)]
40 | MessyFields [String] [String]
42 | MessyFields [String] [String]
41 | IntFloat
43 | IntFloat
42 | TooLongComparableTuple Int
44 | TooLongComparableTuple Int
@@ -585,7 +587,7 @@ flipReason :: Reason -> Reason
585flipReason reason =
587flipReason reason =
586 case reason of
588 case reason of
587 BadFields fields ->
589 BadFields fields ->
588− BadFields fields
590+ BadFields (map (second (fmap flipReason)) fields)
589
591
590 MessyFields leftOnly rightOnly ->
592 MessyFields leftOnly rightOnly ->
591 MessyFields rightOnly leftOnly
593 MessyFields rightOnly leftOnly
@@ -606,15 +608,62 @@ flipReason reason =
606reasonToString :: Reason -> Maybe Doc
608reasonToString :: Reason -> Maybe Doc
607reasonToString reason =
609reasonToString reason =
608 let
610 let
609− go msg =
611+ (fields, maybeDeepReason) =
610− Just (toHint msg)
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 ++ "`. "
611 in
627 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 =
612 case reason of
644 case reason of
613− BadFields [field] ->
645+ BadFields [(field, Nothing)] ->
614− go $ "It looks like a problem with the `" ++ field ++ "` field."
646+ ([field], Nothing)
647+
648+ BadFields [(field, Just subReason)] ->
649+ first (field:) (collectFields subReason)
615
650
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
616 BadFields fields ->
662 BadFields fields ->
663+ go $
664+ "I am seeing issues with the "
617− go $ "I found problems in these fields: " ++ Help.commaSep fields
665+ ++ Help.commaSep (map fst fields) ++ " fields. "
666+ ++ badFieldElaboration
618
667
619 MessyFields leftOnly rightOnly ->
668 MessyFields leftOnly rightOnly ->
620 do let typos = Help.findPotentialTypos leftOnly rightOnly
669 do let typos = Help.findPotentialTypos leftOnly rightOnly
@@ -622,7 +671,7 @@ reasonToString reason =
622 misspellingMessage typos
671 misspellingMessage typos
623
672
624 IntFloat ->
673 IntFloat ->
625− go
674+ go $
626 "Elm does not automatically convert between Ints and Floats. Use\
675 "Elm does not automatically convert between Ints and Floats. Use\
627 \ `toFloat` and `round` to do specific conversions.\
676 \ `toFloat` and `round` to do specific conversions.\
628 \ <http://package.elm-lang.org/packages/elm-lang/core/latest/Basics#toFloat>"
677 \ <http://package.elm-lang.org/packages/elm-lang/core/latest/Basics#toFloat>"
@@ -659,6 +708,13 @@ reasonToString reason =
659 Nothing
708 Nothing
660
709
661
710
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+
662singleRigidError :: String
718singleRigidError :: String
663singleRigidError =
719singleRigidError =
664 "A type annotation is too generic. You can probably just switch to the\
720 "A type annotation is too generic. You can probably just switch to the\
@@ -683,20 +739,20 @@ toHint str =
683 fillSep (hintDoc : map text (words str))
739 fillSep (hintDoc : map text (words str))
684
740
685
741
686−misspellingMessage :: [(String,String)] -> Maybe Doc
742+misspellingMessage :: [(String,String)] -> Maybe (String, [Doc])
687misspellingMessage typos =
743misspellingMessage typos =
688 if null typos then
744 if null typos then
689− Nothing
745+ Nothing
690
746
691 else
747 else
692− let
748+ let
693− maxLen =
749+ maxLen =
694− maximum (map (length . fst) typos)
750+ maximum (map (length . fst) typos)
695− in
751+ in
696− Just $ hang 4 $ vcat $
752+ Just
697− toHint "I compared the record fields and found some potential typos."
753+ ( "I compared the record fields and found some potential typos."
698− : text ""
699− : map (pad maxLen) typos
754+ , text "" : map (pad maxLen) typos
755+ )
700
756
701
757
702pad :: Int -> (String, String) -> Doc
758pad :: Int -> (String, String) -> Doc
src/Type/Unify.hs+3−3
@@ -667,15 +667,15 @@ unifySharedFieldsHelp context sharedFields =
667 mismatch context (Just (Error.BadFields (reverse badFields)))
667 mismatch context (Just (Error.BadFields (reverse badFields)))
668
668
669
669
670−unifyField :: Context -> (String, (Variable, Variable)) -> Unify (Maybe String)
670+unifyField :: Context -> (String, (Variable, Variable)) -> Unify (Maybe (String, Maybe Error.Reason))
671unifyField context (field, (expected, actual)) =
671unifyField context (field, (expected, actual)) =
672 do result <- lift $ runExceptT $ subUnify context expected actual
672 do result <- lift $ runExceptT $ subUnify context expected actual
673 case result of
673 case result of
674 Right () ->
674 Right () ->
675 return $ Nothing
675 return $ Nothing
676
676
677− Left _ ->
677+ Left (Mismatch maybeReason) ->
678− return $ Just field
678+ return $ Just (field, maybeReason)
679
679
680
680
681
681