From 52ef092a4cdc4b260ef7c14df22e36d6abfaca07 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 14 Dec 2019 14:37:30 -0600
Subject: [PATCH] feat(pool): add infix operators on futures

---
 src/threads/CCPool.ml  | 60 ++++++++++++++++++++++++++++++++----------
 src/threads/CCPool.mli | 12 +++++++++
 2 files changed, 58 insertions(+), 14 deletions(-)

diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml
index ba603fa0..0d85b349 100644
--- a/src/threads/CCPool.ml
+++ b/src/threads/CCPool.ml
@@ -386,20 +386,6 @@ module Make(P : PARAM) = struct
 
     let map_async f fut = map_ ~async:true f fut
 
-    (*$R
-      let a = Fut.make (fun () -> 1) in
-      let b = Fut.map (fun x -> x+1) a in
-      let c = Fut.map (fun x -> x-1) b in
-      OUnit.assert_equal 1 (Fut.get c)
-    *)
-
-    (*$R
-      let a = Fut2.make (fun () -> 1) in
-      let b = Fut2.map (fun x -> x+1) a in
-      let c = Fut2.map (fun x -> x-1) b in
-      OUnit.assert_equal 1 (Fut2.get c)
-    *)
-
     let app_ ~async f x = match f, x with
       | Return f, Return x ->
         if async
@@ -424,6 +410,44 @@ module Make(P : PARAM) = struct
 
     let app_async f x = app_ ~async:true f x
 
+    (*$R
+      let a = Fut.make (fun () -> 1) in
+      let b = Fut.return 42 in
+      let c = Fut.monoid_product CCPair.make a b in
+      OUnit.assert_equal (1,42) (Fut.get c)
+    *)
+
+    (*$R
+      let a = Fut.make (fun () -> 1) in
+      let b = Fut.make (fun () -> 42) in
+      let c = Fut.monoid_product CCPair.make a b in
+      OUnit.assert_equal (1,42) (Fut.get c)
+    *)
+
+    (*$R
+      let a = Fut.make (fun () -> 1) in
+      let b = Fut.map succ @@ Fut.make (fun () -> 41) in
+      let c = Fut.monoid_product CCPair.make a b in
+      OUnit.assert_equal (1,42) (Fut.get c)
+    *)
+
+    let monoid_product f x y = match x, y with
+      | Return x, Return y -> Return (f x y)
+      | FailNow e, _
+      | _, FailNow e -> FailNow e
+      | Return x, Run y ->
+        map_cell_ ~async:false (fun y -> f x y) y ~into:(create_cell())
+      | Run x, Return y ->
+        map_cell_ ~async:false (fun x -> f x y) x ~into:(create_cell())
+      | Run x, Run y ->
+        let cell' = create_cell () in
+        add_handler_ x
+          (function
+            | Done x -> ignore (map_cell_ ~async:false (fun y->f x y) y ~into:cell')
+            | Failed e -> set_fail_ cell' e
+            | Waiting -> assert false);
+        Run cell'
+
     let flat_map f fut = match fut with
       | Return x -> f x
       | FailNow e -> FailNow e
@@ -634,6 +658,14 @@ module Make(P : PARAM) = struct
       let (>>) a f = and_then a f
       let (>|=) a f = map f a
       let (<*>) = app
+
+
+    include CCShimsMkLet_.Make(struct
+        type nonrec 'a t = 'a t
+        let (>>=) = (>>=)
+        let (>|=) = (>|=)
+        let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2
+      end)
     end
 
     include Infix
diff --git a/src/threads/CCPool.mli b/src/threads/CCPool.mli
index c57914e4..5fe2cf6a 100644
--- a/src/threads/CCPool.mli
+++ b/src/threads/CCPool.mli
@@ -132,6 +132,10 @@ module Make(P : PARAM) : sig
     val map_async : ('a -> 'b) -> 'a t -> 'b t
     (** Map the value inside the future, to be computed in a separated job. *)
 
+    val monoid_product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+    (** Cartesian product of the content of these futures.
+        @since NEXT_RELEASE *)
+
     val app : ('a -> 'b) t -> 'a t -> 'b t
     (** [app f x] applies the result of [f] to the result of [x]. *)
 
@@ -149,6 +153,10 @@ module Make(P : PARAM) : sig
       val (>>) : 'a t -> (unit -> 'b t) -> 'b t
       val (>|=) : 'a t -> ('a -> 'b) -> 'b t
       val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
+
+      (** Let operators on OCaml >= 4.08.0, nothing otherwise
+          @since NEXT_RELEASE *)
+      include CCShimsMkLet_.S with type 'a t_let := 'a t
     end
 
     val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
@@ -160,5 +168,9 @@ module Make(P : PARAM) : sig
 
     val (<*>): ('a -> 'b) t -> 'a t -> 'b t
     (** Alias to {!app}. *)
+
+    (** Let operators on OCaml >= 4.08.0, nothing otherwise
+        @since NEXT_RELEASE *)
+    include CCShimsMkLet_.S with type 'a t_let := 'a t
   end
 end