Skip to content

Commit 536493d

Browse files
sardonicpresencesardonicpresence
committed
Return Canceler from runAff/launchAff
1 parent e289d31 commit 536493d

File tree

2 files changed

+64
-50
lines changed

2 files changed

+64
-50
lines changed

‎src/Control/Monad/Aff.purs

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -73,12 +73,15 @@ cancelWith aff c = runFn3 _cancelWith nonCanceler aff c
7373
-- | If you do need to handle exceptions, you can use `runAff` instead, or
7474
-- | you can handle the exception within the Aff computation, using
7575
-- | `catchError` (or any of the other mechanisms).
76-
launchAff :: forall e a. Aff (err :: EXCEPTION | e) a -> Eff (err :: EXCEPTION | e) Unit
77-
launchAff = runAff_ throwException (const (pure unit))
76+
launchAff :: forall e a. Aff (err :: EXCEPTION | e) a -> Eff (err :: EXCEPTION | e) (Canceler (err :: EXCEPTION | e))
77+
launchAff = runAff throwException (const (pure unit))
7878

7979
-- | Runs the asynchronous computation. You must supply an error callback and a
8080
-- | success callback.
81-
runAff :: forall e a. (Error -> Eff e Unit) -> (a -> Eff e Unit) -> Aff e a -> Eff e Unit
81+
-- |
82+
-- | Returns a canceler that can be used to attempt cancellation of the
83+
-- | asynchronous computation.
84+
runAff :: forall e a. (Error -> Eff e Unit) -> (a -> Eff e Unit) -> Aff e a -> Eff e (Canceler e)
8285
runAff ex f aff = runFn3 _runAff ex f aff
8386

8487
-- | Creates an asynchronous effect from a function that accepts error and
@@ -191,7 +194,7 @@ instance monadRecAff :: MonadRec (Aff e) where
191194
tailRecM f a = runFn3 _tailRecM isLeft f a
192195

193196
instance monadContAff :: MonadCont (Aff e) where
194-
callCC f = makeAff (\eb cb -> runAff eb cb (f \a -> makeAff (\_ _ -> cb a)))
197+
callCC f = makeAff (\eb cb -> void $ runAff eb cb (f \a -> makeAff (\_ _ -> cb a)))
195198

196199
instance semigroupCanceler :: Semigroup (Canceler e) where
197200
append (Canceler f1) (Canceler f2) = Canceler (\e -> (||) <$> f1 e <*> f2 e)
@@ -221,7 +224,7 @@ foreign import _bind :: forall e a b. Fn3 (Canceler e) (Aff e a) (a -> Aff e b)
221224

222225
foreign import _attempt :: forall e a. Fn3 (forall x y. x -> Either x y) (forall x y. y -> Either x y) (Aff e a) (Aff e (Either Error a))
223226

224-
foreign import _runAff :: forall e a. Fn3 (Error -> Eff e Unit) (a -> Eff e Unit) (Aff e a) (Eff e Unit)
227+
foreign import _runAff :: forall e a. Fn3 (Error -> Eff e Unit) (a -> Eff e Unit) (Aff e a) (Eff e (Canceler e))
225228

226229
foreign import _liftEff :: forall e a. Fn2 (Canceler e) (Eff e a) (Aff e a)
227230

‎test/Test/Main.purs

Lines changed: 56 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,14 @@ import Prelude
44

