Sexp improvement

CHANGES.md

@@ -2,6 +2,8 @@
 
 - Add `Log.src` for logging (by [xvw](https://xvw.lol))
 - Add template chain (by [xvw](https://xvw.lol))
+- Add Sexp control (by [xvw](https://xvw.lol))
+- Add `field` and some combinators for validating record field (that unify `required`, `optional` and `optional_or`) (by [xvw](https://xvw.lol))
 
 ### v2.3.0 2025-05-25 Nantes (France)
 

doc/data_validation.mld

@@ -764,7 +764,7 @@ to a string, I can easily use [$]:
 
 {eof@ocaml[
 # V.(int $ string_of_int) (D.int 23) ;;
-- : string V.validated_value = Ok "23"
+- : (string, V.value_error) result = Result.Ok "23"
 ]eof}
 
 We used [$] to transform a validated value and project it into the desired
@@ -791,8 +791,8 @@ Let's try it with an integer that doesn't respect the expectation:
 
 {eof@ocaml[
 # positive_and_even (D.int (-23)) ;;
-- : int Yocaml.Data.Validation.validated_value =
-Error
+- : (int, V.value_error) result =
+Result.Error
  (Yocaml.Data.Validation.With_message
    {Yocaml.Data.Validation.given = "-23"; message = "should be positive"})
 ]eof}
@@ -802,8 +802,8 @@ reason:
 
 {eof@ocaml[
 # positive_and_even (D.int 25) ;;
-- : int Yocaml.Data.Validation.validated_value =
-Error
+- : (int, V.value_error) result =
+Result.Error
  (Yocaml.Data.Validation.With_message
    {Yocaml.Data.Validation.given = "*"; message = "unsatisfied predicate"})
 ]eof}
@@ -812,7 +812,7 @@ And let's finally try it with a valid integer!
 
 {eof@ocaml[
 # positive_and_even (D.int 24) ;;
-- : int Yocaml.Data.Validation.validated_value = Ok 24
+- : (int, V.value_error) result = Result.Ok 24
 ]eof}
 
 The sequential application lets you chain validators to build validation
@@ -836,17 +836,17 @@ And it can be used with const in the event of absolute valis failure :
 
 {eof@ocaml[
 # V.(my_v / const "erf") (D.string "Hello") ;;
-- : string V.validated_value = Ok "Hello"
+- : (string, V.value_error) result = Result.Ok "Hello"
 ]eof}
 
 {eof@ocaml[
 # V.(my_v / const "erf") (D.int 1234) ;;
-- : string V.validated_value = Ok "1234"
+- : (string, V.value_error) result = Result.Ok "1234"
 ]eof}
 
 {eof@ocaml[
 # V.(my_v / const "erf") D.(list_of string ["Hello"]) ;;
-- : string V.validated_value = Ok "erf"
+- : (string, V.value_error) result = Result.Ok "erf"
 ]eof}
 
 With the support of alternatives, we've seen all the ways to build increasingly
@@ -991,3 +991,104 @@ Result.Error
 
 In some cases, dependent validation makes it possible to construct increasingly
 complex situations, so it should only be used when really necessary.
+
+
+{1 A more generic approach of record validation}
+
+Controlling the optionality (or otherwise) of a field can be a
+handicap, which is why, since more recent versions of YOCaml, there is
+the {!val:Yocaml.Data.Validation.field} primitive. Let's imagine the
+following type:
+
+{eof@ocaml[
+type my_type = {
+  username: string;
+  age: int;
+  gender : string option;
+  is_activated : bool
+}
+]eof}
+
+We could imagine the following validation function:
+
+{eof@ocaml[
+# let validate_my_type =
+    let open Yocaml.Data.Validation in
+    record (fun fields ->
+      let+ username = field (fetch fields "username") string
+      and+ age = field (fetch fields "age") (int & positive)
+      and+ gender = field (fetch fields "gender") (option string)
+      and+ is_activated =
+            field (fetch fields "activated") (option bool)
+            |? field (fetch fields "active") (option bool)
+            |? field (fetch fields "is_activated") (option bool)
+            $? Ok false
+      in
+      { username; age; gender; is_activated }
+    ) ;;
+val validate_my_type : D.t -> my_type Yocaml.Data.Validation.validated_value =
+  <fun>
+]eof}
+
+We can now validate an arbitrary record:
+
+{eof@ocaml[
+# validate_my_type Yocaml.Data.(record [
+     "username", string "bar"
+    ; "age", int 3
+    ; "active", bool true
+  ]) ;;
+- : my_type Yocaml.Data.Validation.validated_value =
+Ok {username = "bar"; age = 3; gender = None; is_activated = true}
+]eof}
+
+{eof@ocaml[
+# validate_my_type Yocaml.Data.(record [
+     "username", string "bar"
+    ; "age", int 3
+    ; "is_activated", bool true
+  ]) ;;
+- : my_type Yocaml.Data.Validation.validated_value =
+Ok {username = "bar"; age = 3; gender = None; is_activated = true}
+]eof}
+
+{eof@ocaml[
+# validate_my_type Yocaml.Data.(record [
+     "username", string "bar"
+    ; "age", int 3
+    ; "activated", bool true
+  ]) ;;
+- : my_type Yocaml.Data.Validation.validated_value =
+Ok {username = "bar"; age = 3; gender = None; is_activated = true}
+]eof}
+
+There is also an infix notation to simplify writing [fetch]:
+
+{eof@ocaml[
+# let validate_my_type =
+    let open Yocaml.Data.Validation in
+    record (fun fields ->
+      let+ username = field fields.${"username"} string
+      and+ age = field fields.${"age"} (int & positive)
+      and+ gender = field fields.${"gender"} (option string)
+      and+ is_activated =
+            field (fetch fields "activated") (option bool)
+            |? field (fetch fields "active") (option bool)
+            |? field (fetch fields "is_activated") (option bool)
+            $! false
+      in
+      { username; age; gender; is_activated }
+    ) ;;
+val validate_my_type : D.t -> my_type Yocaml.Data.Validation.validated_value =
+  <fun>
+]eof}
+
+{eof@ocaml[
+# validate_my_type Yocaml.Data.(record [
+     "username", string "bar"
+    ; "age", int 3
+    ; "activated", bool true
+  ]) ;;
+- : my_type Yocaml.Data.Validation.validated_value =
+Ok {username = "bar"; age = 3; gender = None; is_activated = true}
+]eof}

