Replace later with delay

Author: natefaubion

bower.json

@@ -22,7 +22,8 @@
     "purescript-functions": "^3.0.0",
     "purescript-parallel": "^3.0.0",
     "purescript-transformers": "^3.0.0",
-    "purescript-unsafe-coerce": "^3.0.0"
+    "purescript-unsafe-coerce": "^3.0.0",
+    "purescript-datetime": "^3.0.0"
   },
   "devDependencies": {
     "purescript-partial": "^1.2.0"

src/Control/Monad/Aff.js

@@ -36,29 +36,29 @@ exports._cancelWith = function (nonCanceler, aff, canceler1) {
   };
 };
 
-exports._setTimeout = function (nonCanceler, millis, aff) {
+exports._delay = function (nonCanceler, millis) {
   var set = setTimeout;
   var clear = clearTimeout;
   if (millis <= 0 && typeof setImmediate === "function") {
     set = setImmediate;
     clear = clearImmediate;
   }
-  return function (success, error) {
-    var canceler;
-
-    var timeout = set(function () {
-      canceler = aff(success, error);
+  return function (success) {
+    var timedOut = false;
+    var timer = set(function () {
+      timedOut = true;
+      success();
     }, millis);
 
-    return function (e) {
-      return function (s, f) {
-        if (canceler !== undefined) {
-          return canceler(e)(s, f);
+    return function () {
+      return function (s) {
+        if (timedOut) {
+          s(false);
         } else {
-          clear(timeout);
+          clear(timer);
           s(true);
-          return nonCanceler;
         }
+        return nonCanceler;
       };
     };
   };

src/Control/Monad/Aff.purs

@@ -9,8 +9,7 @@ module Control.Monad.Aff
   , finally
   , forkAff
   , forkAll
-  , later
-  , later'
+  , delay
   , launchAff
   , liftEff'
   , makeAff
@@ -39,6 +38,7 @@ import Data.Foldable (class Foldable, foldl)
 import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3)
 import Data.Monoid (class Monoid, mempty)
 import Data.Newtype (class Newtype)
+import Data.Time.Duration (Milliseconds(..))
 
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -107,14 +107,9 @@ makeAff h = makeAff' (\e a -> const nonCanceler <$> h e a)
 makeAff' :: forall e a. ((Error -> Eff e Unit) -> (a -> Eff e Unit) -> Eff e (Canceler e)) -> Aff e a
 makeAff' h = _makeAff h
 
--- | Runs the asynchronous computation off the current execution context.
-later :: forall e a. Aff e a -> Aff e a
-later = later' 0
-
--- | Runs the specified asynchronous computation later, by the specified
--- | number of milliseconds.
-later' :: forall e a. Int -> Aff e a -> Aff e a
-later' n aff = runFn3 _setTimeout nonCanceler n aff
+-- | Pauses execuation of the current computation for the specified number of milliseconds.
+delay :: forall e. Milliseconds -> Aff e Unit
+delay (Milliseconds n) = runFn2 _delay nonCanceler n
 
 -- | Compute `aff1`, followed by `aff2` regardless of whether `aff1` terminated successfully.
 finally :: forall e a b. Aff e a -> Aff e b -> Aff e a
@@ -284,7 +279,7 @@ fromAVBox = unsafeCoerce
 
 foreign import _cancelWith :: forall e a. Fn3 (Canceler e) (Aff e a) (Canceler e) (Aff e a)
 
-foreign import _setTimeout :: forall e a. Fn3 (Canceler e) Int (Aff e a) (Aff e a)
+foreign import _delay :: forall e a. Fn2 (Canceler e) Number (Aff e a)
 
 foreign import _unsafeInterleaveAff :: forall e1 e2 a. Aff e1 a -> Aff e2 a
 

test/Test/Main.purs

@@ -3,7 +3,7 @@ module Test.Main where
 import Prelude
 
 import Control.Alt ((<|>))
-import Control.Monad.Aff (Aff, runAff, makeAff, launchAff, later, later', forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize)
+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.Console (CONSOLE, log)
 import Control.Monad.Eff (Eff)
@@ -14,16 +14,17 @@ import Control.Monad.Rec.Class (Step(..), tailRecM)
 import Control.Parallel (parallel, sequential)
 import Data.Either (either, fromLeft, fromRight)
 import Data.Maybe (Maybe(..))
+import Data.Time.Duration (Milliseconds(..))
 import Data.Unfoldable (replicate)
 import Partial.Unsafe (unsafePartial)
 
 type Test a = forall e. Aff (console :: CONSOLE | e) a
 type TestAVar a = forall e. Aff (console :: CONSOLE, avar :: AVAR | e) a
 
-timeout :: Int → TestAVar Unit → TestAVar Unit
+timeout :: Milliseconds → TestAVar Unit → TestAVar Unit
 timeout ms aff = do
   exn <- makeVar
-  clr1 <- forkAff (later' ms (putVar exn (Just "Timed out")))
+  clr1 <- forkAff (delay ms *> putVar exn (Just "Timed out"))
   clr2 <- forkAff (aff *> putVar exn Nothing)
   res ← takeVar exn
   log (show res)
@@ -37,7 +38,8 @@ replicateArray = replicate
 test_sequencing :: Int -> Test Unit
 test_sequencing 0 = log "Done"
 test_sequencing n = do
-  later' 100 (log (show (n / 10) <> " seconds left"))
+  delay $ Milliseconds 100.0
+  log (show (n / 10) <> " seconds left")
   test_sequencing (n - 1)
 
 foreign import synchronousUnexpectedThrowError :: forall e. Eff e Unit
@@ -75,30 +77,30 @@ test_apathize = do
 test_putTakeVar :: TestAVar Unit
 test_putTakeVar = do
   v <- makeVar
-  _ <- forkAff (later $ putVar v 1.0)
+  _ <- forkAff (delay (Milliseconds 0.0) *> putVar v 1.0)
   a <- takeVar v
   log ("Success: Value " <> show a)
 
 test_peekVar :: TestAVar Unit
 test_peekVar = do
-  timeout 1000 do
+  timeout (Milliseconds 1000.0) do
     v <- makeVar
-    _ <- forkAff (later $ putVar v 1.0)
+    _ <- forkAff (delay (Milliseconds 0.0) *> 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")
 
-  timeout 1000 do
+  timeout (Milliseconds 1000.0) do
     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")
 
-  timeout 1000 do
+  timeout (Milliseconds 1000.0) do
     x <- makeVar
     res <- makeVar' 1
     _ <- forkAff do
@@ -116,7 +118,7 @@ test_peekVar = do
 
 test_killFirstForked :: Test Unit
 test_killFirstForked = do
-  c <- forkAff (later' 100 $ pure "Failure: This should have been killed!")
+  c <- forkAff (delay (Milliseconds 100.0) $> "Failure: This should have been killed!")
   b <- c `cancel` (error "Just die")
   log (if b then "Success: Killed first forked" else "Failure: Couldn't kill first forked")
 
@@ -144,8 +146,8 @@ test_finally = do
 
 test_parRace :: TestAVar Unit
 test_parRace = do
-  s <- sequential (parallel (later' 100 $ pure "Success: Early bird got the worm") <|>
-               parallel (later' 200 $ pure "Failure: Late bird got the worm"))
+  s <- sequential (parallel (delay (Milliseconds 100.0) $> "Success: Early bird got the worm") <|>
+               parallel (delay (Milliseconds 200.0) $> "Failure: Late bird got the worm"))
   log s
 
 test_parError :: TestAVar Unit
@@ -155,14 +157,14 @@ test_parError = do
 
 test_parRaceKill1 :: TestAVar Unit
 test_parRaceKill1 = do
-  s <- sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
-               parallel (later' 200 $ pure "Success: Early error was ignored in favor of late success"))
+  s <- sequential (parallel (delay (Milliseconds 100.0) *> throwError (error ("Oh noes!"))) <|>
+               parallel (delay (Milliseconds 200.0) $> "Success: Early error was ignored in favor of late success"))
   log s
 
 test_parRaceKill2 :: TestAVar Unit
 test_parRaceKill2 = do
-  e <- attempt $ sequential (parallel (later' 100 $ throwError (error ("Oh noes!"))) <|>
-                         parallel (later' 200 $ throwError (error ("Oh noes!"))))
+  e <- attempt $ sequential (parallel (delay (Milliseconds 100.0) *> throwError (error ("Oh noes!"))) <|>
+                         parallel (delay (Milliseconds 200.0) *> throwError (error ("Oh noes!"))))
   either (const $ log "Success: Killing both kills it dead") (const $ log "Failure: It's alive!!!") e
 
 test_semigroupCanceler :: Test Unit
@@ -174,30 +176,32 @@ test_semigroupCanceler =
     log (if v then "Success: Canceled semigroup composite canceler"
                      else "Failure: Could not cancel semigroup composite canceler")
 
-test_cancelLater :: TestAVar Unit
-test_cancelLater = do
-  c <- forkAff $ (do _ <- pure "Binding"
-                     _ <- later' 100 $ log ("Failure: Later was not canceled!")
-                     pure "Binding")
+test_cancelDelay :: TestAVar Unit
+test_cancelDelay = do
+  c <- forkAff do
+    _ <- pure "Binding"
+    delay (Milliseconds 100.0)
+    log $ "Failure: Delay was not canceled!"
+    pure "Binding"
   v <- cancel c (error "Cause")
-  log (if v then "Success: Canceled later" else "Failure: Did not cancel later")
+  log (if v then "Success: Canceled delay" else "Failure: Did not cancel delay")
 
-test_cancelLaunchLater :: forall e. Eff (console :: CONSOLE, exception :: EXCEPTION | e) Unit
-test_cancelLaunchLater = do
-  c <- launchAff $ later' 100 $ log ("Failure: Later was not canceled!")
+test_cancelLaunchDelay :: forall e. Eff (console :: CONSOLE, exception :: EXCEPTION | e) Unit
+test_cancelLaunchDelay = do
+  c <- launchAff $ delay (Milliseconds 100.0) *> log ("Failure: Delay was not canceled!")
   void $ launchAff $ (do v <- cancel c (error "Cause")
-                         log (if v then "Success: Canceled later" else "Failure: Did not cancel later"))
+                         log (if v then "Success: Canceled delay" else "Failure: Did not cancel delay"))
 
-test_cancelRunLater :: forall e. Eff (console :: CONSOLE | e) Unit
-test_cancelRunLater = do
-  c <- runAff (const (pure unit)) (const (pure unit)) $ later' 100 $ log ("Failure: Later was not canceled!")
+test_cancelRunDelay :: forall e. Eff (console :: CONSOLE | e) Unit
+test_cancelRunDelay = do
+  c <- runAff (const (pure unit)) (const (pure unit)) $ delay (Milliseconds 100.0) *> log ("Failure: Delay was not canceled!")
   void $ try $ launchAff $ (do v <- cancel c (error "Cause")
-                               log (if v then "Success: Canceled later" else "Failure: Did not cancel later"))
+                               log (if v then "Success: Canceled delay" else "Failure: Did not cancel delay"))
 
 test_cancelParallel :: TestAVar Unit
 test_cancelParallel = do
-  c  <- forkAff <<< sequential $ parallel (later' 100 $ log "Failure: #1 should not get through") <|>
-                             parallel (later' 100 $ log "Failure: #2 should not get through")
+  c  <- forkAff <<< sequential $ parallel (delay (Milliseconds 100.0) *> log "Failure: #1 should not get through") <|>
+                             parallel (delay (Milliseconds 100.0) *> log "Failure: #2 should not get through")
   v  <- c `cancel` (error "Must cancel")
   log (if v then "Success: Canceling composite of two Parallel succeeded"
                    else "Failure: Canceling composite of two Parallel failed")
@@ -222,7 +226,7 @@ loopAndBounce n = do
   where
   go 0 = pure (Done 0)
   go k | mod k 30000 == 0 = do
-    later' 10 (pure unit)
+    delay (Milliseconds 10.0)
     pure (Loop (k - 1))
   go k = pure (Loop (k - 1))
 
@@ -235,20 +239,17 @@ all n = do
 
 cancelAll :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit
 cancelAll n = do
-  canceler <- forkAll $ replicateArray n (later' 100000 (log "oops"))
+  canceler <- forkAll $ replicateArray n (delay (Milliseconds 100000.0) *> log "oops")
   canceled <- cancel canceler (error "bye")
   log ("Cancelled all: " <> show canceled)
 
-delay :: forall eff. Int -> Aff eff Unit
-delay n = later' n (pure unit)
-
 main :: Eff (console :: CONSOLE, avar :: AVAR, exception :: EXCEPTION) Unit
 main = do
-  Eff.log "Testing kill of later launched in separate Aff"
-  test_cancelLaunchLater
+  Eff.log "Testing kill of delay launched in separate Aff"
+  test_cancelLaunchDelay
 
-  Eff.log "Testing kill of later run in separate Aff"
-  test_cancelRunLater
+  Eff.log "Testing kill of delay run in separate Aff"
+  test_cancelRunDelay
 
   void $ runAff throwException (const (pure unit)) $ do
     log "Testing sequencing"
@@ -263,11 +264,12 @@ main = do
     log "Testing attempt"
     test_attempt
 
-    log "Testing later"
-    later $ log "Success: It happened later"
+    log "Testing delay"
+    delay (Milliseconds 0.0)
+    log "Success: It happened later"
 
-    log "Testing kill of later"
-    test_cancelLater
+    log "Testing kill of delay"
+    test_cancelDelay
 
     log "Testing kill of first forked"
     test_killFirstForked
@@ -309,7 +311,7 @@ main = do
     test_syncTailRecM
 
     log "pre-delay"
-    delay 1000
+    delay (Milliseconds 1000.0)
     log "post-delay"
 
     loopAndBounce 1000000