Add Yocaml.Data.Validation.where_opt

Author: xvw

CHANGES.md

@@ -1,6 +1,8 @@
 ### unreleased
 
 #### Yocaml
+
+- 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))
 

lib/core/data.ml

@@ -281,6 +281,16 @@ module Validation = struct
       fail_with ~given:(Format.asprintf "%a" pp x) (f x)
     else Ok x
 
+  let where_opt ?pp ?message predicate x =
+    match predicate x with
+    | Some x -> Ok x
+    | None ->
+        let pp = mk_pp pp in
+        let f =
+          Option.value ~default:(fun _ -> "unsatisfied predicate") message
+        in
+        fail_with ~given:(Format.asprintf "%a" pp x) (f x)
+
   let sum branch x =
     let str_expectation () =
       branch
@@ -541,6 +551,9 @@ module Validation = struct
     let where ?message predicate actual =
       where ~pp:string_pp ?message predicate actual
 
+    let where_opt ?message predicate actual =
+      where_opt ~pp:string_pp ?message predicate actual
+
     let lowercase_ascii = Stdlib.String.lowercase_ascii
     let trim = Stdlib.String.trim
   end
@@ -561,6 +574,7 @@ module Validation = struct
     let le = pp_cmp le
     let one_of = pp_equal one_of
     let where = with_pp where
+    let where_opt ?message f = (with_pp where_opt) ?message f
   end
 
   module Float = struct
@@ -579,6 +593,7 @@ module Validation = struct
     let le = pp_cmp le
     let one_of = pp_equal one_of
     let where = with_pp where
+    let where_opt ?message f = (with_pp where_opt) ?message f
   end
 
   let negate validator x =

lib/core/data.mli

@@ -332,6 +332,15 @@ module Validation : sig
   (** [where ?pp predicate x] ensure that [x] is satisfying [predicate]. [pp] is
       used for error-reporting.*)
 
+  val where_opt :
+       ?pp:(Format.formatter -> 'a -> unit)
+    -> ?message:('a -> string)
+    -> ('a -> 'b option)
+    -> 'a
+    -> 'b validated_value
+  (** [where_opt ?pp predicate x] ensure that [predicate x] return [Some]. [pp]
+      is used for error-reporting.*)
+
   val const : 'a -> 'b -> ('a, 'c) result
   (** [const k r] wrap [k] as valid and discard [r]. *)
 
@@ -535,6 +544,14 @@ module Validation : sig
     (** [where ?message predicate actual] ensures that [actual] satisfies
         [predicate]. [message] is used for custom error messages. *)
 
+    val where_opt :
+         ?message:(string -> string)
+      -> (string -> 'b option)
+      -> string
+      -> 'b validated_value
+    (** [where_opt ?pp predicate x] ensure that [predicate x] return [Some].
+        [pp] is used for error-reporting.*)
+
     (** Useful function to be used with regular string validators. *)
 
     val lowercase_ascii : string -> string
@@ -576,6 +593,13 @@ module Validation : sig
     val where :
       ?message:(int -> string) -> (int -> bool) -> int -> int validated_value
     (** Integer version of {!val:Data.Validation.where} *)
+
+    val where_opt :
+         ?message:(int -> string)
+      -> (int -> 'b option)
+      -> int
+      -> 'b validated_value
+    (** Integer version of {!val:Data.Validation.where_opt} *)
   end
 
   (** {2 Float validators}
@@ -616,6 +640,13 @@ module Validation : sig
       -> float
       -> float validated_value
     (** Float version of {!val:Data.Validation.where} *)
+
+    val where_opt :
+         ?message:(float -> string)
+      -> (float -> 'b option)
+      -> float
+      -> 'b validated_value
+    (** Integer version of {!val:Data.Validation.where_opt} *)
   end
 
   (** {2 Validator combinators} *)