Add lazy thread map

Author: natefaubion

src/Control/Monad/Aff.js

@@ -90,6 +90,32 @@ exports.bracket = function (acquire) {
   };
 };
 
+exports.mapThread = function () {
+  var EMPTY = {};
+
+  return function (f) {
+    return function (thread) {
+      var value = EMPTY;
+
+      function force() {
+        if (value === EMPTY) {
+          return new Aff(BIND, thread.join, function (result) {
+            value = new Aff(PURE, f(result));
+            return value;
+          });
+        } else {
+          return value;
+        }
+      }
+
+      return {
+        kill: thread.kill,
+        join: new Aff(BIND, new Aff(PURE, void 0), force)
+      };
+    };
+  };
+}();
+
 exports._delay = function () {
   var setDelay = function (n, k) {
     if (n === 0 && typeof setImmediate !== "undefined") {

src/Control/Monad/Aff.purs

@@ -15,6 +15,7 @@ module Control.Monad.Aff
   , atomically
   , killThread
   , joinThread
+  , module Exports
   ) where
 
 import Prelude
@@ -28,6 +29,7 @@ import Control.Monad.Eff.Ref (newRef, readRef, writeRef)
 import Control.Monad.Eff.Ref.Unsafe (unsafeRunRef)
 import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow, throwError, catchError, try)
+import Control.Monad.Error.Class (try) as Exports
 import Control.Monad.Rec.Class (class MonadRec, Step(..))
 import Control.MonadPlus (class MonadPlus)
 import Control.MonadZero (class MonadZero)
@@ -188,7 +190,7 @@ newtype Thread eff a = Thread
   }
 
 instance functorThread ∷ Functor (Thread eff) where
-  map f (Thread { kill, join }) = Thread { kill, join: f <$> join }
+  map = mapThread
 
 killThread ∷ ∀ eff a. Error → Thread eff a → Aff eff Unit
 killThread e (Thread t) = t.kill e
@@ -240,6 +242,7 @@ foreign import _delay ∷ ∀ a eff. Fn.Fn2 (Unit → Either a Unit) Number (Aff
 foreign import _liftEff ∷ ∀ eff a. Eff eff a → Aff eff a
 foreign import bracket ∷ ∀ eff a b. Aff eff a → (a → Aff eff Unit) → (a → Aff eff b) → Aff eff b
 foreign import makeAff ∷ ∀ eff a. ((Either Error a → Eff eff Unit) → Eff eff (Canceler eff)) → Aff eff a
+foreign import mapThread ∷ ∀ eff a b. (a → b) → Thread eff a → Thread eff b
 
 foreign import _launchAff
   ∷ ∀ eff a

test/Test/Main.purs

@@ -2,14 +2,15 @@ module Test.Main where
 
 import Prelude
 import Control.Alt ((<|>))
-import Control.Monad.Aff (Aff, Canceler(..), ASYNC, nonCanceler, runAff, launchAff, makeAff, try, bracket, delay, forkAff, joinThread, killThread)
-import Control.Monad.Eff (Eff)
+import Control.Monad.Aff (Aff, Canceler(..), nonCanceler, runAff, launchAff, makeAff, try, bracket, delay, forkAff, joinThread, killThread)
+import Control.Monad.Eff (Eff, runPure)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
 import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Eff.Console as Console
 import Control.Monad.Eff.Exception (Error, EXCEPTION, throwException, error, message)
 import Control.Monad.Eff.Ref (REF, Ref)
 import Control.Monad.Eff.Ref as Ref
+import Control.Monad.Eff.Ref.Unsafe (unsafeRunRef)
 import Control.Monad.Error.Class (throwError)
 import Control.Parallel (parallel, sequential)
 import Data.Bifunctor (lmap)
@@ -21,7 +22,7 @@ import Data.Time.Duration (Milliseconds(..))
 import Test.Assert (assert', ASSERT)
 
 type TestEffects eff = (assert ∷ ASSERT, console ∷ CONSOLE, ref ∷ REF, exception ∷ EXCEPTION | eff)
-type TestEff eff = Eff (TestEffects (async ∷ ASYNC | eff))
+type TestEff eff = Eff (TestEffects eff)
 type TestAff eff = Aff (TestEffects eff)
 
 newRef ∷ ∀ m eff a. MonadEff (ref ∷ REF | eff) m ⇒ a → m (Ref a)
@@ -346,6 +347,23 @@ test_kill_parallel_alt = assert "kill/parallel/alt" do
   _ ← try $ joinThread t2
   eq "killedfookilledbardone" <$> readRef ref
 
+test_mapThread ∷ ∀ eff. TestAff eff Unit
+test_mapThread = assert "mapThread" do
+  ref ← newRef 0
+  let
+    mapFn a = runPure do
+      unsafeRunRef $ Ref.modifyRef ref (_ + 1)
+      pure (a + 1)
+  t1 ← forkAff do
+    delay (Milliseconds 10.0)
+    pure 10
+  let
+    t2 = mapFn <$> t1
+  a ← joinThread t2
+  b ← joinThread t2
+  n ← readRef ref
+  pure (a == 11 && b == 11 && n == 1)
+
 main ∷ TestEff () Unit
 main = do
   test_pure
@@ -372,3 +390,4 @@ main = do
     test_kill_parallel
     test_parallel_alt
     test_kill_parallel_alt
+    test_mapThread