Skip to content

Commit 4def7a9

Browse files
xvwxvw
authored
Merge pull request #113 from Linda-Njau/pp_validation_error
Pretty printing validation errors
2 parents ae2db32 + 98fe316 commit 4def7a9

File tree

4 files changed

+301
-45
lines changed

4 files changed

+301
-45
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
### unreleased
22

33
#### Yocaml
4-
4+
- Improve pretty-printing of validation errors (by [Linda-Njau](https://github.com/Linda-Njau))
55
- Fix typos and improve logs display (by [clementd](https://clementd.wtf))
66

77
### v2.8.0 2025-12-17 Nantes (France)

‎lib/core/diagnostic.ml‎

Lines changed: 58 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -14,75 +14,89 @@
1414
You should have received a copy of the GNU General Public License
1515
along with this program. If not, see <https://www.gnu.org/licenses/>. *)
1616

17-
let comma_sep ppf () = Format.fprintf ppf ";@,"
17+
let pp_blankline ppf () = Format.fprintf ppf "@,@,"
18+
let pp_newline ppf () = Format.fprintf ppf "@,"
1819

1920
let rec pp_validation_error custom_error ppf = function
2021
| Data.Validation.Invalid_shape { expected; given } ->
21-
Format.fprintf ppf
22-
"Fail with Invalid shape: @[<2>{ @[<1>expected =@ `%s`@];@,\
23-
@[<1>given =@ `%a`@];@,\
24-
}@]"
22+
Format.fprintf ppf "@[<v 2>Invalid shape:@,Expected: %s@,Given: `%a`@]"
2523
expected Data.pp given
2624
| Data.Validation.With_message { message; given } ->
27-
Format.fprintf ppf
28-
"Fail with message: @[<2>{ @[<1>message =@ `%s`@];@,\
29-
@[<1>given =@ `%s`@];@,\
30-
}@]"
31-
message given
25+
Format.fprintf ppf "@[<v 2>Message:@,Message: %s@,Given: `%s`@]" message
26+
given
3227
| Data.Validation.Custom custom ->
33-
Format.fprintf ppf "Fail with Custom error: @[<2>%a@]" custom_error custom
28+
Format.fprintf ppf "@[<v 2>Custom error:@,%a@]" custom_error custom
3429
| Data.Validation.Invalid_list { errors; given } ->
35-
Format.fprintf ppf
36-
"Fail with Invalid list @[<2>{ @[<1>errors =@ `%a`@];@,\
37-
@[<1>given =@ `%a`@];@,\
38-
}@]"
39-
(Format.pp_print_list ~pp_sep:comma_sep (fun ppf (i, err) ->
40-
Format.fprintf ppf "@[<1>%d =@ `%a`@]" i
41-
(pp_validation_error custom_error)
42-
err))
43-
(Nel.to_list errors)
44-
(Format.pp_print_list ~pp_sep:comma_sep Data.pp)
45-
given
30+
Format.fprintf ppf "@[<v 2>Invalid list:@,";
31+
32+
Format.fprintf ppf "Errors (%d):@," (Nel.length errors);
33+
34+
Nel.iteri
35+
(fun i (index, err) ->
36+
if i > 0 then pp_blankline ppf ();
37+
Format.fprintf ppf "@[<v 2>%d) At index %d:@,%a@]" (i + 1) index
38+
(pp_validation_error custom_error)
39+
err)
40+
errors;
41+
42+
pp_blankline ppf ();
43+
44+
Format.fprintf ppf "@[<v 2>Given list:@,";
45+
46+
List.iteri
47+
(fun i v ->
48+
Format.fprintf ppf "[%d] = `%a`" i Data.pp v;
49+
pp_newline ppf ())
50+
given;
51+
52+
Format.fprintf ppf "@]@]"
4653
| Data.Validation.Invalid_record { errors; given } ->
47-
Format.fprintf ppf
48-
"Fail with Invalid record: @[<2>{@[<1>errors =@ `%a`@];@,\
49-
@[<1>given =@ `%a`@];@,\
50-
}]"
51-
(Format.pp_print_list ~pp_sep:comma_sep (pp_record_error custom_error))
52-
(Nel.to_list errors)
53-
(Format.pp_print_list ~pp_sep:comma_sep (fun ppf (k, v) ->
54-
Format.fprintf ppf "@[<1>%s =@ `%a`@]" k Data.pp v))
55-
given
54+
Format.fprintf ppf "@[<v 2>Invalid record:@,";
55+
56+
Format.fprintf ppf "Errors (%d):@," (Nel.length errors);
57+
58+
Nel.iteri
59+
(fun i err ->
60+
if i > 0 then pp_blankline ppf ();
61+
Format.fprintf ppf "%d) %a" (i + 1) (pp_record_error custom_error) err)
62+
errors;
63+
64+
pp_blankline ppf ();
65+
66+
Format.fprintf ppf "@[<v 2>Given record:@,";
67+
68+
Format.pp_print_list
69+
~pp_sep:(fun ppf () -> pp_newline ppf ())
70+
(fun ppf (k, v) -> Format.fprintf ppf "%s = `%a`" k Data.pp v)
71+
ppf given;
72+
73+
Format.fprintf ppf "@]@]"
5674

