Skip to content

Commit

Permalink
Killing a suspended thread should be sync because laws (#121)
Browse files Browse the repository at this point in the history
  • Loading branch information
natefaubion committed Sep 12, 2017
1 parent 2bd3ab9 commit 91853ea
Show file tree
Hide file tree
Showing 3 changed files with 17 additions and 10 deletions.
3 changes: 3 additions & 0 deletions src/Control/Monad/Aff.js
Original file line number Diff line number Diff line change
Expand Up @@ -608,6 +608,9 @@ var Aff = function () {
kill: kill,
join: join,
onComplete: onComplete,
isSuspended: function () {
return status === SUSPENDED;
},
run: function () {
if (status === SUSPENDED) {
if (!Scheduler.isDraining()) {
Expand Down
12 changes: 10 additions & 2 deletions src/Control/Monad/Aff.purs
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ module Control.Monad.Aff
, BracketConditions
, generalBracket
, nonCanceler
, effCanceler
, module Exports
) where

Expand Down Expand Up @@ -154,6 +155,7 @@ newtype Fiber eff a = Fiber
, kill Fn.Fn2 Error (Either Error Unit Eff eff Unit) (Eff eff (Eff eff Unit))
, join (Either Error a Eff eff Unit) Eff eff (Eff eff Unit)
, onComplete OnComplete eff a Eff eff (Eff eff Unit)
, isSuspended Eff eff Boolean
}

instance functorFiberFunctor (Fiber eff) where
Expand All @@ -168,12 +170,14 @@ instance applicativeFiber ∷ Applicative (Fiber eff) where
-- | Invokes pending cancelers in a fiber and runs cleanup effects. Blocks
-- | until the fiber has fully exited.
killFiber eff a. Error Fiber eff a Aff eff Unit
killFiber e (Fiber t) = makeAff \k → Canceler <<< const <<< liftEff <$> Fn.runFn2 t.kill e k
killFiber e (Fiber t) = liftEff t.isSuspended >>= if _
then liftEff $ void $ Fn.runFn2 t.kill e (const (pure unit))
else makeAff \k → effCanceler <$> Fn.runFn2 t.kill e k

-- | Blocks until the fiber completes, yielding the result. If the fiber
-- | throws an exception, it is rethrown in the current fiber.
joinFiber eff a. Fiber eff a Aff eff a
joinFiber (Fiber t) = makeAff \k → Canceler <<< const <<< liftEff <$> t.join k
joinFiber (Fiber t) = makeAff \k → effCanceler <$> t.join k

-- | A cancellation effect for actions run via `makeAff`. If a `Fiber` is
-- | killed, and an async action is pending, the canceler will be called to
Expand All @@ -194,6 +198,10 @@ instance monoidCanceler ∷ Monoid (Canceler eff) where
nonCanceler eff. Canceler eff
nonCanceler = Canceler (const (pure unit))

-- | A canceler from an Eff action.
effCanceler eff. Eff eff Unit Canceler eff
effCanceler = Canceler <<< const <<< liftEff

-- | Forks an `Aff` from an `Eff` context, returning the `Fiber`.
launchAff eff a. Aff eff a Eff eff (Fiber eff a)
launchAff aff = do
Expand Down
12 changes: 4 additions & 8 deletions src/Control/Monad/Aff/AVar.purs
Original file line number Diff line number Diff line change
Expand Up @@ -16,17 +16,13 @@ module Control.Monad.Aff.AVar
) where

import Prelude
import Control.Monad.Aff (Aff, Canceler(..), makeAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Aff (Aff, makeAff, effCanceler)
import Control.Monad.Eff.AVar (AVar, AVAR, AVarStatus(..), isEmpty, isFilled, isKilled)
import Control.Monad.Eff.AVar as AVar
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (Error)
import Data.Maybe (Maybe)

toCanceler eff. Eff eff Unit Canceler eff
toCanceler = Canceler <<< const <<< liftEff

-- | Creates a fresh AVar with an initial value.
makeVar eff a. a Aff (avar AVAR | eff) (AVar a)
makeVar = liftEff <<< AVar.makeVar
Expand Down Expand Up @@ -57,7 +53,7 @@ isKilledVar = liftEff <<< AVar.isKilledVar
takeVar eff a. AVar a Aff (avar AVAR | eff) a
takeVar avar = makeAff \k → do
c ← AVar.takeVar avar k
pure (toCanceler c)
pure (effCanceler c)

-- | Attempts to synchronously take an AVar value, leaving it empty. If the
-- | AVar is empty, this will return `Nothing`.
Expand All @@ -70,7 +66,7 @@ tryTakeVar = liftEff <<< AVar.tryTakeVar
putVar eff a. a AVar a Aff (avar AVAR | eff) Unit
putVar value avar = makeAff \k → do
c ← AVar.putVar value avar k
pure (toCanceler c)
pure (effCanceler c)

-- | Attempts to synchronously fill an AVar. If the AVar is already filled,
-- | this will do nothing. Returns true or false depending on if it succeeded.
Expand All @@ -83,7 +79,7 @@ tryPutVar value = liftEff <<< AVar.tryPutVar value
readVar eff a. AVar a Aff (avar AVAR | eff) a
readVar avar = makeAff \k → do
c ← AVar.readVar avar k
pure (toCanceler c)
pure (effCanceler c)

-- | Attempts to synchronously read an AVar. If the AVar is empty, this will
-- | return `Nothing`.
Expand Down

0 comments on commit 91853ea

Please sign in to comment.