Make recursive calls to flatMap stack safe

README.md

@@ -143,6 +143,15 @@ somePromiseGetter()
 
 See [Composible Error Handling in OCaml][error-handling] for several strategies that you may employ.
 
+### Stack Safety
+
+By default this library is not stack safe, you will recieve a 'Maximum call stack size exceeded' error if you recurse too deeply. You can opt into stack safety by passing an optional parameter to the constructors of trampoline. This has a slight overhead. For example:
+
+```reason
+let stackSafe = Future.make(~executor=`trampoline, resolver);
+let stackSafeValue = Future.value(~executor=`trampoline, "Value");
+```
+
 ## TODO
 
 - [ ] Implement cancellation tokens

__tests__/TestFuture.re

@@ -311,4 +311,64 @@ describe("Future Belt.Result", () => {
         |> finish
       );
   });
-});
+
+  testAsync("value recursion is stack safe", finish => {
+    let next = x => Future.value(~executor=`trampoline, x + 1);
+    let numberOfLoops = 10000;
+    let rec loop = x => {
+      next(x)
+      ->Future.flatMap(x => Future.value(x + 1))
+      ->Future.map(x => x + 1)
+      ->Future.flatMap(x =>
+          Future.value(x + 1)->Future.flatMap(x => Future.value(x + 1))
+        )
+      ->Future.flatMap(x' =>
+          if (x' > numberOfLoops) {
+            Future.value(x');
+          } else {
+            loop(x');
+          }
+        );
+    };
+    loop(0)
+    ->Future.get(r =>
+        r |> expect |> toBeGreaterThan(numberOfLoops) |> finish
+      );
+  });
+
+  testAsync("async recursion is stack safe", finish => {
+    let next = x => delay(~executor=`trampoline, 1, () => x + 1);
+    let numberOfLoops = 1000;
+    let rec loop = x => {
+      next(x)
+      ->Future.flatMap(x' =>
+          if (x' == numberOfLoops) {
+            Future.value(x');
+          } else {
+            loop(x');
+          }
+        );
+    };
+    loop(0)
+    ->Future.get(r => r |> expect |> toEqual(numberOfLoops) |> finish);
+  });
+
+  test("value recursion blows the stack with default executor", () => {
+    let next = x => Future.value(x + 1);
+    let numberOfLoops = 10000;
+    let rec loop = x => {
+      next(x)
+      ->Future.flatMap(x' =>
+          if (x' > numberOfLoops) {
+            Future.value(x');
+          } else {
+            loop(x');
+          }
+        );
+    };
+    expect(() =>
+      loop(0)
+    )
+    |> toThrowMessage("Maximum call stack size exceeded");
+  });
+});

__tests__/TestUtil.re

@@ -4,5 +4,7 @@ type timeoutId;
 [@bs.val] [@bs.val]
 external setTimeout: ([@bs.uncurry] (unit => unit), int) => timeoutId = "";
 
-let delay = (ms, f) =>
-  Future.make(resolve => setTimeout(() => f() |> resolve, ms) |> ignore);
+let delay = (~executor=`none, ms, f) =>
+  Future.make(~executor, resolve =>
+    setTimeout(() => f() |> resolve, ms) |> ignore
+  );

src/Future.re

@@ -1,17 +1,47 @@
 type getFn('a) = ('a => unit) => unit;
 
+type executorType = [ | `none | `trampoline];
+
 type t('a) =
-  | Future(getFn('a));
+  | Future(getFn('a), executorType);
+
+let trampoline = {
+  let running = ref(false);
+  let callbacks = [||];
+  let rec runLoop = callback => {
+    callback();
+    switch (Js.Array.pop(callbacks)) {
+    | None => ()
+    | Some(callback) => runLoop(callback)
+    };
+  };
+  callback =>
+    if (running^) {
+      Js.Array.unshift(callback, callbacks) |> ignore;
+    } else {
+      running := true;
+      runLoop(callback);
+      running := false;
+    };
+};
 
-let make = resolver => {
+let make = (~executor: executorType=`none, resolver) => {
   let callbacks = ref([]);
   let data = ref(None);
 
+  let runCallback =
+    switch (executor) {
+    | `none => ((result, cb) => cb(result))
+    | `trampoline => ((result, cb) => trampoline(() => cb(result)))
+    };
+
   resolver(result =>
     switch (data^) {
     | None =>
       data := Some(result);
-      (callbacks^)->Belt.List.reverse->Belt.List.forEach(cb => cb(result));
+      (callbacks^)
+      ->Belt.List.reverse
+      ->Belt.List.forEach(runCallback(result));
       /* Clean up memory usage */
       callbacks := [];
     | Some(_) => () /* Do nothing; theoretically not possible */
@@ -21,21 +51,23 @@ let make = resolver => {
   Future(
     resolve =>
       switch (data^) {
-      | Some(result) => resolve(result)
+      | Some(result) => runCallback(result, resolve)
       | None => callbacks := [resolve, ...callbacks^]
       },
+    executor,
   );
 };
 
-let value = x => make(resolve => resolve(x));
+let value = (~executor: executorType=`none, x) =>
+  make(~executor, resolve => resolve(x));
 
-let map = (Future(get), f) =>
-  make(resolve => get(result => resolve(f(result))));
+let map = (Future(get, executor), f) =>
+  make(~executor, resolve => get(result => resolve(f(result))));
 
-let flatMap = (Future(get), f) =>
-  make(resolve =>
+let flatMap = (Future(get, executor), f) =>
+  make(~executor, resolve =>
     get(result => {
-      let Future(get2) = f(result);
+      let Future(get2, _) = f(result);
       get2(resolve);
     })
   );
@@ -59,12 +91,12 @@ let rec all = futures =>
   | [] => value([])
   };
 
-let tap = (Future(get) as future, f) => {
+let tap = (Future(get, _) as future, f) => {
   get(f);
   future;
 };
 
-let get = (Future(getFn), f) => getFn(f);
+let get = (Future(getFn, _), f) => getFn(f);
 
 /* *
  * Future Belt.Result convenience functions,
@@ -123,4 +155,4 @@ let tapError = (future, f) =>
   );
 
 let (>>=) = flatMapOk;
-let (<$>) = mapOk;
+let (<$>) = mapOk;

src/Future.rei

@@ -1,7 +1,8 @@
 type getFn('a) = ('a => unit) => unit;
-type t('a) = Future(getFn('a));
-let make: (('a => unit) => 'b) => t('a);
-let value: 'a => t('a);
+type executorType = [ `none | `trampoline ];
+type t('a);
+let make: (~executor: executorType=?, ('a => unit) => 'b) => t('a);
+let value: (~executor: executorType=?, 'a) => t('a);
 let map: (t('a), 'a => 'b) => t('b);
 let flatMap: (t('a), 'a => t('b)) => t('b);
 let map2: (t('a), t('b), ('a, 'b) => 'c) => t('c);