git.iko.soy/elk
on master help sign in
Better error messages for bad record accesses
b17a4f0Evan Czaplicki
src/AST/Expression/General.hs+20
compare with master
unifiedsplit
@@ -8,6 +8,8 @@ enrich the AST with more information.
8-}
8-}
9module AST.Expression.General where
9module AST.Expression.General where
10
10
11+import qualified Data.List as List
12+
11import qualified AST.Effects as Effects
13import qualified AST.Effects as Effects
12import qualified AST.Literal as Literal
14import qualified AST.Literal as Literal
13import qualified AST.Module.Name as ModuleName
15import qualified AST.Module.Name as ModuleName
@@ -88,6 +90,24 @@ tuple expressions =
88 Data ("_Tuple" ++ show (length expressions)) expressions
90 Data ("_Tuple" ++ show (length expressions)) expressions
89
91
90
92
93+collectFields :: (Var.ToString var) => Expr ann def var typ -> Maybe String
94+collectFields expr =
95+ collectFieldsHelp expr []
96+
97+
98+collectFieldsHelp :: (Var.ToString var) => Expr ann def var typ -> [String] -> Maybe String
99+collectFieldsHelp (A.A _ expr) fields =
100+ case expr of
101+ Var var ->
102+ Just (List.intercalate "." (Var.toString var : fields))
103+
104+ Access record field ->
105+ collectFieldsHelp record (field : fields)
106+
107+ _ ->
108+ Nothing
109+
110+
91collectApps :: Expr ann def var typ -> [Expr ann def var typ]
111collectApps :: Expr ann def var typ -> [Expr ann def var typ]
92collectApps annExpr@(A.A _ expr) =
112collectApps annExpr@(A.A _ expr) =
93 case expr of
113 case expr of
src/Reporting/Error/Type.hs+31−5
@@ -75,6 +75,7 @@ data Hint
75 | Pattern Pattern
75 | Pattern Pattern
76 | Shader
76 | Shader
77 | Lambda
77 | Lambda
78+ | Access (Maybe String) String
78 | Record
79 | Record
79 -- effect manager problems
80 -- effect manager problems
80 | Manager String
81 | Manager String
@@ -145,11 +146,12 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =
145 report =
146 report =
146 Report.report "TYPE MISMATCH"
147 Report.report "TYPE MISMATCH"
147
148
149+ typicalHints =
150+ Maybe.maybeToList (reasonToString =<< maybeReason)
151+
148 cmpHint leftWords rightWords extraHints =
152 cmpHint leftWords rightWords extraHints =
149 comparisonHint localizer leftType rightType leftWords rightWords
153 comparisonHint localizer leftType rightType leftWords rightWords
150− ( Maybe.maybeToList (reasonToString =<< maybeReason)
151− ++ map toHint extraHints
154+ (typicalHints ++ map toHint extraHints)
152− )
153 in
155 in
154 case hint of
156 case hint of
155 CaseBranch branchNumber region ->
157 CaseBranch branchNumber region ->
@@ -446,6 +448,30 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =
446 []
448 []
447 )
449 )
448
450
451+ Access (Just body) field ->
452+ let
453+ header =
454+ "`" ++ body ++ "` does not have a field named `" ++ field ++ "`."
455+ in
456+ report Nothing header $ Help.stack $
457+ [ Help.reflowParagraph $ "The type of `" ++ body ++ "` is:"
458+ , indent 4 $ dullyellow $ RenderType.toDoc localizer leftType
459+ , Help.reflowParagraph $ "Which does not contain a field named `" ++ field ++ "`."
460+ ]
461+ ++ typicalHints
462+
463+ Access Nothing field ->
464+ let
465+ header =
466+ "Cannot access a field named `" ++ field ++ "`."
467+ in
468+ report Nothing header $ Help.stack $
469+ [ Help.reflowParagraph $ "You are trying to get `" ++ field ++ "` from a value with this type:"
470+ , indent 4 $ dullyellow $ RenderType.toDoc localizer leftType
471+ , Help.reflowParagraph $ "It is not in there!"
472+ ]
473+ ++ typicalHints
474+
449 Record ->
475 Record ->
450 report
476 report
451 Nothing
477 Nothing
@@ -653,7 +679,7 @@ reasonToString reason =
653 (fields, maybeDeepReason) =
679 (fields, maybeDeepReason) =
654 collectFields reason
680 collectFields reason
655
681
656− mabyeDocs =
682+ maybeDocs =
657 reasonToStringHelp =<< maybeDeepReason
683 reasonToStringHelp =<< maybeDeepReason
658
684
659 starter =
685 starter =
@@ -667,7 +693,7 @@ reasonToString reason =
667 _ ->
693 _ ->
668 Just $ "Problem at `" ++ List.intercalate "." fields ++ "`. "
694 Just $ "Problem at `" ++ List.intercalate "." fields ++ "`. "
669 in
695 in
670− case (starter, mabyeDocs) of
696+ case (starter, maybeDocs) of
671 (Nothing, Nothing) ->
697 (Nothing, Nothing) ->
672 Nothing
698 Nothing
673
699
src/Type/Constrain/Expression.hs+8−3
@@ -110,9 +110,14 @@ constrain env annotatedExpr@(A.A region expression) tipe =
110 do c' <- constrain env e x
110 do c' <- constrain env e x
111 return (x ==> t, c /\ c')
111 return (x ==> t, c /\ c')
112
112
113− E.Access expr label ->
113+ E.Access expr field ->
114+ exists $ \recordType ->
114− exists $ \t ->
115+ exists $ \ext ->
116+ do recordCon <- constrain env expr recordType
117+ let maybeBody = E.collectFields expr
115− constrain env expr (record (Map.singleton label tipe) t)
118+ let desiredType = record (Map.singleton field tipe) ext
119+ let fieldCon = CEqual (Error.Access maybeBody field) region recordType desiredType
120+ return $ recordCon /\ fieldCon
116
121
117 E.Update expr fields ->
122 E.Update expr fields ->
118 exists $ \t ->
123 exists $ \t ->