Skip to content

Commit aa6fd30

Browse files
winitzkiwinitzki
committed
implement better error messages
1 parent df0330c commit aa6fd30

File tree

1 file changed

+33
-26
lines changed

1 file changed

+33
-26
lines changed

‎dhall/src/Dhall/TypeCheck.hs‎

Lines changed: 33 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -843,19 +843,24 @@ infer typer = loop
843843

844844
(VConst cL, VRecord xLs', VConst cR, VRecord xRs') -> do -- Both arguments are record types.
845845
let c = max cL cR
846-
recordTypesHaveNoFieldCollisions [] xLs' xRs'
846+
recordTypesHaveNoFieldCollisions '∧' [] xLs' xRs'
847847
return (VConst c)
848848

849-
(VRecord _, _, _, _) -> do -- The left argument is a record term, the right argument is not. The error is in the right argument.
849+
(VRecord _, _, _, _) -> do -- The left argument is a record term, the right argument is not. We report the error in the right argument.
850850
case mk of
851851
Nothing -> die (MustCombineARecord '∧' r'' _R'')
852852
Just t -> die (InvalidDuplicateField t r _R'')
853853

854-
(VConst _, VRecord _, _, _) -> do -- The left argument is a record type, the right argument is not. The error is in the right argument.
855-
die (CombineTypesRequiresRecordType r r'')
854+
(_, _, VRecord _, _) -> do -- The right argument is a record term, the left argument is not. We report the error in the left argument.
855+
case mk of
856+
Nothing -> die (MustCombineARecord '∧' l'' _L'')
857+
Just t -> die (InvalidDuplicateField t l _L'')
858+
859+
(VConst _, VRecord _, _, _) -> do -- The left argument is a record type, the right argument is not. We report the error in the right argument.
860+
die (MustCombineRecordsOrRecordTypes '∧' r r'')
856861

857-
_ -> do -- The error is in the left argument: it must be either a record term or a record type, but it is neither.
858-
die (MustCombineARecordOrRecordType '∧' l l'')
862+
_ -> do -- The error is in the left argument: it must be either a record term or a record type, but it is neither. We report the error in the left argument.
863+
die (MustCombineRecordsOrRecordTypes '∧' l l'')
859864

860865

861866
CombineTypes _ l r -> do
@@ -889,7 +894,7 @@ infer typer = loop
889894
VRecord xRs' -> return xRs'
890895
_ -> die (CombineTypesRequiresRecordType r r'')
891896

892-
recordTypesHaveNoFieldCollisions [] xLs' xRs'
897+
recordTypesHaveNoFieldCollisions '⩓' [] xLs' xRs'
893898

894899
return (VConst c)
895900

@@ -1359,13 +1364,13 @@ infer typer = loop
13591364

13601365
quote ns value = Dhall.Core.renote (Eval.quote ns value)
13611366

1362-
recordTypesHaveNoFieldCollisions xs xLs₀' xRs₀' = Foldable.sequence_ (Data.Map.intersectionWithKey combine mL mR)
1367+
recordTypesHaveNoFieldCollisions c xs xLs₀' xRs₀' = Foldable.sequence_ (Data.Map.intersectionWithKey combine mL mR)
13631368
where
13641369
combine x (VRecord xLs₁') (VRecord xRs₁') =
1365-
recordTypesHaveNoFieldCollisions (x : xs) xLs₁' xRs₁'
1370+
recordTypesHaveNoFieldCollisions c (x : xs) xLs₁' xRs₁'
13661371

13671372
combine x _ _ =
1368-
die (FieldTypeCollision (NonEmpty.reverse (x :| xs)))
1373+
die (FieldTypeCollision c (NonEmpty.reverse (x :| xs)))
13691374

13701375
mL = Dhall.Map.toMap xLs₀'
13711376
mR = Dhall.Map.toMap xRs₀'
@@ -1401,15 +1406,15 @@ data TypeMessage s a
14011406
| ListAppendMismatch (Expr s a) (Expr s a)
14021407
| MustUpdateARecord (Expr s a) (Expr s a) (Expr s a)
14031408
| MustCombineARecord Char (Expr s a) (Expr s a)
1404-
| MustCombineARecordOrRecordType Char (Expr s a) (Expr s a)
1409+
| MustCombineRecordsOrRecordTypes Char (Expr s a) (Expr s a)
14051410
| InvalidDuplicateField Text (Expr s a) (Expr s a)
14061411
| InvalidRecordCompletion Text (Expr s a)
14071412
| CompletionSchemaMustBeARecord (Expr s a) (Expr s a)
14081413
| CombineTypesRequiresRecordType (Expr s a) (Expr s a)
14091414
| RecordTypeMismatch Const Const (Expr s a) (Expr s a)
14101415
| DuplicateFieldCannotBeMerged (NonEmpty Text)
14111416
| FieldCollision (NonEmpty Text)
1412-
| FieldTypeCollision (NonEmpty Text)
1417+
| FieldTypeCollision Char (NonEmpty Text)
14131418
| MustMergeARecord (Expr s a) (Expr s a)
14141419
| MustMergeUnionOrOptional (Expr s a) (Expr s a)
14151420
| MustMapARecord (Expr s a) (Expr s a)
@@ -2872,16 +2877,16 @@ prettyTypeMessage (MustCombineARecord c expression typeExpression) =
28722877
where
28732878
op = pretty c
28742879