5775
and pp_record_error custom_error ppf = function
5876
| Data.Validation.Missing_field { field } ->
59-
Format.fprintf ppf "Missing field =@ `%s`" field
60-
| Data.Validation.Invalid_field { given; field; error } ->
61-
Format.fprintf ppf
62-
"Invalid field =@ `%s` @[<2>{@[<2>{@[<1>error =@ `%a`@];@,\
63-
@[<1>given =@ `%a`@];@,\
64-
}@]"
65-
field
77+
Format.fprintf ppf "Missing field `%s`" field
78+
| Data.Validation.Invalid_field { field; error; given = _ } ->
79+
Format.fprintf ppf "@[<v 2>Invalid field `%s`:@,%a@]" field
6680
(pp_validation_error custom_error)
67-
error Data.pp given
81+
error
6882
| Data.Validation.Invalid_subrecord error ->
69-
Format.fprintf ppf "Invalid subrecord @[<2>%a@]"
83+
Format.fprintf ppf "@[<v 2>Invalid subrecord:@,%a@]"
7084
(pp_validation_error custom_error)
7185
error
7286

7387
let pp_provider_error custom_error ppf = function
7488
| Required.Parsing_error { given; message } ->
75-
Format.fprintf ppf "Parsing error: @[given: @[`%s`@]\nmessage:@[`%s`@]@]"
76-
given message
89+
Format.fprintf ppf "Parsing error:@,Given: `%s`@,Message: `%s`" given
90+
message
7791
| Required.Required_metadata { entity } ->
7892
Format.fprintf ppf "Required metadata: `%s`" entity
7993
| Required.Validation_error { entity; error } ->
80-
Format.fprintf ppf "Validation error: `%s`\n @[%a@]" entity
94+
Format.fprintf ppf "Validation error: `%s`@,@[%a@]" entity
8195
(pp_validation_error custom_error)
8296
error
8397

8498
let glob_pp p v backtrace ppf =
85-
Format.fprintf ppf "--- %a ---\n%a\n---\n%s" Lexicon.there_is_an_error () p v
99+
Format.fprintf ppf "--- %a ---@,%a@,---@,%s" Lexicon.there_is_an_error () p v
86100
backtrace
87101

88102
let exception_to_diagnostic

‎lib/core/diagnostic.mli‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,3 +29,10 @@ val exception_to_diagnostic :
2929
val runtime_error_to_diagnostic : Format.formatter -> string -> unit
3030
(** Uses the same representation as an exception diagnostic to visually render
3131
an error message produced by the runtime. *)
32+
33+
val pp_validation_error :
34+
(Format.formatter -> Data.Validation.custom_error -> unit)
35+
-> Format.formatter
36+
-> Data.Validation.value_error
37+
-> unit
38+
(** Pretty-print a validation error. *)

‎test/yocaml-expect/pp_validation_error.ml‎

