diff --git a/bower.json b/bower.json index 3fe49c2..a6299d3 100644 --- a/bower.json +++ b/bower.json @@ -17,14 +17,15 @@ "package.json" ], "dependencies": { - "purescript-console": "^2.0.0", - "purescript-exceptions": "^2.0.0", - "purescript-functions": "^2.0.0", - "purescript-parallel": "^2.0.0", - "purescript-transformers": "^2.0.1", - "purescript-unsafe-coerce": "^2.0.0" + "purescript-console": "^3.0.0", + "purescript-exceptions": "^3.0.0", + "purescript-functions": "^3.0.0", + "purescript-parallel": "^3.0.0", + "purescript-transformers": "^3.0.0", + "purescript-unsafe-coerce": "^3.0.0", + "purescript-datetime": "^3.0.0" }, "devDependencies": { - "purescript-partial": "^1.1.2" + "purescript-partial": "^1.2.0" } } diff --git a/package.json b/package.json index c711c63..c4fe1e6 100644 --- a/package.json +++ b/package.json @@ -8,9 +8,9 @@ "devDependencies": { "jscs": "^3.0.7", "jshint": "^2.9.4", - "pulp": "^10.0.0", - "purescript-psa": "^0.4.0", - "purescript": "^0.10.1", + "pulp": "^11.0.0", + "purescript-psa": "^0.5.0", + "purescript": "^0.11.0", "rimraf": "^2.5.4" } } diff --git a/src/Control/Monad/Aff.js b/src/Control/Monad/Aff.js index eb061d2..9e7d22f 100644 --- a/src/Control/Monad/Aff.js +++ b/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; }; }; }; diff --git a/src/Control/Monad/Aff.purs b/src/Control/Monad/Aff.purs index 52a1041..dfc6739 100644 --- a/src/Control/Monad/Aff.purs +++ b/src/Control/Monad/Aff.purs @@ -9,8 +9,7 @@ module Control.Monad.Aff , finally , forkAff , forkAll - , later - , later' + , delay , launchAff , liftEff' , makeAff @@ -25,10 +24,10 @@ import Prelude import Control.Alt (class Alt) import Control.Alternative (class Alternative) import Control.Monad.Aff.Internal (AVBox, AVar, _killVar, _putVar, _takeVar, _makeVar) -import Control.Monad.Eff (Eff) +import Control.Monad.Eff (Eff, kind Effect) import Control.Monad.Eff.Class (class MonadEff) import Control.Monad.Eff.Exception (Error, EXCEPTION, throwException, error) -import Control.Monad.Error.Class (class MonadError, throwError) +import Control.Monad.Error.Class (class MonadThrow, class MonadError, throwError) import Control.Monad.Rec.Class (class MonadRec, Step(..)) import Control.MonadPlus (class MonadZero, class MonadPlus) import Control.Parallel (class Parallel) @@ -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 Data.Tuple (Tuple(..), fst, snd) import Unsafe.Coerce (unsafeCoerce) @@ -47,7 +47,7 @@ import Unsafe.Coerce (unsafeCoerce) -- | errors or produces a value of type `a`. -- | -- | This is moral equivalent of `ErrorT (ContT Unit (Eff e)) a`. -foreign import data Aff :: # ! -> * -> * +foreign import data Aff :: # Effect -> Type -> Type -- | A pure asynchronous computation, having no effects other than -- | asynchronous computation. @@ -80,12 +80,12 @@ cancelWith aff c = runFn3 _cancelWith nonCanceler aff c -- | If you do need to handle exceptions, you can use `runAff` instead, or -- | you can handle the exception within the Aff computation, using -- | `catchError` (or any of the other mechanisms). -launchAff :: forall e a. Aff e a -> Eff (err :: EXCEPTION | e) (Canceler e) +launchAff :: forall e a. Aff e a -> Eff (exception :: EXCEPTION | e) (Canceler e) launchAff = lowerEx <<< runAff throwException (const (pure unit)) <<< liftEx where - liftEx :: Aff e a -> Aff (err :: EXCEPTION | e) a + liftEx :: Aff e a -> Aff (exception :: EXCEPTION | e) a liftEx = _unsafeInterleaveAff - lowerEx :: Eff (err :: EXCEPTION | e) (Canceler (err :: EXCEPTION | e)) -> Eff (err :: EXCEPTION | e) (Canceler e) + lowerEx :: Eff (exception :: EXCEPTION | e) (Canceler (exception :: EXCEPTION | e)) -> Eff (exception :: EXCEPTION | e) (Canceler e) lowerEx = map (Canceler <<< map _unsafeInterleaveAff <<< cancel) -- | Runs the asynchronous computation. You must supply an error callback and a @@ -108,14 +108,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 @@ -149,7 +144,7 @@ apathize :: forall e a. Aff e a -> Aff e Unit apathize a = const unit <$> attempt a -- | Lifts a synchronous computation and makes explicit any failure from exceptions. -liftEff' :: forall e a. Eff (err :: EXCEPTION | e) a -> Aff e (Either Error a) +liftEff' :: forall e a. Eff (exception :: EXCEPTION | e) a -> Aff e (Either Error a) liftEff' eff = attempt (_unsafeInterleaveAff (runFn2 _liftEff nonCanceler eff)) -- | A constant canceller that always returns false. @@ -183,11 +178,14 @@ instance monadAff :: Monad (Aff e) instance monadEffAff :: MonadEff e (Aff e) where liftEff eff = runFn2 _liftEff nonCanceler eff --- | Allows users to catch and throw errors on the error channel of the +-- | Allows users to throw errors on the error channel of the -- | asynchronous computation. See documentation in `purescript-transformers`. -instance monadErrorAff :: MonadError Error (Aff e) where +instance monadThrowAff :: MonadThrow Error (Aff e) where throwError e = runFn2 _throwError nonCanceler e +-- | Allows users to catch errors on the error channel of the +-- | asynchronous computation. See documentation in `purescript-transformers`. +instance monadErrorAff :: MonadError Error (Aff e) where catchError aff ex = attempt aff >>= either ex pure instance altAff :: Alt (Aff e) where @@ -289,7 +287,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 diff --git a/src/Control/Monad/Aff/AVar.purs b/src/Control/Monad/Aff/AVar.purs index 8b6970e..3e05f7a 100644 --- a/src/Control/Monad/Aff/AVar.purs +++ b/src/Control/Monad/Aff/AVar.purs @@ -17,13 +17,14 @@ 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.Eff (kind Effect) import Control.Monad.Eff.Exception (Error()) import Data.Function.Uncurried (runFn3, runFn2) import Unsafe.Coerce (unsafeCoerce) -foreign import data AVAR :: ! +foreign import data AVAR :: Effect type AffAVar e a = Aff (avar :: AVAR | e) a diff --git a/src/Control/Monad/Aff/Internal.purs b/src/Control/Monad/Aff/Internal.purs index 5f4e0fc..52f95cf 100644 --- a/src/Control/Monad/Aff/Internal.purs +++ b/src/Control/Monad/Aff/Internal.purs @@ -14,9 +14,9 @@ import Control.Monad.Eff.Exception (Error) import Data.Function.Uncurried (Fn2, Fn3) -foreign import data AVar :: * -> * +foreign import data AVar :: Type -> Type -foreign import data AVBox :: * -> * +foreign import data AVBox :: Type -> Type foreign import _makeVar :: forall c a. c -> AVBox (AVar a) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 3f86d87..077fa33 100644 --- a/test/Test/Main.purs +++ b/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,22 +77,22 @@ 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 @@ -98,10 +100,10 @@ test_peekVar = 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 + _ <- forkAff do c <- peekVar x putVar x 1000 d <- peekVar x @@ -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, err :: 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") @@ -206,9 +210,10 @@ test_cancelRaceLeft :: TestAVar Unit test_cancelRaceLeft = do var <- makeVar c <- sequential - $ parallel (later' 250 $ putVar var true) - <|> parallel (later' 100 $ pure unit) - later' 500 $ putVar var false + $ parallel (delay (Milliseconds 250.0) *> putVar var true) + <|> parallel (delay (Milliseconds 100.0)) + delay (Milliseconds 500.0) + putVar var false l <- takeVar var when l $ throwError (error "Failure: left side ran even though it lost the race") @@ -216,9 +221,10 @@ test_cancelRaceRight :: TestAVar Unit test_cancelRaceRight = do var <- makeVar c <- sequential - $ parallel (later' 100 $ pure unit) - <|> parallel (later' 250 $ putVar var true) - later' 500 $ putVar var false + $ parallel (delay (Milliseconds 100.0)) + <|> parallel (delay (Milliseconds 250.0) *> putVar var true) + delay (Milliseconds 500.0) + putVar var false l <- takeVar var when l $ throwError (error "Failure: right side ran even though it lost the race") @@ -242,33 +248,30 @@ 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)) all :: forall eff. Int -> Aff (console :: CONSOLE, avar :: AVAR | eff) Unit all n = do var <- makeVar' 0 - forkAll $ replicateArray n (modifyVar (_ + 1) var) + _ <- forkAll $ replicateArray n (modifyVar (_ + 1) var) count <- takeVar var log ("Forked " <> show count) 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, err :: EXCEPTION) 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" @@ -283,11 +286,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 @@ -335,7 +339,7 @@ main = do test_syncTailRecM log "pre-delay" - delay 1000 + delay (Milliseconds 1000.0) log "post-delay" loopAndBounce 1000000