2875-
prettyTypeMessage (MustCombineARecordOrRecordType c expression typeExpression) =
2880+
prettyTypeMessage (MustCombineRecordsOrRecordTypes c expression typeExpression) =
28762881
ErrorMessages {..}
28772882
where
28782883
action = "combine"
2879-
short = "You can only " <> action <> " records or record types"
2884+
short = "You can only " <> action <> " two records or two record types"
28802885

28812886
hints = emptyRecordTypeHint expression
28822887

28832888
long =
2884-
"Explanation: You can " <> action <> " records or record types using the ❰" <> op <> "❱ operator, like this:\n\
2889+
"Explanation: You can " <> action <> " two records or two record types using the ❰" <> op <> "❱ operator, like this:\n\
28852890
\ \n\
28862891
\ \n\
28872892
\ ┌───────────────────────────────────────────┐ \n\
@@ -2894,7 +2899,7 @@ prettyTypeMessage (MustCombineARecordOrRecordType c expression typeExpression) =
28942899
\ └───────────────────────────────────────────┘ \n\
28952900
\ \n\
28962901
\ \n\
2897-
\... but you cannot " <> action <> " values that are neither records nor record types.\n\
2902+
\... but you cannot " <> action <> " values that are not both records and not both record types.\n\
28982903
\ \n\
28992904
\For example, the following expressions are " <> _NOT <> " valid: \n\
29002905
\ \n\
@@ -2910,7 +2915,7 @@ prettyTypeMessage (MustCombineARecordOrRecordType c expression typeExpression) =
29102915
\ │ { foo = 1, bar = \"ABC\" } " <> op <> " { baz : Bool } │ \n\
29112916
\ └───────────────────────────────────────────┘ \n\
29122917
\ ⇧ \n\
2913-
\ Invalid: This is a record type and not a record\n\
2918+
\ Invalid: cannot combine a record and a record type\n\
29142919
\ \n\
29152920
\ \n\
29162921
\ ┌───────────────────────────────────────────┐ \n\
@@ -3224,19 +3229,21 @@ prettyTypeMessage (FieldCollision ks) = ErrorMessages {..}
32243229
where
32253230
txt0 = insert (toPath ks)
32263231

3227-
prettyTypeMessage (FieldTypeCollision ks) = ErrorMessages {..}
3232+
prettyTypeMessage (FieldTypeCollision c ks) = ErrorMessages {..}
32283233
where
3234+
op = pretty c
3235+
32293236
short = "Field type collision on: " <> pretty (toPath ks)
32303237

32313238
hints = []
32323239

32333240
long =
3234-
"Explanation: You can recursively merge record types using the ❰⩓❱ operator, like\n\
3241+
"Explanation: You can recursively merge record types using the ❰" <> op <> "❱ operator, like\n\
32353242
\this: \n\
32363243
\ \n\
32373244
\ \n\
32383245
\ ┌───────────────────────┐ \n\
3239-
\ │ { x : A } ⩓ { y : B } │ \n\
3246+
\ │ { x : A } " <> op <> " { y : B } │ \n\
32403247
\ └───────────────────────┘ \n\
32413248
\ \n\
32423249
\ \n\
@@ -3247,15 +3254,15 @@ prettyTypeMessage (FieldTypeCollision ks) = ErrorMessages {..}
32473254
\ \n\
32483255
\ \n\
32493256
\ ┌────────────────────────────────┐ \n\
3250-
\ │ { x : Natural } ⩓ { x : Bool } │ Invalid: The ❰x❱ fields \"collide\" \n\
3257+
\ │ { x : Natural } " <> op <> " { x : Bool } │ Invalid: The ❰x❱ fields \"collide\" \n\
32513258
\ └────────────────────────────────┘ because they cannot be merged \n\
32523259
\ \n\
32533260
\ \n\
32543261
\... but the following expression is valid: \n\
32553262
\ \n\
32563263
\ \n\
32573264
\ ┌────────────────────────────────────────────────┐ Valid: The ❰x❱ field \n\
3258-
\ │ { x : { y : Bool } } ⩓ { x : { z : Natural } } │ types don't collide and \n\
3265+
\ │ { x : { y : Bool } } " <> op <> " { x : { z : Natural } } │ types don't collide and \n\
32593266
\ └────────────────────────────────────────────────┘ can be merged \n\
32603267
\ \n\
32613268
\ \n\
@@ -4978,8 +4985,8 @@ messageExpressions f m = case m of
49784985
MustUpdateARecord <$> f a <*> f b <*> f c
49794986
MustCombineARecord a b c ->
49804987
MustCombineARecord <$> pure a <*> f b <*> f c
4981-
MustCombineARecordOrRecordType a b c ->
4982-
MustCombineARecordOrRecordType <$> pure a <*> f b <*> f c
4988+
MustCombineRecordsOrRecordTypes a b c ->
4989+
MustCombineRecordsOrRecordTypes <$> pure a <*> f b <*> f c
49834990
InvalidRecordCompletion a l ->
49844991
InvalidRecordCompletion a <$> f l
49854992
CompletionSchemaMustBeARecord l r ->
@@ -4992,8 +4999,8 @@ messageExpressions f m = case m of
49924999
pure (DuplicateFieldCannotBeMerged a)
49935000
FieldCollision a ->
49945001
pure (FieldCollision a)
4995-
FieldTypeCollision a ->
4996-
pure (FieldTypeCollision a)
5002+
FieldTypeCollision c a ->
5003+
pure (FieldTypeCollision c a)
49975004
MustMergeARecord a b ->
49985005
MustMergeARecord <$> f a <*> f b
49995006
MustMergeUnionOrOptional a b ->

0 commit comments

Comments
 (0)