Add peekVar for reading from an avar without consuming (#68)

Author: garyb

src/Control/Monad/Aff/AVar.purs

@@ -5,6 +5,7 @@ module Control.Monad.Aff.AVar
   , makeVar
   , makeVar'
   , takeVar
+  , peekVar
   , putVar
   , modifyVar
   , killVar
@@ -15,7 +16,7 @@ import Prelude
 
 import Control.Monad.Aff (Aff, nonCanceler)
 import Control.Monad.Aff.Internal (AVar) as Exports
-import Control.Monad.Aff.Internal (AVBox, AVar, _killVar, _putVar, _takeVar, _makeVar)
+import Control.Monad.Aff.Internal (AVBox, AVar, _killVar, _putVar, _takeVar, _peekVar, _makeVar)
 import Control.Monad.Eff.Exception (Error())
 
 import Data.Function.Uncurried (runFn3, runFn2)
@@ -41,6 +42,10 @@ makeVar' a = do
 takeVar :: forall e a. AVar a -> AffAVar e a
 takeVar q = fromAVBox $ runFn2 _takeVar nonCanceler q
 
+-- | Reads a value from the asynchronous var but does not consume it.
+peekVar :: forall e a. AVar a -> AffAVar e a
+peekVar q = fromAVBox $ runFn2 _peekVar nonCanceler q
+
 -- | Puts a new value into the asynchronous avar. If the avar has
 -- | been killed, this will result in an error.
 putVar :: forall e a. AVar a -> a -> AffAVar e Unit

src/Control/Monad/Aff/Internal.js

@@ -33,6 +33,20 @@ exports._takeVar = function (nonCanceler, avar) {
   };
 };
 
+exports._peekVar = function (nonCanceler, avar) {
+  return function(success, error) {
+    if (avar.error !== undefined) {
+      error(avar.error);
+    } else if (avar.producers.length > 0) {
+      var producer = avar.producers[0];
+      producer(success, error);
+    } else {
+      avar.consumers.push({peek: true, success: success, error: error});
+    }
+    return nonCanceler;
+  };
+};
+
 exports._putVar = function (nonCanceler, avar, a) {
   return function(success, error) {
     if (avar.error !== undefined) {
@@ -48,15 +62,17 @@ exports._putVar = function (nonCanceler, avar, a) {
 
       success({});
     } else {
-      var consumer = avar.consumers.shift();
 
-      try {
-        consumer.success(a);
-      } catch (err) {
-        error(err);
-
-        return;
-      }
+      var consumer;
+      do {
+        consumer = avar.consumers.shift();
+        try {
+          consumer.success(a);
+        } catch (err) {
+          error(err);
+          return;
+        }
+      } while (consumer.peek === true);
 
       success({});
     }

src/Control/Monad/Aff/Internal.purs

@@ -3,6 +3,7 @@ module Control.Monad.Aff.Internal
   , AVar
   , _makeVar
   , _takeVar
+  , _peekVar
   , _putVar
   , _killVar
   ) where
@@ -21,6 +22,8 @@ foreign import _makeVar :: forall c a. c -> AVBox (AVar a)
 
 foreign import _takeVar :: forall c a. Fn2 c (AVar a) (AVBox a)
 
+foreign import _peekVar :: forall c a. Fn2 c (AVar a) (AVBox a)
+
 foreign import _putVar :: forall c a. Fn3 c (AVar a) a (AVBox Unit)
 
 foreign import _killVar :: forall c a. Fn3 c (AVar a) Error (AVBox Unit)

test/Test/Main.purs

@@ -6,7 +6,7 @@ import Control.Alt ((<|>))
 import Control.Apply ((*>))
 import Control.Parallel.Class (parallel, runParallel)
 import Control.Monad.Aff (Aff, runAff, makeAff, launchAff, later, later', forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize)
-import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, killVar)
+import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, peekVar, killVar)
 import Control.Monad.Aff.Console (CONSOLE, log)
 import Control.Monad.Cont.Class (callCC)
 import Control.Monad.Eff (Eff)
@@ -69,6 +69,23 @@ test_putTakeVar = do
   a <- takeVar v
   log ("Success: Value " <> show a)
 
+test_peekVar :: TestAVar Unit
+test_peekVar = do
+  v <- makeVar
+  forkAff (later $ putVar v 1.0)
+  a1 <- peekVar v
+  a2 <- takeVar v
+  when (a1 /= a2) do
+    throwError (error "Something horrible went wrong - peeked var is not equal to taken var")
+  log ("Success: Peeked value not consumed")
+
+  w <- makeVar
+  putVar w true
+  b <- peekVar w
+  when (not b) do
+    throwError (error "Something horrible went wrong - peeked var is not true")
+  log ("Success: Peeked value read from written var")
+
 test_killFirstForked :: Test Unit
 test_killFirstForked = do
   c <- forkAff (later' 100 $ pure "Failure: This should have been killed!")
@@ -237,6 +254,9 @@ main = do
     log "Testing AVar - putVar, takeVar"
     test_putTakeVar
 
+    log "Testing AVar - peekVar"
+    test_peekVar
+
     log "Testing AVar killVar"
     test_killVar