git.iko.soy/elk
on master help sign in
Better errors for large record types
dd084ffEvan Czaplicki
src/Reporting/Error/Type.hs+11−1
compare with master
unifiedsplit
@@ -36,7 +36,8 @@ data Mismatch = MismatchInfo
36
36
37
37
38data Reason
38data Reason
39+ = BadFields [String]
39− = MessyFields [String] [String]
40+ | MessyFields [String] [String]
40 | IntFloat
41 | IntFloat
41 | TooLongComparableTuple Int
42 | TooLongComparableTuple Int
42 | MissingArgs Int
43 | MissingArgs Int
@@ -583,6 +584,9 @@ funcName maybeVar =
583flipReason :: Reason -> Reason
584flipReason :: Reason -> Reason
584flipReason reason =
585flipReason reason =
585 case reason of
586 case reason of
587+ BadFields fields ->
588+ BadFields fields
589+
586 MessyFields leftOnly rightOnly ->
590 MessyFields leftOnly rightOnly ->
587 MessyFields rightOnly leftOnly
591 MessyFields rightOnly leftOnly
588
592
@@ -606,6 +610,12 @@ reasonToString reason =
606 Just (toHint msg)
610 Just (toHint msg)
607 in
611 in
608 case reason of
612 case reason of
613+ BadFields [field] ->
614+ go $ "It looks like a problem with the `" ++ field ++ "` field."
615+
616+ BadFields fields ->
617+ go $ "I found problems in these fields: " ++ Help.commaSep fields
618+
609 MessyFields leftOnly rightOnly ->
619 MessyFields leftOnly rightOnly ->
610 do let typos = Help.findPotentialTypos leftOnly rightOnly
620 do let typos = Help.findPotentialTypos leftOnly rightOnly
611 _ <- Help.vetTypos typos
621 _ <- Help.vetTypos typos
src/Type/Unify.hs+25−1
@@ -4,6 +4,7 @@ module Type.Unify (unify) where
4import Control.Monad (zipWithM_)
4import Control.Monad (zipWithM_)
5import Control.Monad.Except (ExceptT, lift, liftIO, throwError, runExceptT)
5import Control.Monad.Except (ExceptT, lift, liftIO, throwError, runExceptT)
6import qualified Data.Map as Map
6import qualified Data.Map as Map
7+import qualified Data.Maybe as Maybe
7import qualified Data.UnionFind.IO as UF
8import qualified Data.UnionFind.IO as UF
8
9
9import qualified AST.Variable as Var
10import qualified AST.Variable as Var
@@ -616,7 +617,7 @@ unifyRecord context firstStructure secondStructure =
616 -- looking into whether the particular field types match.
617 -- looking into whether the particular field types match.
617 let unifySharedFields otherFields ext =
618 let unifySharedFields otherFields ext =
618 do let sharedFields = Map.intersectionWith (,) expFields actFields
619 do let sharedFields = Map.intersectionWith (,) expFields actFields
619− _ <- traverse (uncurry (subUnify context)) sharedFields
620+ unifySharedFieldsHelp context sharedFields
620 let allFields = Map.union (Map.map fst sharedFields) otherFields
621 let allFields = Map.union (Map.map fst sharedFields) otherFields
621 merge context (Structure (Record1 allFields ext))
622 merge context (Structure (Record1 allFields ext))
622
623
@@ -655,6 +656,29 @@ unifyRecord context firstStructure secondStructure =
655
656
656
657
657
658
659+unifySharedFieldsHelp :: Context -> Map.Map String (Variable, Variable) -> Unify ()
660+unifySharedFieldsHelp context sharedFields =
661+ do maybeBadFields <- traverse (unifyField context) (Map.toList sharedFields)
662+ case Maybe.catMaybes maybeBadFields of
663+ [] ->
664+ return ()
665+
666+ badFields ->
667+ mismatch context (Just (Error.BadFields (reverse badFields)))
668+
669+
670+unifyField :: Context -> (String, (Variable, Variable)) -> Unify (Maybe String)
671+unifyField context (field, (expected, actual)) =
672+ do result <- lift $ runExceptT $ subUnify context expected actual
673+ case result of
674+ Right () ->
675+ return $ Nothing
676+
677+ Left _ ->
678+ return $ Just field
679+
680+
681+
658-- GATHER RECORD STRUCTURE
682-- GATHER RECORD STRUCTURE
659
683
660
684