Skip to content

Commit 6c68f82

Browse files
aleatorGabriella439
aleator
authored and
Gabriella439
committed
Improved error messages. (#1528)
This patch improves some of the error messages: 1) Bad field names on record completion: ``` echo "{Type = {x : Integer, y : Bool}, Default = {y = True}}::{x = 5}" |stack exec dhall Use "dhall --explain" for detailed errors Error: Completion record is missing a field: default 1│ {Type = {x : Integer, y : Bool}, Default = {y = True}}::{x = 5} (stdin):1:1 ``` 2) Trying to complete non-records: ``` Use "dhall --explain" for detailed errors Error: You can only complete records 1│ True::{x = 5} (stdin):1:1 ``` 3) Possibly better short message on if predicates ``` echo "if 1 then 2 else 3" |stack exec dhall Use "dhall --explain" for detailed errors Error: Invalid predicate for ❰if❱: Natural 1│ if 1 then 2 else 3 (stdin):1:1 ``` 4) Possibly better short message on list annotations. This is probably superfluous ``` echo "[] : Bool" |stack exec dhall Use "dhall --explain" for detailed errors Error: Invalid type for ❰List❱: Bool 1│ [] : Bool ``` 5) Better short message on missing constructors: ``` echo "<Foo : Bool>.Boo True" |stack exec dhall Use "dhall --explain" for detailed errors Error: Missing constructor: Boo 1│ <Foo : Bool>.Boo (stdin):1:1 ``` 6) Better short messages on missing handlers
1 parent 3fdf075 commit 6c68f82

File tree

1 file changed

+83
-12
lines changed

1 file changed

+83
-12
lines changed

‎dhall/src/Dhall/TypeCheck.hs

Lines changed: 83 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -903,7 +903,17 @@ infer typer = loop
903903
return (VRecord (Dhall.Map.union xRs' xLs'))
904904

