Extend Monad for folding over lists

base.opam

@@ -11,7 +11,7 @@ build: [
 ]
 depends: [
   "ocaml" {>= "4.10.0"}
-  "sexplib0"
+  "sexplib0" {>= "v0.15.0"}
   "dune"              {>= "2.0.0"}
   "dune-configurator"
 ]

src/dune

@@ -9,6 +9,7 @@
 
 (library (name base) (public_name base)
  (libraries base_internalhash_types caml sexplib0 shadow_stdlib)
+ (flags :standard -w -55)
  (c_flags :standard -D_LARGEFILE64_SOURCE (:include mpopcnt.sexp))
  (c_names exn_stubs int_math_stubs hash_stubs am_testing)
  (preprocess no_preprocessing)

src/list.ml

@@ -763,6 +763,8 @@ module Cartesian_product = struct
   let all_unit = Monad.all_unit
   let ignore_m = Monad.ignore_m
   let join = Monad.join
+  let fold_list = Monad.fold_list
+  let map_list = Monad.map_list
 
   module Monad_infix = struct
     let ( >>| ) = ( >>| )

src/monad.ml

@@ -66,6 +66,21 @@ module Make_general (M : Basic_general) = struct
     | [] -> return ()
     | t :: ts -> t >>= fun () -> all_unit ts
   ;;
+
+  let fold_list ~f ~init =
+    let rec loop acc = function
+      | [] -> return acc
+      | t :: ts -> f acc t >>= fun acc -> loop acc ts
+    in
+    loop init
+
+  let map_list ~f =
+    let rec loop vs = function
+      | [] -> return (List.rev vs)
+      | t :: ts -> f t >>= fun v -> loop (v :: vs) ts
+    in
+    loop []
+
 end
 
 module Make_indexed (M : Basic_indexed) :

src/monad_intf.ml

@@ -89,6 +89,14 @@ module type S_without_syntax = sig
   (** Like [all], but ensures that every monadic value in the list produces a unit value,
       all of which are discarded rather than being collected into a list. *)
   val all_unit : unit t list -> unit t
+
+  (** [fold_list ~f ~init [v1; ...; vn]] folds over a list applying a monadic operation,
+      i.e., performs [f init v1 >>= fun acc -> f acc v2 >>= ... >>= fun acc -> f acc vn]. *)
+  val fold_list : f:('a -> 'b -> 'a t) -> init:'a -> 'b list -> 'a t
+
+  (** [map_list ~f [v1; ...; vn]] applies a monadic operation to each element of a list,
+      i.e., performs [f v1 >>= fun w1 -> f v2 >>= fun w2 -> ... f vn >>= fun wn -> return [w1; ...; wn]]. *)
+  val map_list : f:('a -> 'b t) -> 'a list -> 'b list t
 end
 
 module type S = sig
@@ -156,6 +164,8 @@ module type S2 = sig
   val ignore_m : (_, 'e) t -> (unit, 'e) t
   val all : ('a, 'e) t list -> ('a list, 'e) t
   val all_unit : (unit, 'e) t list -> (unit, 'e) t
+  val fold_list : f:('a -> 'b -> ('a, 'e) t) -> init:'a -> 'b list -> ('a, 'e) t
+  val map_list : f:('a -> ('b, 'e) t) -> 'a list -> ('b list, 'e) t
 end
 
 module type Basic3 = sig
@@ -218,6 +228,8 @@ module type S3 = sig
   val ignore_m : (_, 'd, 'e) t -> (unit, 'd, 'e) t
   val all : ('a, 'd, 'e) t list -> ('a list, 'd, 'e) t
   val all_unit : (unit, 'd, 'e) t list -> (unit, 'd, 'e) t
+  val fold_list : f:('a -> 'b -> ('a, 'd, 'e) t) -> init:'a -> 'b list -> ('a, 'd, 'e) t
+  val map_list : f:('a -> ('b, 'd, 'e) t) -> 'a list -> ('b list, 'd, 'e) t
 end
 
 module type Basic_indexed = sig
@@ -299,6 +311,8 @@ module type S_indexed = sig
   val ignore_m : (_, 'i, 'j) t -> (unit, 'i, 'j) t
   val all : ('a, 'i, 'i) t list -> ('a list, 'i, 'i) t
   val all_unit : (unit, 'i, 'i) t list -> (unit, 'i, 'i) t
+  val fold_list : f:('a -> 'b -> ('a, 'i, 'i) t) -> init:'a -> 'b list -> ('a, 'i, 'i) t
+  val map_list : f:('a -> ('b, 'i, 'i) t) -> 'a list -> ('b list, 'i, 'i) t
 end
 
 module S_to_S2 (X : S) : S2 with type ('a, 'e) t = 'a X.t = struct