Skip to content

Commit d2ce139

Browse files
gr-imgr-im
authored
Merge pull request #115 from xhtmlboi/comprehensive-api-for-field-validation
Compact field validators
2 parents 80a8177 + 42683ce commit d2ce139

File tree

5 files changed

+193
-1
lines changed

5 files changed

+193
-1
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
#### Yocaml
44

5+
- Add `Data.Validation.req` and `Data.Validation.opt` for compact validation and alternative name (by [xhtmlboi](https://github.com/xhtmlboi))
56
- Add `Data.Validation.where_opt` (and `String`, `Int` and `Float` version) (by [xvw](https://xvw.lol))
67
- Improve pretty-printing of validation errors (by [Linda-Njau](https://github.com/Linda-Njau))
78
- Fix typos and improve logs display (by [clementd](https://clementd.wtf))

‎lib/core/data.ml‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -379,6 +379,32 @@ module Validation = struct
379379
let opt = optional assoc field validator in
380380
Result.bind opt (function Some x -> Ok x | None -> Ok default)
381381

382+
let req ?(alt = []) assoc field validation =
383+
let alt_name =
384+
match alt with [] -> "" | _ -> " or [" ^ String.concat ", " alt ^ "]"
385+
in
386+
let field_name = field ^ alt_name in
387+
let rec aux = function
388+
| [] -> Error (Nel.singleton @@ Missing_field { field = field_name })
389+
| field :: xs -> (
390+
match required assoc field validation with
391+
| Ok x -> Ok x
392+
| Error Nel.[ Missing_field _ ] -> aux xs
393+
| Error err -> Error err)
394+
in
395+
aux (field :: alt)
396+
397+
let opt ?(alt = []) assoc field validation =
398+
let rec aux = function
399+
| [] -> Ok None
400+
| field :: xs -> (
401+
match optional assoc field validation with
402+
| Ok None -> aux xs
403+
| Ok x -> Ok x
404+
| Error err -> Error err)
405+
in
406+
aux (field :: alt)
407+
382408
let sub_record assoc validator =
383409
validator (mk_record assoc)
384410
|> Result.map_error (fun err -> Nel.singleton (Invalid_subrecord err))

‎lib/core/data.mli‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -404,6 +404,15 @@ module Validation : sig
404404
(** [required assoc field validator] required [field] of [assoc], validated by
405405
[validator]. *)
406406

407+
val req :
408+
?alt:string list
409+
-> (string * t) list
410+
-> string
411+
-> (t -> 'a validated_value)
412+
-> 'a validated_record
413+
(** [req ?alt assoc field validator] is a compact form of {!val:required}
414+
allowing alternative field names. *)
415+
407416
val optional :
408417
(string * t) list
409418
-> string
@@ -412,6 +421,15 @@ module Validation : sig
412421
(** [optional assoc field validator] optional [field] of [assoc], validated by
413422
[validator]. *)
414423

424+
val opt :
425+
?alt:string list
426+
-> (string * t) list
427+
-> string
428+
-> (t -> 'a validated_value)
429+
-> 'a option validated_record
430+
(** [opt ?alt assoc field validator] is a compact form of {!val:optional}
431+
allowing alternative field names. *)
432+
415433
val optional_or :
416434
(string * t) list
417435
-> string

‎test/e2e/run.t‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -314,4 +314,4 @@ Observe Residual Removing
314314

315315
Clean the sandbox
316316
$ rm -r _www
317-
$ rm -rf _residuals_build
317+
$ rm -rf residuals_build

‎test/yocaml-expect/data_test.ml‎

Lines changed: 147 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,147 @@
1+
(* YOCaml a static blog generator.
2+
Copyright (C) 2026 The Funkyworkers and The YOCaml's developers
3+
4+
This program is free software: you can redistribute it and/or modify
5+
it under the terms of the GNU General Public License as published by
6+
the Free Software Foundation, either version 3 of the License, or
7+
(at your option) any later version.
8+
9+
This program is distributed in the hope that it will be useful,
10+
but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
GNU General Public License for more details.
13+
14+
You should have received a copy of the GNU General Public License
15+
along with this program. If not, see <https://www.gnu.org/licenses/>. *)
16+
17+
open Yocaml
18+
19+
let my_record ?(title = "title") ?(kind = "kind") ?(description = "description")
20+
?(url = "url") () =
21+
let open Data in
22+
record
23+
[
24+
(title, string "My title")
25+
; (kind, string "My Kind")
26+
; (description, string "A description")
27+
; (url, string "https://yocaml.github.io")
28+
]
29+
30+
let dump = function
31+
| Ok x -> print_endline x
32+
| Error err ->
33+
Format.asprintf "%a" (Diagnostic.pp_validation_error (fun _ _ -> ())) err
34+
|> print_endline
35+
36+
let validate_my_record input =
37+
let open Data.Validation in
38+
record
39+
(fun obj ->
40+
let+ title = req obj ~alt:[ "name"; "main_title" ] "title" string
41+
and+ kind = opt obj ~alt:[ "k"; "sort" ] "kind" string
42+
and+ desc = req obj ~alt:[ "desc"; "synopsis" ] "description" string
43+
and+ url = opt obj ~alt:[ "link"; "site" ] "url" string in
44+
let open Format in
45+
asprintf "%a\n\ntitle:%s\nkind:%a\ndesc:%s\nurl:%a" Data.pp input title
46+
(pp_print_option pp_print_string)
47+
kind desc
48+
(pp_print_option pp_print_string)
49+
url)
50+
input
51+
52+
let%expect_test "Validate a regular record" =
53+
my_record () |> validate_my_record |> dump;
54+
[%expect
55+
{|
56+
{"title": "My title", "kind": "My Kind", "description": "A description",
57+
"url": "https://yocaml.github.io"}
58+
59+
title:My title
60+
kind:My Kind
61+
desc:A description
62+
url:https://yocaml.github.io
63+
|}]
64+
65+
let%expect_test "Validate a regular record with alternative names" =
66+
my_record ~title:"main_title" ~kind:"sort" ~description:"synopsis" ~url:"site"
67+
()
68+
|> validate_my_record
69+
|> dump;
70+
[%expect
71+
{|
72+
{"main_title": "My title", "sort": "My Kind", "synopsis": "A description",
73+
"site": "https://yocaml.github.io"}
74+
75+
title:My title
76+
kind:My Kind
77+
desc:A description
78+
url:https://yocaml.github.io
79+
|}]
80+
81+
let%expect_test "Validate a regular record with missing name - 1" =
82+
my_record ~title:"main_title" ~kind:"invalidfieldname" ~description:"synopsis"
83+
~url:"site" ()
84+
|> validate_my_record
85+
|> dump;
86+
[%expect
87+
{|
88+
{"main_title": "My title", "invalidfieldname": "My Kind", "synopsis":
89+
"A description", "site": "https://yocaml.github.io"}
90+
91+
title:My title
92+
kind:
93+
desc:A description
94+
url:https://yocaml.github.io
95+
|}]
96+
97+
let%expect_test "Validate a regular record with missing name - 2" =
98+
my_record ~title:"an_invalid_title_name" ~kind:"invalidfieldname"
99+
~description:"fail_because_required" ~url:"site" ()
100+
|> validate_my_record
101+
|> dump;
102+
[%expect
103+
{|
104+
Invalid record:
105+
Errors (2):
106+
1) Missing field `title or [name, main_title]`
107+
108+
2) Missing field `description or [desc, synopsis]`
109+
110+
Given record:
111+
an_invalid_title_name = `"My title"`
112+
invalidfieldname = `"My Kind"`
113+
fail_because_required = `"A description"`
114+
site = `"https://yocaml.github.io"`
115+
|}]
116+
117+
let%expect_test "Validate a regular record with invalid fields" =
118+
Data.(
119+
record
120+
[
121+
("title", list_of string [])
122+
; ("sort", string "My Kind")
123+
; ("desc", string "A description")
124+
; ("link", int 42)
125+
])
126+
|> validate_my_record
127+
|> dump;
128+
[%expect
129+
{|
130+
Invalid record:
131+
Errors (2):
132+
1) Invalid field `title`:
133+
Invalid shape:
134+
Expected: strict-string
135+
Given: `[]`
136+
137+
2) Invalid field `link`:
138+
Invalid shape:
139+
Expected: strict-string
140+
Given: `42`
141+
142+
Given record:
143+
title = `[]`
144+
sort = `"My Kind"`
145+
desc = `"A description"`
146+
link = `42`
147+
|}]

0 commit comments

Comments
 (0)