Kleisli Composition Operator and Apply_or Added (#455)

Added the Kleisli composition operator for Option, Result, and CCFun.

src/core/CCFun.mli

@@ -101,11 +101,13 @@ module Monad (X : sig
   type t
 end) : sig
   type 'a t = X.t -> 'a
+  (** Definition of a monad in continuation-passing style. *)
 
   val return : 'a -> 'a t
   (** Monadic [return]. *)
 
   val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
+  (** Monadic [map]. *)
 
   val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
   (** Monadic [bind]. *)

src/core/CCOption.ml

@@ -55,6 +55,10 @@ let[@inline] bind o f = flat_map f o
 let ( >>= ) = bind
 let pure x = Some x
 
+let k_compose f g x = f x |> flat_map g
+let ( >=> ) = k_compose
+let ( <=< ) f g = g >=> f 
+
 let ( <*> ) f x =
   match f, x with
   | None, _ | _, None -> None
@@ -111,6 +115,13 @@ let get_or ~default x =
   | None -> default
   | Some y -> y
 
+let apply_or f x =
+  match f x with
+  | None -> x
+  | Some y -> y
+
+let ( |?> ) x f = apply_or f x
+
 let value x ~default =
   match x with
   | None -> default
@@ -181,6 +192,7 @@ module Infix = struct
   let ( <*> ) = ( <*> )
   let ( <$> ) = map
   let ( <+> ) = ( <+> )
+  let ( |?> ) = ( |?> )
   let ( let+ ) = ( >|= )
   let ( let* ) = ( >>= )
 
@@ -190,6 +202,10 @@ module Infix = struct
     | _ -> None
 
   let ( and* ) = ( and+ )
+
+  let ( >=> ) = ( >=> )
+
+  let ( <=< ) = ( <=< )
 end
 
 include Infix

src/core/CCOption.mli

@@ -58,6 +58,9 @@ val bind : 'a t -> ('a -> 'b t) -> 'b t
     Monadic bind.
     @since 3.0 *)
 
+val k_compose : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
+(** Kleisli composition. Monadic equivalent of CCFun.compose *)
+
 val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
 (** [map2 f o1 o2] maps ['a option] and ['b option] to a ['c option] using [f]. *)
 
@@ -92,6 +95,12 @@ val get_or : default:'a -> 'a t -> 'a
     returns [default] if [o] is [None].
     @since 0.18 *)
 
+val apply_or : ('a -> 'a t) -> 'a -> 'a
+(** [apply_or f x] returns the original [x] if [f] fails, or unwraps [f x] if it succeeds.
+    Useful for piping preprocessing functions together (such as string processing),
+    turning functions like "remove" into "remove_if_it_exists".
+    *)
+
 val value : 'a t -> default:'a -> 'a
 (** [value o ~default] is similar to the Stdlib's [Option.value] and to {!get_or}.
     @since 2.8 *)
@@ -175,10 +184,19 @@ module Infix : sig
   val ( <+> ) : 'a t -> 'a t -> 'a t
   (** [o1 <+> o2] is [o1] if [o1] is [Some _], [o2] if [o1] is [None]. *)
 
+  val ( |?> ) : 'a -> ('a -> 'a t) -> 'a
+  (** [x |?> f] is [apply_or f x] *)
+
   val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
   val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
   val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
   val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
+
+  val ( >=> ) : ('a -> 'b t) -> ('b -> 'c t) -> 'a -> 'c t
+  (** Monadic [k_compose]. *)
+  
+  val ( <=< ) : ('b -> 'c t) -> ('a -> 'b t) -> 'a -> 'c t
+  (** Reverse monadic [k_compose]. *)
 end
 
 include module type of Infix

src/core/CCResult.ml

@@ -101,6 +101,13 @@ let get_or e ~default =
   | Ok x -> x
   | Error _ -> default
 
+let apply_or f x =
+  match f x with
+  | Error _ -> x
+  | Ok y -> y
+
+let ( |?> ) x f = apply_or f x
+
 let get_lazy f e =
   match e with
   | Ok x -> x
@@ -125,6 +132,11 @@ let flat_map f e =
   | Ok x -> f x
   | Error s -> Error s
 
+let k_compose f g x = f x |> flat_map g
+
+let ( >=> ) = k_compose
+let ( <=< ) f g = g >=> f 
+
 let equal ~err eq a b =
   match a, b with
   | Ok x, Ok y -> eq x y
@@ -265,6 +277,7 @@ module Infix = struct
   let ( >|= ) e f = map f e
   let ( >>= ) e f = flat_map f e
   let ( <*> ) = ( <*> )
+  let ( |?> ) = ( |?> )
   let ( let+ ) = ( >|= )
   let ( let* ) = ( >>= )
 
@@ -275,6 +288,9 @@ module Infix = struct
     | _, Error e -> Error e
 
   let ( and* ) = ( and+ )
+
+  let ( >=> ) = ( >=> )
+  let ( <=< ) = ( <=< )
 end
 
 include Infix

src/core/CCResult.mli

@@ -96,6 +96,12 @@ val get_exn : ('a, _) t -> 'a
 val get_or : ('a, _) t -> default:'a -> 'a
 (** [get_or e ~default] returns [x] if [e = Ok x], [default] otherwise. *)
 
+val apply_or : ('a -> ('a, _) t) -> 'a -> 'a
+(** [apply_or f x] returns the original [x] if [f] fails, or unwraps [f x] if it succeeds.
+    Useful for piping preprocessing functions together (such as string processing),
+    turning functions like "remove" into "remove_if_it_exists".
+    *)
+
 val get_or_failwith : ('a, string) t -> 'a
 (** [get_or_failwith e] returns [x] if [e = Ok x], fails otherwise.
     @raise Failure with [msg] if [e = Error msg].
@@ -113,6 +119,11 @@ val catch : ('a, 'err) t -> ok:('a -> 'b) -> err:('err -> 'b) -> 'b
     the value of [e]. *)
 
 val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t
+
+val k_compose : 
+  ('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t
+(** Kleisli composition. Monadic equivalent of CCFun.compose *)
+
 val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal
 val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord
 
@@ -188,6 +199,8 @@ module Infix : sig
       [Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen
       over the error of [b] if both fail. *)
 
+  val ( |?> ) : 'a -> ('a -> ('a, _) t) -> 'a
+
   val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t
   (** @since 2.8 *)
 
@@ -199,6 +212,14 @@ module Infix : sig
 
   val ( and* ) : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t
   (** @since 2.8 *)
+
+  val ( >=> ) :
+    ('a -> ('b, 'err) t) -> ('b -> ('c, 'err) t) -> 'a -> ('c, 'err) t
+  (** Monadic [k_compose]. *)
+  
+  val ( <=< ) :
+    ('b -> ('c, 'err) t) -> ('a -> ('b, 'err) t) -> 'a -> ('c, 'err) t
+  (** Reverse monadic [k_compose]. *)
 end
 
 include module type of Infix