diff --git a/CHANGES.md b/CHANGES.md index 36e4a5b..e1c0a91 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,7 @@ #### Yocaml +- Add `Data.Validation.req` and `Data.Validation.opt` for compact validation and alternative name (by [xhtmlboi](https://github.com/xhtmlboi)) - Add `Data.Validation.where_opt` (and `String`, `Int` and `Float` version) (by [xvw](https://xvw.lol)) - Improve pretty-printing of validation errors (by [Linda-Njau](https://github.com/Linda-Njau)) - Fix typos and improve logs display (by [clementd](https://clementd.wtf)) diff --git a/lib/core/data.ml b/lib/core/data.ml index c06476e..db363be 100644 --- a/lib/core/data.ml +++ b/lib/core/data.ml @@ -379,6 +379,32 @@ module Validation = struct let opt = optional assoc field validator in Result.bind opt (function Some x -> Ok x | None -> Ok default) + let req ?(alt = []) assoc field validation = + let alt_name = + match alt with [] -> "" | _ -> " or [" ^ String.concat ", " alt ^ "]" + in + let field_name = field ^ alt_name in + let rec aux = function + | [] -> Error (Nel.singleton @@ Missing_field { field = field_name }) + | field :: xs -> ( + match required assoc field validation with + | Ok x -> Ok x + | Error Nel.[ Missing_field _ ] -> aux xs + | Error err -> Error err) + in + aux (field :: alt) + + let opt ?(alt = []) assoc field validation = + let rec aux = function + | [] -> Ok None + | field :: xs -> ( + match optional assoc field validation with + | Ok None -> aux xs + | Ok x -> Ok x + | Error err -> Error err) + in + aux (field :: alt) + let sub_record assoc validator = validator (mk_record assoc) |> Result.map_error (fun err -> Nel.singleton (Invalid_subrecord err)) diff --git a/lib/core/data.mli b/lib/core/data.mli index 6cf1968..fa4af30 100644 --- a/lib/core/data.mli +++ b/lib/core/data.mli @@ -404,6 +404,15 @@ module Validation : sig (** [required assoc field validator] required [field] of [assoc], validated by [validator]. *) + val req : + ?alt:string list + -> (string * t) list + -> string + -> (t -> 'a validated_value) + -> 'a validated_record + (** [req ?alt assoc field validator] is a compact form of {!val:required} + allowing alternative field names. *) + val optional : (string * t) list -> string @@ -412,6 +421,15 @@ module Validation : sig (** [optional assoc field validator] optional [field] of [assoc], validated by [validator]. *) + val opt : + ?alt:string list + -> (string * t) list + -> string + -> (t -> 'a validated_value) + -> 'a option validated_record + (** [opt ?alt assoc field validator] is a compact form of {!val:optional} + allowing alternative field names. *) + val optional_or : (string * t) list -> string diff --git a/test/e2e/run.t b/test/e2e/run.t index 5fd5e48..c9f6eab 100644 --- a/test/e2e/run.t +++ b/test/e2e/run.t @@ -314,4 +314,4 @@ Observe Residual Removing Clean the sandbox $ rm -r _www - $ rm -rf _residuals_build + $ rm -rf residuals_build diff --git a/test/yocaml-expect/data_test.ml b/test/yocaml-expect/data_test.ml new file mode 100644 index 0000000..eae193c --- /dev/null +++ b/test/yocaml-expect/data_test.ml @@ -0,0 +1,147 @@ +(* YOCaml a static blog generator. + Copyright (C) 2026 The Funkyworkers and The YOCaml's developers + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . *) + +open Yocaml + +let my_record ?(title = "title") ?(kind = "kind") ?(description = "description") + ?(url = "url") () = + let open Data in + record + [ + (title, string "My title") + ; (kind, string "My Kind") + ; (description, string "A description") + ; (url, string "https://yocaml.github.io") + ] + +let dump = function + | Ok x -> print_endline x + | Error err -> + Format.asprintf "%a" (Diagnostic.pp_validation_error (fun _ _ -> ())) err + |> print_endline + +let validate_my_record input = + let open Data.Validation in + record + (fun obj -> + let+ title = req obj ~alt:[ "name"; "main_title" ] "title" string + and+ kind = opt obj ~alt:[ "k"; "sort" ] "kind" string + and+ desc = req obj ~alt:[ "desc"; "synopsis" ] "description" string + and+ url = opt obj ~alt:[ "link"; "site" ] "url" string in + let open Format in + asprintf "%a\n\ntitle:%s\nkind:%a\ndesc:%s\nurl:%a" Data.pp input title + (pp_print_option pp_print_string) + kind desc + (pp_print_option pp_print_string) + url) + input + +let%expect_test "Validate a regular record" = + my_record () |> validate_my_record |> dump; + [%expect + {| + {"title": "My title", "kind": "My Kind", "description": "A description", + "url": "https://yocaml.github.io"} + + title:My title + kind:My Kind + desc:A description + url:https://yocaml.github.io + |}] + +let%expect_test "Validate a regular record with alternative names" = + my_record ~title:"main_title" ~kind:"sort" ~description:"synopsis" ~url:"site" + () + |> validate_my_record + |> dump; + [%expect + {| + {"main_title": "My title", "sort": "My Kind", "synopsis": "A description", + "site": "https://yocaml.github.io"} + + title:My title + kind:My Kind + desc:A description + url:https://yocaml.github.io + |}] + +let%expect_test "Validate a regular record with missing name - 1" = + my_record ~title:"main_title" ~kind:"invalidfieldname" ~description:"synopsis" + ~url:"site" () + |> validate_my_record + |> dump; + [%expect + {| + {"main_title": "My title", "invalidfieldname": "My Kind", "synopsis": + "A description", "site": "https://yocaml.github.io"} + + title:My title + kind: + desc:A description + url:https://yocaml.github.io + |}] + +let%expect_test "Validate a regular record with missing name - 2" = + my_record ~title:"an_invalid_title_name" ~kind:"invalidfieldname" + ~description:"fail_because_required" ~url:"site" () + |> validate_my_record + |> dump; + [%expect + {| + Invalid record: + Errors (2): + 1) Missing field `title or [name, main_title]` + + 2) Missing field `description or [desc, synopsis]` + + Given record: + an_invalid_title_name = `"My title"` + invalidfieldname = `"My Kind"` + fail_because_required = `"A description"` + site = `"https://yocaml.github.io"` + |}] + +let%expect_test "Validate a regular record with invalid fields" = + Data.( + record + [ + ("title", list_of string []) + ; ("sort", string "My Kind") + ; ("desc", string "A description") + ; ("link", int 42) + ]) + |> validate_my_record + |> dump; + [%expect + {| + Invalid record: + Errors (2): + 1) Invalid field `title`: + Invalid shape: + Expected: strict-string + Given: `[]` + + 2) Invalid field `link`: + Invalid shape: + Expected: strict-string + Given: `42` + + Given record: + title = `[]` + sort = `"My Kind"` + desc = `"A description"` + link = `42` + |}]