Add canceler to forkAll

Author: natefaubion

docs/Control.Monad.Aff.md

@@ -162,12 +162,14 @@ forked computation.
 #### `forkAll`
 
 ``` purescript
-forkAll :: forall f e a. (Foldable f) => f (Aff e a) -> Aff e Unit
+forkAll :: forall f e a. (Foldable f) => f (Aff e a) -> Aff e (Canceler e)
 ```
 
-Forks many asynchronous computation at once, ignoring the results.
+Forks many asynchronous computation in a synchronous manner while being
+stack-safe up to the selected Foldable instance.
 
-This function is stack-safe up to the selected Foldable instance.
+Returns a canceler that can be used to attempt cancellation of all
+forked computations.
 
 #### `attempt`
 

src/Control/Monad/Aff.js

@@ -100,14 +100,49 @@ exports._forkAll = function (nonCanceler, foldl, affs) {
   var voidF = function(){};
 
   return function(success, error) {
-    foldl(function(_) {
+    var cancelers = foldl(function(acc) {
       return function(aff) {
-        aff(voidF, voidF);
+        acc.push(aff(voidF, voidF));
+        return acc;
+      }
+    })([])(affs);
+
+    var canceler = function(e) {
+      return function(success, error) {
+        var cancellations = 0;
+        var result        = false;
+        var errored       = false;
+
+        var s = function(bool) {
+          cancellations = cancellations + 1;
+          result        = result || bool;
+
+          if (cancellations === cancelers.length && !errored) {
+            try {
+              success(result);
+            } catch (e) {
+              error(e);
+            }
+          }
+        };
+
+        var f = function(err) {
+          if (!errored) {
+            errored = true;
+            error(err);
+          }
+        };
+
+        for (var i = 0; i < cancelers.length; i++) {
+          cancelers[i](e)(s, f);
+        }
+
+        return nonCanceler;
       };
-    })({})(affs);
+    };
 
     try {
-      success({});
+      success(canceler);
     } catch(e) {
       error(e);
     }

src/Control/Monad/Aff.purs

@@ -122,10 +122,12 @@ finally aff1 aff2 = do
 forkAff :: forall e a. Aff e a -> Aff e (Canceler e)
 forkAff aff = runFn2 _forkAff nonCanceler aff
 
--- | Forks many asynchronous computation at once, ignoring the results.
+-- | Forks many asynchronous computation in a synchronous manner while being
+-- | stack-safe up to the selected Foldable instance.
 -- |
--- | This function is stack-safe up to the selected Foldable instance.
-forkAll :: forall f e a. (Foldable f) => f (Aff e a) -> Aff e Unit
+-- | Returns a canceler that can be used to attempt cancellation of all
+-- | forked computations.
+forkAll :: forall f e a. (Foldable f) => f (Aff e a) -> Aff e (Canceler e)
 forkAll affs = runFn3 _forkAll nonCanceler foldl affs
 
 -- | Promotes any error to the value level of the asynchronous monad.
@@ -215,7 +217,7 @@ foreign import _unsafeInterleaveAff :: forall e1 e2 a. Aff e1 a -> Aff e2 a
 
 foreign import _forkAff :: forall e a. Fn2 (Canceler e) (Aff e a) (Aff e (Canceler e))
 
-foreign import _forkAll :: forall f e a b. Fn3 (Canceler e) ((b -> a -> b) -> b -> f a -> b) (f (Aff e a)) (Aff e Unit)
+foreign import _forkAll :: forall f e a b. Fn3 (Canceler e) ((b -> a -> b) -> b -> f a -> b) (f (Aff e a)) (Aff e (Canceler e))
 
 foreign import _makeAff :: forall e a. ((Error -> Eff e Unit) -> (a -> Eff e Unit) -> Eff e (Canceler e)) -> Aff e a
 

test/Test/Main.purs

@@ -2,16 +2,16 @@ module Test.Main where
 
 import Prelude
 
-import Control.Monad.Aff (Aff(), runAff, later', forkAll)
+import Control.Monad.Aff (Aff(), runAff, later', forkAll, cancel)
 import Control.Monad.Aff.AVar (AVAR(), makeVar', modifyVar, takeVar)
 import Control.Monad.Cont.Class (callCC)
 import Control.Monad.Eff (Eff())
 import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Console (CONSOLE(), log, print)
-import Control.Monad.Eff.Exception (EXCEPTION(), throwException)
+import Control.Monad.Eff.Exception (EXCEPTION(), throwException, error)
 import Control.Monad.Rec.Class (tailRecM)
 
-import Data.Array ((..))
+import Data.Array (replicate)
 import Data.Either (Either(..))
 
 loop :: forall eff. Int -> Aff (console :: CONSOLE | eff) Unit
@@ -25,10 +25,16 @@ loop n = tailRecM go n
 all :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
 all n = do
   var <- makeVar' 0
-  forkAll $ map (\_ -> modifyVar (+ 1) var) (1 .. n)
+  forkAll $ replicate n (modifyVar (+ 1) var)
   count <- takeVar var
   liftEff $ log ("Forked " <> show count)
 
+cancelAll :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
+cancelAll n = do
+  canceler <- forkAll $ replicate n (later' 100000 (liftEff $ log "oops"))
+  canceled <- cancel canceler (error "bye")
+  liftEff $ log ("Cancelled all: " <> show canceled)
+
 delay :: forall eff. Int -> Aff eff Unit
 delay n = callCC \cont ->
   later' n (cont unit)
@@ -40,3 +46,4 @@ main = runAff throwException (const (pure unit)) $ do
   liftEff $ log "post-delay"
   loop 1000000
   all 100000
+  cancelAll 100000