55
import Control.Alt ((<|>))
66
import Control.Apply ((*>))
7-
import Control.Monad.Aff (Aff, runAff, makeAff, later, later', forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize)
7+
import Control.Monad.Aff (Aff, runAff, makeAff, launchAff, later, later', forkAff, forkAll, Canceler(..), cancel, attempt, finally, apathize)
88
import Control.Monad.Aff.AVar (AVAR, makeVar, makeVar', putVar, modifyVar, takeVar, killVar)
99
import Control.Monad.Aff.Console (log)
1010
import Control.Monad.Aff.Par (Par(..), runPar)
1111
import Control.Monad.Cont.Class (callCC)
1212
import Control.Monad.Eff (Eff)
1313
import Control.Monad.Eff.Console (CONSOLE)
14+
import Control.Monad.Eff.Console (log) as Eff
1415
import Control.Monad.Eff.Exception (EXCEPTION, throwException, error, message)
1516
import Control.Monad.Error.Class (throwError)
1617
import Control.Monad.Rec.Class (tailRecM)
@@ -137,6 +138,12 @@ test_cancelLater = do
137138
v <- cancel c (error "Cause")
138139
log (if v then "Success: Canceled later" else "Failure: Did not cancel later")
139140

141+
test_cancelRunLater :: forall e. Eff (console :: CONSOLE, err :: EXCEPTION | e) Unit
142+
test_cancelRunLater = do
143+
c <- runAff throwException (const (pure unit)) $ later' 100 $ log ("Failure: Later was not canceled!")
144+
void $ launchAff $ (do v <- cancel c (error "Cause")
145+
log (if v then "Success: Canceled later" else "Failure: Did not cancel later"))
146+
140147
test_cancelPar :: TestAVar Unit
141148
test_cancelPar = do
142149
c <- forkAff <<< runPar $ Par (later' 100 $ log "Failure: #1 should not get through") <|>
@@ -187,69 +194,73 @@ delay n = callCC \cont ->
187194
later' n (cont unit)
188195

189196
main :: Eff (console :: CONSOLE, avar :: AVAR, err :: EXCEPTION) Unit
190-
main = runAff throwException (const (pure unit)) $ do
191-
log "Testing sequencing"
192-
test_sequencing 3
197+
main = do
198+
Eff.log "Testing kill of later in separate Aff"
199+
test_cancelRunLater
200+
201+
void $ runAff throwException (const (pure unit)) $ do
202+
log "Testing sequencing"
203+
test_sequencing 3
193204

194-
log "Testing pure"
195-
test_pure
205+
log "Testing pure"
206+
test_pure
196207

197-
log "Testing makeAff"
198-
test_makeAff
208+
log "Testing makeAff"
209+
test_makeAff
199210

200-
log "Testing attempt"
201-
test_attempt
211+
log "Testing attempt"
212+
test_attempt
202213

203-
log "Testing later"
204-
later $ log "Success: It happened later"
214+
log "Testing later"
215+
later $ log "Success: It happened later"
205216

206-
log "Testing kill of later"
207-
test_cancelLater
217+
log "Testing kill of later"
218+
test_cancelLater
208219

209-
log "Testing kill of first forked"
210-
test_killFirstForked
220+
log "Testing kill of first forked"
221+
test_killFirstForked
211222

212-
log "Testing apathize"
213-
test_apathize
223+
log "Testing apathize"
224+
test_apathize
214225

215-
log "Testing semigroup canceler"
216-
test_semigroupCanceler
226+
log "Testing semigroup canceler"
227+
test_semigroupCanceler
217228

218-
log "Testing AVar - putVar, takeVar"
219-
test_putTakeVar
229+
log "Testing AVar - putVar, takeVar"
230+
test_putTakeVar
220231

221-
log "Testing AVar killVar"
222-
test_killVar
232+
log "Testing AVar killVar"
233+
test_killVar
223234

224-
log "Testing finally"
225-
test_finally
235+
log "Testing finally"
236+
test_finally
226237

227-
log "Test Par (*>)"
228-
test_parError
238+
log "Test Par (*>)"
239+
test_parError
229240

230-
log "Testing Par (<|>)"
231-
test_parRace
241+
log "Testing Par (<|>)"
242+
test_parRace
232243

233-
log "Testing Par (<|>) - kill one"
234-
test_parRaceKill1
244+
log "Testing Par (<|>) - kill one"
245+
test_parRaceKill1
235246

236-
log "Testing Par (<|>) - kill two"
237-
test_parRaceKill2
247+
log "Testing Par (<|>) - kill two"
248+
test_parRaceKill2
238249

239-
log "Testing cancel of Par (<|>)"
240-
test_cancelPar
250+
log "Testing cancel of Par (<|>)"
251+
test_cancelPar
241252

242-
log "Testing synchronous tailRecM"
243-
test_syncTailRecM
253+
log "Testing synchronous tailRecM"
254+
test_syncTailRecM
244255

245-
log "pre-delay"
246-
delay 1000
247-
log "post-delay"
256+
log "pre-delay"
257+
delay 1000
258+
log "post-delay"
248259

249-
loopAndBounce 1000000
260+
loopAndBounce 1000000
250261

251-
all 100000
262+
all 100000
252263

253-
cancelAll 100000
264+
cancelAll 100000
254265

255-
log "Done testing"
266+
log "Done testing"

0 commit comments

Comments
 (0)