Killing a suspended thread should be sync because laws (#121)

Author: natefaubion

src/Control/Monad/Aff.js

@@ -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()) {

src/Control/Monad/Aff.purs

@@ -27,6 +27,7 @@ module Control.Monad.Aff
   , BracketConditions
   , generalBracket
   , nonCanceler
+  , effCanceler
   , module Exports
   ) where
 
@@ -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 functorFiber ∷ Functor (Fiber eff) where
@@ -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
@@ -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

src/Control/Monad/Aff/AVar.purs

@@ -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
@@ -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`.
@@ -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.
@@ -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`.