lib/core/data.ml

@@ -40,6 +40,7 @@ let list v = List v
 let list_of f l = list @@ List.map f l
 let record fields = Record fields
 let option some = Option.fold ~none:null ~some
+let path p = string (Path.to_string p)
 
 let sum f value =
   let k, v = f value in
@@ -84,6 +85,24 @@ let rec pp ppf = function
              Format.fprintf ppf {|"%s":@, %a|} key pp value))
         x
 
+let rec to_sexp = function
+  | Null -> Sexp.atom "null"
+  | Bool x -> Sexp.atom (string_of_bool x)
+  | Int x -> Sexp.atom (string_of_int x)
+  | Float x -> Sexp.atom (string_of_float x)
+  | String x -> Sexp.atom x
+  | List x ->
+      Sexp.node
+        (Stdlib.List.concat_map (function Null -> [] | x -> [ to_sexp x ]) x)
+  | Record xs ->
+      Sexp.node
+        (Stdlib.List.concat_map
+           (fun (k, v) ->
+             match v with
+             | Null -> []
+             | v -> [ Sexp.(node [ atom k; to_sexp v ]) ])
+           xs)
+
 let rec to_ezjsonm = function
   | Null -> `Null
   | Bool b -> `Bool b
@@ -312,6 +331,17 @@ module Validation = struct
                Invalid_record { errors; given = li })
     | invalid_value -> invalid_shape "record" invalid_value
 
+  let field fetch validator =
+    let field, value = fetch () in
+    let value = Option.value ~default:Null value in
+    value
+    |> validator
+    |> Result.map_error (fun error ->
+           Nel.singleton @@ Invalid_field { given = value; error; field })
+
+  let fetch fields field () = (field, find_assoc field fields)
+  let ( .${} ) fields field = fetch fields field
+
   let optional assoc field validator =
     match find_assoc field assoc with
     | None | Some Null -> Ok None
@@ -341,6 +371,11 @@ module Validation = struct
     let ( & ) l r x = Result.bind (l x) r
     let ( / ) l r x = Result.fold ~ok:Result.ok ~error:(fun _ -> r x) (l x)
     let ( $ ) l f x = Result.map f (l x)