Lines changed: 235 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,235 @@
1+
open Yocaml
2+
3+
type Data.Validation.custom_error += Test_custom_error
4+
5+
let custom_printer ppf = function
6+
| Test_custom_error -> Format.fprintf ppf "test custom error"
7+
| _ -> ()
8+
9+
let validation_error_to_string err =
10+
Format.asprintf "%a"
11+
(Yocaml.Diagnostic.pp_validation_error custom_printer)
12+
err
13+
14+
let%expect_test "validation - invalid shape" =
15+
let err =
16+
Data.Validation.Invalid_shape { expected = "string"; given = Data.int 10 }
17+
in
18+
print_endline (validation_error_to_string err);
19+
[%expect {|
20+
Invalid shape:
21+
Expected: string
22+
Given: `10`
23+
|}]
24+
25+
let%expect_test "validation - with_message" =
26+
let err =
27+
Data.Validation.With_message
28+
{ message = "value is not allowed here"; given = "42" }
29+
in
30+
print_endline (validation_error_to_string err);
31+
[%expect {|
32+
Message:
33+
Message: value is not allowed here
34+
Given: `42`
35+
|}]
36+
37+
let%expect_test "validation - custom error" =
38+
let err = Data.Validation.Custom Test_custom_error in
39+
print_endline (validation_error_to_string err);
40+
[%expect {|
41+
Custom error:
42+
test custom error
43+
|}]
44+
45+
let%expect_test "validation - record with one error" =
46+
let err =
47+
Data.Validation.Invalid_record
48+
{
49+
given = [ ("title", Data.int 1) ]
50+
; errors =
51+
Nel.singleton (Data.Validation.Missing_field { field = "name" })
52+
}
53+
in
54+
print_endline (validation_error_to_string err);
55+
[%expect
56+
{|
57+
Invalid record:
58+
Errors (1):
59+
1) Missing field `name`
60+
61+
Given record:
62+
title = `1`
63+
|}]
64+
65+
let%expect_test "validation - record with multiple errors" =
66+
let err =
67+
Data.Validation.Invalid_record
68+
{
69+
given = [ ("title", Data.int 1); ("age", Data.int 2) ]
70+
; errors =
71+
Nel.from_list
72+
[
73+
Data.Validation.Invalid_field
74+
{
75+
field = "title"
76+
; given = Data.int 1
77+
; error =
78+
Data.Validation.Invalid_shape
79+
{ expected = "string"; given = Data.int 1 }
80+
}
81+
; Data.Validation.Missing_field { field = "name" }
82+
]
83+
|> Option.get
84+
}
85+
in
86+
print_endline (validation_error_to_string err);
87+
[%expect
88+
{|
89+
Invalid record:
90+
Errors (2):
91+
1) Invalid field `title`:
92+
Invalid shape:
93+
Expected: string
94+
Given: `1`
95+
96+
2) Missing field `name`
97+
98+
Given record:
99+
title = `1`
100+
age = `2`
101+
|}]
102+
103+
let%expect_test "validation - nested record" =
104+
let err =
105+
Data.Validation.Invalid_record
106+
{
107+
given = [ ("author", Data.record [ ("name", Data.int 1) ]) ]
108+
; errors =
109+
Nel.singleton
110+
(Data.Validation.Invalid_subrecord
111+
(Data.Validation.Invalid_record
112+
{
113+
given = [ ("name", Data.int 1) ]
114+
; errors =
115+
Nel.singleton
116+
(Data.Validation.Invalid_field
117+
{
118+
field = "name"
119+
; given = Data.int 1
120+
; error =
121+
Data.Validation.Invalid_shape
122+
{ expected = "string"; given = Data.int 1 }
123+
})
124+
}))
125+
}
126+
in
127+
print_endline (validation_error_to_string err);
128+
[%expect
129+
{|
130+
Invalid record:
131+
Errors (1):
132+
1) Invalid subrecord:
133+
Invalid record:
134+
Errors (1):
135+
1) Invalid field `name`:
136+
Invalid shape:
137+
Expected: string
138+
Given: `1`
139+
140+
Given record:
141+
name = `1`
142+
143+
Given record:
144+
author = `{"name": 1}`
145+
|}]
146+
147+
let%expect_test "validation - invalid list with one error" =
148+
let err =
149+
Data.Validation.Invalid_list
150+
{
151+
given = [ Data.string "ok"; Data.int 42; Data.string "also ok" ]
152+
; errors =
153+
Nel.singleton
154+
( 1
155+
, Data.Validation.Invalid_shape
156+
{ expected = "string"; given = Data.int 42 } )
157+
}
158+
in
159+
print_endline (validation_error_to_string err);
160+
[%expect
161+
{|
162+
Invalid list:
163+
Errors (1):
164+
1) At index 1:
165+
Invalid shape:
166+
Expected: string
167+
Given: `42`
168+
169+
Given list:
170+
[0] = `"ok"`
171+
[1] = `42`
172+
[2] = `"also ok"`
173+
|}]
174+
175+
let%expect_test "validation - invalid list with nested record" =
176+
let err =
177+
Data.Validation.Invalid_list
178+
{
179+
given =
180+
[
181+
Data.int 1
182+
; Data.record [ ("title", Data.int 2) ]
183+
; Data.int 3
184+
; Data.string "ok"
185+
]
186+
; errors =
187+
Nel.from_list
188+
[
189+
( 0
190+
, Data.Validation.Invalid_shape
191+
{ expected = "string"; given = Data.int 1 } )
192+
; ( 1
193+
, Data.Validation.Invalid_record
194+
{
195+
given = [ ("title", Data.int 2) ]
196+
; errors =
197+
Nel.singleton
198+
(Data.Validation.Missing_field { field = "name" })
199+
} )
200+
; ( 2
201+
, Data.Validation.Invalid_shape
202+
{ expected = "string"; given = Data.int 3 } )
203+
]
204+
|> Option.get
205+
}
206+
in
207+
print_endline (validation_error_to_string err);
208+
[%expect
209+
{|
210+
Invalid list:
211+
Errors (3):
212+
1) At index 0:
213+
Invalid shape:
214+
Expected: string
215+
Given: `1`
216+
217+
2) At index 1:
218+
Invalid record:
219+
Errors (1):
220+
1) Missing field `name`
221+
222+
Given record:
223+
title = `2`
224+
225+
3) At index 2:
226+
Invalid shape:
227+
Expected: string
228+
Given: `3`
229+
230+
Given list:
231+
[0] = `1`
232+
[1] = `{"title": 2}`
233+
[2] = `3`
234+
[3] = `"ok"`
235+
|}]

0 commit comments

Comments
 (0)