905905
RecordCompletion l r -> do
906-
loop ctx (Annot (Prefer (Field l "default") r) (Field l "Type"))
906+
_L' <- loop ctx l
907+
908+
case _L' of
909+
VRecord xLs'
910+
| not (Dhall.Map.member "default" xLs')
911+
-> die (InvalidRecordCompletion "default" l)
912+
| not (Dhall.Map.member "Type" xLs')
913+
-> die (InvalidRecordCompletion "Type" l)
914+
| otherwise
915+
-> loop ctx (Annot (Prefer (Field l "default") r) (Field l "Type"))
916+
_ -> die (CompletionSchemaMustBeARecord l (quote names _L'))
907917

908918
Merge t u mT₁ -> do
909919
_T' <- loop ctx t
@@ -940,7 +950,8 @@ infer typer = loop
940950

941951
if Data.Set.null diffU
942952
then return ()
943-
else die (MissingHandler diffU)
953+
else let (exemplar,rest) = Data.Set.deleteFindMin diffU
954+
in die (MissingHandler exemplar rest)
944955

945956
let match _y _T₀' Nothing =
946957
return _T₀'
@@ -1290,6 +1301,8 @@ data TypeMessage s a
12901301
| AlternativeAnnotationMismatch Text (Expr s a) Const Text (Expr s a) Const
12911302
| ListAppendMismatch (Expr s a) (Expr s a)
12921303
| MustCombineARecord Char (Expr s a) (Expr s a)
1304+
| InvalidRecordCompletion Text (Expr s a)
1305+
| CompletionSchemaMustBeARecord (Expr s a) (Expr s a)
12931306
| CombineTypesRequiresRecordType (Expr s a) (Expr s a)
12941307
| RecordTypeMismatch Const Const (Expr s a) (Expr s a)
12951308
| FieldCollision Text
@@ -1302,7 +1315,7 @@ data TypeMessage s a
13021315
| MapTypeMismatch (Expr s a) (Expr s a)
13031316
| MissingToMapType
13041317
| UnusedHandler (Set Text)
1305-
| MissingHandler (Set Text)
1318+
| MissingHandler Text (Set Text)
13061319
| HandlerInputTypeMismatch Text (Expr s a) (Expr s a)
13071320
| DisallowedHandlerType Text (Expr s a) (Expr s a) Text
13081321
| HandlerOutputTypeMismatch Text (Expr s a) Text (Expr s a)
@@ -2028,7 +2041,9 @@ prettyTypeMessage Untyped = ErrorMessages {..}
20282041

20292042
prettyTypeMessage (InvalidPredicate expr0 expr1) = ErrorMessages {..}
20302043
where
2031-
short = "Invalid predicate for ❰if❱"
2044+
short = "Invalid predicate for ❰if❱: "
2045+
<> "\n"
2046+
<> Dhall.Diff.doc (Dhall.Diff.diffNormalized Bool expr1)
20322047

20332048
long =
20342049
"Explanation: Every ❰if❱ expression begins with a predicate which must have type \n\
@@ -2677,6 +2692,55 @@ prettyTypeMessage (ListAppendMismatch expr0 expr1) = ErrorMessages {..}
26772692
txt0 = insert expr0
26782693
txt1 = insert expr1
26792694

2695+
prettyTypeMessage (CompletionSchemaMustBeARecord expr0 expr1) = ErrorMessages {..}
2696+
where
2697+
short = "The completion schema must be a record"
2698+
2699+
long =
2700+
"Explanation: You can complete records using the ❰::❱ operator: \n\
2701+
\ \n\
2702+
\ ┌─────────────────────────────────────────────────────────────────────────┐ \n\
2703+
\ │ {Type = {foo : Bool, bar : Natural}, default = {bar = 2}::{foo = True}} │ \n\
2704+
\ └─────────────────────────────────────────────────────────────────────────┘ \n\
2705+
\ \n\
2706+
\... The left-hand side of :: must be a record with 'Type' and 'default' keys \n\
2707+
\ \n\
2708+
\You tried to record complete the following value: \n\
2709+
\ \n\
2710+
\" <> txt0 <> "\n\
2711+
\ \n\
2712+
\... which is not a record. It is: \n\
2713+
\ \n\
2714+
\" <> txt1 <> "\n"
2715+
where
2716+
txt0 = insert expr0
2717+
txt1 = insert expr1
2718+
2719+
prettyTypeMessage (InvalidRecordCompletion fieldName expr0) = ErrorMessages {..}
2720+
where
2721+
short = "Completion schema is missing a field: " <> pretty fieldName
2722+
2723+
long =
2724+
"Explanation: You can complete records using the ❰::❱ operator like this:\n\
2725+
\ \n\
2726+
\ ┌─────────────────────────────────────────────────────────────────────────┐ \n\
2727+
\ │ {Type = {foo : Bool, bar : Natural}, default = {bar = 2}::{foo = True}} │ \n\
2728+
\ └─────────────────────────────────────────────────────────────────────────┘ \n\
2729+
\ \n\
2730+
\... but you need to have both Type and default fields in the completion schema \n\
2731+
\ (the record on the left of the the ::). \n\
2732+
\ \n\
2733+
\You tried to do record completion using the schema: \n\
2734+
\ \n\
2735+
\" <> txt0 <> "\n\
2736+
\ \n\
2737+
\... which is missing the key: \n\
2738+
\ \n\
2739+
\" <> txt1 <> "\n"
2740+
where
2741+
txt0 = insert expr0
2742+
txt1 = pretty fieldName
2743+
26802744
prettyTypeMessage (MustCombineARecord c expr0 expr1) = ErrorMessages {..}
26812745
where
26822746
short = "You can only combine records"
@@ -2825,7 +2889,7 @@ prettyTypeMessage (RecordTypeMismatch const0 const1 expr0 expr1) =
28252889

28262890
prettyTypeMessage (FieldCollision k) = ErrorMessages {..}
28272891
where
2828-
short = "Field collision"
2892+
short = "Field collision on: " <> Dhall.Pretty.Internal.prettyLabel k
28292893

28302894
long =
28312895
"Explanation: You can combine records or record types if they don't share any \n\
@@ -3035,9 +3099,12 @@ prettyTypeMessage (UnusedHandler ks) = ErrorMessages {..}
30353099
where
30363100
txt0 = insert (Text.intercalate ", " (Data.Set.toList ks))
30373101

3038-
prettyTypeMessage (MissingHandler ks) = ErrorMessages {..}
3102+
prettyTypeMessage (MissingHandler exemplar ks) = ErrorMessages {..}
30393103
where
3040-
short = "Missing handler"
3104+
short = case Data.Set.toList ks of
3105+
[] -> "Missing handler: " <> Dhall.Pretty.Internal.prettyLabel exemplar
3106+
xs@(_:_) -> "Missing handlers: " <> (Pretty.hsep . Pretty.punctuate Pretty.comma
3107+
. map Dhall.Pretty.Internal.prettyLabel $ exemplar:xs)
30413108

30423109
long =
30433110
"Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\
@@ -3073,7 +3140,7 @@ prettyTypeMessage (MissingHandler ks) = ErrorMessages {..}
30733140
\ \n\
30743141
\" <> txt0 <> "\n"
30753142
where
3076-
txt0 = insert (Text.intercalate ", " (Data.Set.toList ks))
3143+
txt0 = insert (Text.intercalate ", " (exemplar : Data.Set.toList ks))
30773144

30783145
prettyTypeMessage MissingMergeType =
30793146
ErrorMessages {..}
@@ -3336,7 +3403,7 @@ prettyTypeMessage (HandlerOutputTypeMismatch key0 expr0 key1 expr1) =
33363403

33373404
prettyTypeMessage (HandlerNotAFunction k expr0) = ErrorMessages {..}
33383405
where
3339-
short = "Handler is not a function"
3406+
short = "Handler for "<> Dhall.Pretty.Internal.prettyLabel k <> " is not a function"
33403407

33413408
long =
33423409
"Explanation: You can ❰merge❱ the alternatives of a union using a record with one\n\
@@ -3729,7 +3796,7 @@ prettyTypeMessage (MissingField k expr0) = ErrorMessages {..}
37293796

37303797
prettyTypeMessage (MissingConstructor k expr0) = ErrorMessages {..}
37313798
where
3732-
short = "Missing constructor"
3799+
short = "Missing constructor: " <> Dhall.Pretty.Internal.prettyLabel k
37333800

37343801
long =
37353802
"Explanation: You can access constructors from unions, like this: \n\
@@ -4343,6 +4410,10 @@ messageExpressions f m = case m of
43434410
ListAppendMismatch <$> f a <*> f b
43444411
MustCombineARecord a b c ->
43454412
MustCombineARecord <$> pure a <*> f b <*> f c
4413+
InvalidRecordCompletion a l ->
4414+
InvalidRecordCompletion a <$> f l
4415+
CompletionSchemaMustBeARecord l r ->
4416+
CompletionSchemaMustBeARecord <$> f l <*> f r
43464417
CombineTypesRequiresRecordType a b ->
43474418
CombineTypesRequiresRecordType <$> f a <*> f b
43484419
RecordTypeMismatch a b c d ->
@@ -4367,8 +4438,8 @@ messageExpressions f m = case m of
43674438
pure MissingToMapType
43684439
UnusedHandler a ->
43694440
UnusedHandler <$> pure a
4370-
MissingHandler a ->
4371-
MissingHandler <$> pure a
4441+
MissingHandler e a ->
4442+
MissingHandler <$> pure e <*> pure a
43724443
HandlerInputTypeMismatch a b c ->
43734444
HandlerInputTypeMismatch <$> pure a <*> f b <*> f c
43744445
DisallowedHandlerType a b c d ->

0 commit comments

Comments
 (0)