+    let ( $? ) l f = Result.bind l (function None -> f | Some x -> Ok x)
+    let ( $! ) l f = Result.bind l (function None -> Ok f | Some x -> Ok x)
+
+    let ( |? ) l f =
+      Result.bind l (function None -> f | Some x -> Ok (Some x))
   end
 
   module Syntax = struct
@@ -373,4 +408,6 @@ module Validation = struct
     x
     |> pair f (triple g h i)
     |> Result.map (fun (w, (x, y, z)) -> (w, x, y, z))
+
+  let path = string $ Path.from_string
 end

lib/core/data.mli

@@ -100,6 +100,11 @@ val either : ('a -> t) -> ('b -> t) -> ('a, 'b) Either.t -> t
 (** [either f g x] construct either as a {!type:t}. Either has the structure
     [{"constr": "left | right", "value": e}]. *)
 
+(** {2 Specific Data values} *)
+
+val path : Path.t -> t
+(** Normalize a Path. *)
+
 (** {1 Validating Data values} *)
 
 module Validation : sig
@@ -226,6 +231,9 @@ module Validation : sig
     -> ('a, 'b) Either.t validated_value
   (** [either left right v] validated a [either] value. *)
 
+  val path : t -> Path.t validated_value
+  (** Validate a Path. *)
+
   (** {2 Validators on parsed data}
 
       Validators to use when data is already parsed. *)
@@ -335,23 +343,33 @@ module Validation : sig
     *)
 
     val ( & ) :
-         ('a -> 'b validated_value)
-      -> ('b -> 'c validated_value)
+         ('a -> ('b, 'e) Result.t)
+      -> ('b -> ('c, 'e) Result.t)
       -> 'a
-      -> 'c validated_value
+      -> ('c, 'e) Result.t
     (** [(v1 & v2) x] sequentially compose [v2 (v1 x)], so [v1] following by
         [v2]. For example : [int &> positive &> c]. *)
 
     val ( / ) :
-         ('a -> 'b validated_value)
-      -> ('a -> 'b validated_value)
+         ('a -> ('b, 'e) Result.t)
+      -> ('a -> ('b, 'e) Result.t)
       -> 'a
-      -> 'b validated_value
+      -> ('b, 'e) Result.t
     (** [(v1 / v2) x] perform [v1 x] and if it fail, performs [v2 x]. *)
 
     val ( $ ) :
-      ('a -> 'b validated_value) -> ('b -> 'c) -> 'a -> 'c validated_value
+      ('a -> ('b, 'c) Result.t) -> ('b -> 'd) -> 'a -> ('d, 'c) Result.t
     (** [(v1 $ f) x] perform [f] on the result of [v1 x]. *)
+
+    val ( $? ) : ('a option, 'b) result -> ('a, 'b) result -> ('a, 'b) result
+    (** [f $? k] is [k] if [f] is [None] or [x] if [f] is [Some x]. *)
+
+    val ( $! ) : ('a option, 'b) result -> 'a -> ('a, 'b) result
+    (** [f $? k] is [Ok k] if [f] is [None] or [x] if [f] is [Some x]. *)
+
+    val ( |? ) :
+      ('a option, 'b) result -> ('a option, 'b) result -> ('a option, 'b) result
+    (** [f |? k] is [k] if [f] is [None], [f] otherwise. *)
   end
 
   include module type of Infix
@@ -390,6 +408,18 @@ module Validation : sig
       validated by [validator]. If the field does not exists, it return default.
       ([default] is not validated) *)
 
+  val field :
+       (unit -> string * t option)
+    -> (t -> 'a validated_value)
+    -> 'a validated_record
+  (** [field f validator] is a more generic validator for record fields. *)
+
+  val fetch : (string * t) list -> string -> unit -> string * t option
+  (** To be used with [field], ie: [field (fetch "foo" fieldset) v]*)
+
+  val ( .${} ) : (string * t) list -> string -> unit -> string * t option
+  (** An indexing version of [fetch]. *)
+
   (** {2 Bindings operators} *)
 
   module Syntax : sig
@@ -438,6 +468,9 @@ val equal : t -> t -> bool
 val pp : Format.formatter -> t -> unit
 (** Pretty-printer for {!type:t} (mostly used for debugging issue). *)
 
+val to_sexp : t -> Sexp.t
+(** [to_sexp] convert to a {!type:Yocaml.Sexp.t}. *)
+
 val to_ezjsonm : t -> ezjsonm
 (** [to_ezjsonm v] converts a {!type:t} into a {!type:ezjsonm}. *)