Dynamic event switching results in "*** Exception: thread blocked indefinitely in an MVar operation" deadlock

[LiraOnGithub]

Hello,

While working on an application I noticed that the application hang any moment I created a new event from an event callback.
I decided to create a little application to test if it was my code, my misunderstanding of the framework or a bug.

I think I already ruled out the first option, as I get the exception "*** Exception: thread blocked indefinitely in an MVar operation" when I run the code below in GHCi.

You can enter "i" and "d" to increase or decrease the value in the state, and if the state gets to 5 it jumps to 1000. It is that jump that is causing the problems.

{-# LANGUAGE RecursiveDo #-}
module Main2 where
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import qualified Reactive.Banana as B
import qualified Reactive.Banana.Frameworks as BF

data Vars = Vars { var :: Int }
data EventType = Increase | Decrease | Jump
instance Semigroup EventType where a <> _ = a

main :: IO ()
main = do
	(addHandler, fire) <- BF.newAddHandler
	network <- B.compile $ eventNetworkDescription addHandler
	BF.actuate network
	loop fire
	where
		loop fire = do
			s <- getLine
			case s of
				"i" -> fire Increase
				"d" -> fire Decrease
				_ -> pure ()
			when (s /= "x") $ loop fire

eventNetworkDescription :: BF.AddHandler EventType -> BF.MomentIO ()
eventNetworkDescription addHandler = mdo
	events <- BF.fromAddHandler addHandler
	let vars = Vars 1
	stateE <- B.accumE vars $ doSomethingWithState <$> (events <> feedbackEvents)
	feedbackEvents <- B.switchE =<< (BF.execute $ getFeedbackEvents <$> stateE)

	stateB <- B.stepper vars stateE
	futureStateE <- BF.changes stateB
	BF.reactimate' $ fmap printState <$> futureStateE

doSomethingWithState :: EventType -> (Vars -> Vars)
doSomethingWithState Increase (Vars n) = Vars (n + 1)
doSomethingWithState Decrease (Vars n) = Vars (n - 1)
doSomethingWithState Jump _ = Vars 1000

getFeedbackEvents :: Vars -> BF.MomentIO (B.Event EventType)
getFeedbackEvents (Vars 5) = do
	(e, fire) <- BF.newEvent
	liftIO $ fire Jump
	pure e
getFeedbackEvents _ = pure B.never

printState :: Vars -> IO ()
printState (Vars n) = print n

Do you know if I am doing something wrong or if this is a bug? Thanks in advance!

[LiraOnGithub]

I decided to take a look at the source code of reactive-banana and saw this: Reactive.Banana.Internal.Combinators.compile

compile :: Moment () -> IO EventNetwork
compile setup = do
    actuated <- newIORef False                   -- flag to set running status
    s        <- newEmptyMVar                     -- setup callback machinery
    let
        whenFlag flag action = readIORef flag >>= \b -> when b action
        runStep f            = whenFlag actuated $ do
            s1 <- takeMVar s                    -- read and take lock
            -- pollValues <- sequence polls     -- poll mutable data
            (output, s2) <- f s1                -- calculate new state
            putMVar s s2                        -- write state
            output                              -- run IO actions afterwards

        eventNetwork = EventNetwork
            { runStep = runStep
            , actuate = writeIORef actuated True
            , pause   = writeIORef actuated False
            }

    (output, s0) <-                             -- compile initial graph
        Prim.compile (runReaderT setup eventNetwork) Prim.emptyNetwork
    putMVar s s0                                -- set initial state

    return $ eventNetwork

Could it be that the value of s never gets set which prevents s1 <- takeMVar s from returning?

[LiraOnGithub]

I managed to get the code to work by creating the event after it was first converted to a behavior:

{-# LANGUAGE RecursiveDo #-}
module Main2 where
import Control.Monad (when)
import qualified Reactive.Banana as B
import qualified Reactive.Banana.Frameworks as BF

data Vars = Vars { var :: Int }
data EventType = Increase | Decrease | Jump
instance Semigroup EventType where a <> _ = a

main :: IO ()
main = do
	(addHandler, fire) <- BF.newAddHandler
	network <- B.compile $ eventNetworkDescription addHandler
	BF.actuate network
	loop fire
	where
		loop fire = do
			s <- getLine
			case s of
				"i" -> fire Increase
				"d" -> fire Decrease
				_ -> pure ()
			when (s /= "x") $ loop fire

eventNetworkDescription :: BF.AddHandler EventType -> BF.MomentIO ()
eventNetworkDescription addHandler = mdo
	events <- BF.fromAddHandler addHandler
	let vars = Vars 1
	stateE <- B.accumE vars $ doSomethingWithState <$> (events <> feedbackEvents)

	stateB <- B.stepper vars stateE
	futureStateE <- BF.changes stateB
	feedbackEvents <- getFeedbackEvents stateB -- <- ❗ feedbackEvents is now created here ❗
	BF.reactimate' $ fmap printState <$> futureStateE

doSomethingWithState :: EventType -> (Vars -> Vars)
doSomethingWithState Increase (Vars n) = Vars (n + 1)
doSomethingWithState Decrease (Vars n) = Vars (n - 1)
doSomethingWithState Jump _ = Vars 1000

getFeedbackEvents :: B.Behavior Vars -> BF.MomentIO (B.Event EventType)
getFeedbackEvents b = do
	(e, fire) <- BF.newEvent
	eb <- BF.changes b
	BF.reactimate' $ fmap (fire . varToEvent) <$> eb
	pure $ B.filterJust e
	where
		varToEvent :: Vars -> Maybe EventType
		varToEvent (Vars 5) = Just Jump
		varToEvent _ = Nothing

printState :: Vars -> IO ()
printState (Vars n) = print n

But I still feel like it should work the original way I had it too instead of with this work-around... :/

[ocharles]

There's definitely something up here, because I'm also getting this in my app. I'm pretty sure the bug happens if you try and fire events in your MomentIO block given to execute. I get it with:

    imageChanged <- switchE =<< execute do
      imagePathChanges <&> \newPath -> do
        (imageLoaded, onImageLoad) <- newEvent
        liftIO do
          onImageLoad =<< imdecode ImreadColor <$> BS.readFile newPath
        return imageLoaded

But if I comment out that middle liftIO, the MVar-exception goes away. Likewise if I change liftIO to liftIO $ async $, the exception goes away.

I note that in your example, getFeedbackEvents is also doing liftIO . fire, which I think is the same problem.

[LiraOnGithub]

That might be the issue yes, but still strange that it happens.
I also asked on reddit/r/haskell and was able to fully solve my issue. I am not happy with the solution tho :/ But it works... https://old.reddit.com/r/haskell/comments/ovpftp/how_to_prevent_a_deadlock_in_reactivebanana_with/

[ocharles]

I think this is a duplicate of #190

[HeinrichApfelmus]

Hello! Yes, this is a duplicate of #190 . Sorry about that — it's a feature, not a bug! Creating a new event handler will reorganize the EventNetwork, but you can't reorganize the network while still handling events — it has to be done afterwards, that's why async and friends work.

[LiraOnGithub]

If it is working as intended, is the way I "solved" it the way to go?
Just making a global eventstream and call its fire whenever I need a new event? It feels so wrong...

[HeinrichApfelmus]

@PiJoKra Uh, could you be more specific about what you want to do? I don't quite understand how getFeedbackEvents is supposed to work.

It seems that you want some sort of recursion? You do have to be very careful when events depends on itself; using fire within a reactimate' in your second solution does break the recursive loop — the fired events come "slightly" after the event that triggered the feedback. If that is what you want, your second solution looks good to me, though by putting it into IO, it leaves unspecified how much "later" the feedback events occur after the events that triggered them.

[LiraOnGithub]

Sorry for my late reply. Yes I am looking for recursion. An event triggering another event.

Take for example a video game: an event causes your character to walk to a wall which should cause a collision-event that can be acted upon.

What is the best way to handle such a situation? I feel like I am missing something.

Edit: I was wondering why I did it the way I did by translating the Events to Behaviors and back to Events and decided to search the internet for information on recursiveness in Reactive Banana: I think I was already incorporating the advice from https://stackoverflow.com/questions/7850389/can-reactive-banana-handle-cycles-in-the-network

It is possible and encouraged to define an Event in terms of a Behavior that refers to the Event again. In other words, recursion is allowed as long as you go through a Behavior.

Since the answer there already mentions ...

The question "Does the reactive-banana library support recursively defined events?" has not only one, but three answers. The short answers are: 1. generally no, 2. sometimes yes, 3. with workaround yes.

... I am wondering if your stance has changed from "This is a decision that Conal Elliott made in his original FRP semantics and I've decided to stick to it."

[HeinrichApfelmus]

Take for example a video game: an event causes your character to walk to a wall which should cause a collision-event that can be acted upon.

What is the best way to handle such a situation? I feel like I am missing something.

The collision-event will be fine as long as it's not recursive — if you try to make the event that walks the character into the wall depend on the collision, then you may end up with conflicting semantics where the collision only happens if the character walks into a wall, but once a collision happens, the character will not walk into a wall — but this implies that no collision happens. Disallowing recursion of Events forces you to make up your mind on the semantics of this situation.

[HeinrichApfelmus]

(As this discussion does not qualify as an "issue" anymore, i.e. a defect or enhancement, I'm moving it to the Discussion forum.)