Add failing test for purescript-contrib/purescript-aff#174

[felixSchl]

I'll also make an attempt at fixing this, but if it goes nowhere, feel free to copy the test code.

[natefaubion]

This is a tough call, and I think this is actually a problem with invincible/uninterruptible being implemented in terms of bracket. In this example, you essentially inlined invincible. The problem is that bracket always admits an unmasked state for the body. You've killed it during the acquisition phase, and so it goes to run the body (const (pure unit)), which can be killed. And since you've already killed it, I believe it is correctly not even evaluating the body and marking it as killed for generalBracket. I think this means we need a primitive for invincible which applies a complete mask for the entire evaluation of the block.

[felixSchl]

Alright, to be honest, I think I may be out of my depth there, I was hoping it might be a small fix on top of the existing bracketing code. Been in Aff.js for good chunk of time last night, and it's incredible difficult to trace all the mutations and how the slots relate to the current tag, etc.

[felixSchl]

Here's a motivating example for this change. Previously a withLock function
that takes an avar, runs an action, and then returns the avar was impossible to
write. Consider the following function:

withLock
  :: forall a
   . Aff a
  -> AVar Unit
  -> Aff a

A possible implementation could look like this:

withLock action lock =
    bracket (AVar.take lock)
      (\_ -> AVar.put lock)
      (\_ -> action)

However, this implementation means that that the entire withLock function was
no longer cancellable.

Another possible implementation could then look like this:

withLock action lock =
  bracket (pure unit)
    (\_ -> Avar.put lock)
    (\_ ->  do
        AVar.take lock
        action
    )

However, it is now impossible to discern, at time of cancellation, whether or
not the lock has been taken. Did the interrupt occur taking the lock, or running
the action? It is impossible to tell.

This pull request enables the following function to be written:

atomic :: (v -> Aff Unit) -> Aff v -> Aff v
atomic postFn action =
  generalBracket (pure unit)
    { completed: \v _ -> postFn v
    , killed: \_ _ -> pure unit
    , failed: \_ _ -> pure unit
    } action

It is guaranteed that iff action completes, postFn will run.

Using this function, we can now implement withLock:

withLock action lock =
  bracket (liftEffect (Ref.new false))
    (\ref ->
        liftEffect (Ref.read ref) >>= \hasTakenLock ->
            when hasTakenLock $ Avar.put lock)
    (\ref ->
        atomic (\_ -> liftEffect $ Ref.write true ref) $ AVar.take lock
        action
    )

[felixSchl]

On further thought, my motivating example is flawed. An interrupt during AVar.take should go through proper AVar cancellation mechanics, meaning an interrupt during AVar.take won't cause any damage and the Ref won't be touched. If, however, AVar.take does complete, and we don't transition back into 'PENDING', then we know that the Ref.write true must follow.

So, really the motivating example is a bad one. A better one, I believe, would be the following:

module Test.Main where

import Prelude

import Data.Maybe (Maybe(..))
import Data.Time.Duration (Milliseconds(..))
import Effect (Effect)
import Effect.Aff (Aff, delay, error, forkAff, invincible, killFiber, launchAff_)
import Effect.Class (liftEffect)
import Effect.Console as Console
import Effect.Ref (Ref)
import Effect.Ref as Ref

newtype LazyVal a =
  LazyVal { ref :: Ref (Maybe a)
          , acquireFn :: Aff a
          }

newLazyVal :: ∀ a. Aff a -> Effect (LazyVal a)
newLazyVal acquireFn = ado
  ref <- Ref.new Nothing
  in LazyVal { ref, acquireFn }

acquire :: ∀ a. LazyVal a -> Aff a
acquire (LazyVal { ref, acquireFn }) = do
  liftEffect (Ref.read ref) >>= case _ of
    Just v ->
      pure v
    Nothing -> do
      v <- acquireFn
      v <$ liftEffect (Ref.write (Just v) ref)

newLeakedLazyVal :: Effect (LazyVal String)
newLeakedLazyVal =
  newLazyVal $
    invincible $
      "hello" <$ do
        delay (10.0 # Milliseconds)
        liftEffect $ Console.log "yielded!"

main :: Effect Unit
main = launchAff_ do
  lv <- liftEffect newLeakedLazyVal
  f1 <- forkAff $ acquire lv
  delay (5.0 # Milliseconds)
  killFiber (error "abort!") f1
  acquire lv

The idea is to capture a shared resource that can be lazily acquired. Since the acquistion function is just any old Aff, we cannot know whether or not the acquisition function is masked. If it is masked, we forgo the opportunity to capture the yielded value (even though we had to wait, since it's not killable!), and subsequently have to yield it again.

If you run the above example, you will see "yielded!" printed twice to the console. The resource is never captured in the Ref and acquisition will happen again and again until one fine day there's no interrupt during acquisition.

To be clear, however, I am not proposing a change to purescript-aff that would make the above work without changes. The semantics are correct, as far as I am concerned that if an interrupt happens during a partially evaluated bracket body, it should of course be treated as killed. However, if the body did fully evaluate (e.g. it was interrupted while masked), it should call the completed handler. The acquire function above could then be written as:

acquire :: ∀ a. LazyVal a -> Aff a
acquire (LazyVal { ref, acquireFn }) = do
  liftEffect (Ref.read ref) >>= case _ of
    Just v ->
      pure v
    Nothing ->
      generalBracket (pure unit)
         { completed: \v _ -> liftEffect (Ref.write (Just v) ref)
         , killed: \_ _ -> pure unit
         , failed: \_ _ -> pure unit
         } (const acquireFn)