diff --git a/src/Control/Monad/Aff/AVar.purs b/src/Control/Monad/Aff/AVar.purs index 3e05f7a..c8f20c4 100644 --- a/src/Control/Monad/Aff/AVar.purs +++ b/src/Control/Monad/Aff/AVar.purs @@ -9,6 +9,8 @@ module Control.Monad.Aff.AVar , putVar , modifyVar , killVar + , tryTakeVar + , tryPeekVar , module Exports ) where @@ -16,11 +18,12 @@ 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, _peekVar, _makeVar) +import Control.Monad.Aff.Internal (AVBox, AVar, _killVar, _putVar, _takeVar, _peekVar, _makeVar, _tryTakeVar, _tryPeekVar) import Control.Monad.Eff (kind Effect) import Control.Monad.Eff.Exception (Error()) -import Data.Function.Uncurried (runFn3, runFn2) +import Data.Function.Uncurried (runFn4, runFn3, runFn2) +import Data.Maybe (Maybe(..)) import Unsafe.Coerce (unsafeCoerce) @@ -43,10 +46,20 @@ makeVar' a = do takeVar :: forall e a. AVar a -> AffAVar e a takeVar q = fromAVBox $ runFn2 _takeVar nonCanceler q +-- | A variant of `takeVar` which return immediately if the asynchronous avar +-- | was empty. Nothing if the avar empty and `Just a` if the avar have contents `a`. +tryTakeVar :: forall e a. AVar a -> AffAVar e (Maybe a) +tryTakeVar q = fromAVBox $ runFn4 _tryTakeVar Nothing Just 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 +-- | A variant of `peekVar` which return immediately when the asynchronous avar +-- | was empty. Nothing if the avar empty and `Just a` if the avar have contents `a`. +tryPeekVar :: forall e a. AVar a -> AffAVar e (Maybe a) +tryPeekVar q = fromAVBox $ runFn4 _tryPeekVar Nothing Just 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 diff --git a/src/Control/Monad/Aff/Internal.js b/src/Control/Monad/Aff/Internal.js index f1e8a89..49bf6bf 100644 --- a/src/Control/Monad/Aff/Internal.js +++ b/src/Control/Monad/Aff/Internal.js @@ -25,6 +25,21 @@ exports._takeVar = function (nonCanceler, avar) { }; }; +exports._tryTakeVar = function (nothing, just, nonCanceler, avar) { + return function (success, error) { + if (avar.error !== undefined) { + error(avar.error); + } else if (avar.producers.length > 0) { + avar.producers.shift()(function (x) { + return success(just(x)); + }, error); + } else { + success(nothing); + } + return nonCanceler; + }; +}; + exports._peekVar = function (nonCanceler, avar) { return function (success, error) { if (avar.error !== undefined) { @@ -38,6 +53,21 @@ exports._peekVar = function (nonCanceler, avar) { }; }; +exports._tryPeekVar = function (nothing, just, nonCanceler, avar) { + return function (success, error) { + if (avar.error !== undefined) { + error(avar.error); + } else if (avar.producers.length > 0) { + avar.producers[0](function (x) { + return success(just(x)); + }, error); + } else { + success(nothing); + } + return nonCanceler; + }; +}; + exports._putVar = function (nonCanceler, avar, a) { return function (success, error) { if (avar.error !== undefined) { diff --git a/src/Control/Monad/Aff/Internal.purs b/src/Control/Monad/Aff/Internal.purs index 52f95cf..0ff681d 100644 --- a/src/Control/Monad/Aff/Internal.purs +++ b/src/Control/Monad/Aff/Internal.purs @@ -3,7 +3,9 @@ module Control.Monad.Aff.Internal , AVar , _makeVar , _takeVar + , _tryTakeVar , _peekVar + , _tryPeekVar , _putVar , _killVar ) where @@ -12,7 +14,8 @@ import Prelude import Control.Monad.Eff.Exception (Error) -import Data.Function.Uncurried (Fn2, Fn3) +import Data.Maybe (Maybe) +import Data.Function.Uncurried (Fn2, Fn3, Fn4) foreign import data AVar :: Type -> Type @@ -22,8 +25,12 @@ foreign import _makeVar :: forall c a. c -> AVBox (AVar a) foreign import _takeVar :: forall c a. Fn2 c (AVar a) (AVBox a) +foreign import _tryTakeVar :: forall c a. Fn4 (forall x. Maybe x) (forall x. x -> Maybe x) c (AVar a) (AVBox (Maybe a)) + foreign import _peekVar :: forall c a. Fn2 c (AVar a) (AVBox a) +foreign import _tryPeekVar :: forall c a. Fn4 (forall x. Maybe x) (forall x. x -> Maybe x) c (AVar a) (AVBox (Maybe 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) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 077fa33..a25b24e 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -4,7 +4,7 @@ import Prelude import Control.Alt ((<|>)) import Control.Monad.Aff (Aff, runAff, makeAff, launchAff, delay, forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize) -import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, peekVar, killVar) +import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, peekVar, killVar, tryTakeVar, tryPeekVar) import Control.Monad.Aff.Console (CONSOLE, log) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log) as Eff @@ -129,6 +129,42 @@ test_killVar = do e <- attempt $ takeVar v either (const $ log "Success: Killed queue dead") (const $ log "Failure: Oh noes, queue survived!") e +test_tryTakeVar :: TestAVar Unit +test_tryTakeVar = do + timeout (Milliseconds 1000.0) do + v <- makeVar + x <- tryTakeVar v + case x of + Nothing -> log $ "Success: trying take an empty var" + Just _ -> throwError $ error $ "Failure: Oh noes, take an empty var should return Nothing" + + timeout (Milliseconds 1000.0) do + v <- makeVar + b <- tryTakeVar v + putVar v 1.0 + a <- tryTakeVar v + when (a /= Just 1.0 || a == b) do + throwError $ error ("Failure: Oh noes, tryTakeVar should take var if it available, value: " <> show a) + log $ "Success: value taken by tryTakeVar " <> show a + +test_tryPeekVar :: TestAVar Unit +test_tryPeekVar = do + timeout (Milliseconds 1000.0) do + v <- makeVar + x <- tryPeekVar v + case x of + Nothing -> log $ "Success: try peek var return immediately" + Just _ -> throwError $ error $ "Failure: tryPeekVar return Just when peek an empty var" + + timeout (Milliseconds 1000.0) do + v <- makeVar + putVar v 100.0 + a <- tryPeekVar v + b <- takeVar v + when (a /= Just b) do + throwError (error "Something horrible went wrong - peeked var is not equal to taken var") + log ("Success: Try Peeked value not consumed") + test_finally :: TestAVar Unit test_finally = do v <- makeVar @@ -311,6 +347,12 @@ main = do log "Testing AVar killVar" test_killVar + log "Testing AVar - tryTakeVar" + test_tryTakeVar + + log "Testing AVar - tryPeekVar" + test_tryPeekVar + log "Testing finally" test_finally