Merge pull request #262 from HeinrichApfelmus/mvar-crash-deadlock

Prevent a deadlock if stepping the network crashes

reactive-banana/src/Reactive/Banana/Prim/High/Combinators.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances, NamedFieldPuns, NoMonomorphismRestriction #-}
 module Reactive.Banana.Prim.High.Combinators where
 
+import           Control.Exception
 import           Control.Concurrent.MVar
 import           Control.Event.Handler
 import           Control.Monad
@@ -50,11 +51,15 @@ data EventNetwork = EventNetwork
 
 runStep :: EventNetwork -> Prim.Step -> IO ()
 runStep EventNetwork{ actuated, s } 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
+    output <- mask $ \restore -> do
+        s1 <- takeMVar s                   -- read and take lock
+        -- pollValues <- sequence polls    -- poll mutable data
+        (output, s2) <-
+            restore (f s1)                 -- calculate new state
+                `onException` putMVar s s1 -- on error, restore the original state
+        putMVar s s2                       -- write state
+        return output
+    output                                 -- run IO actions afterwards
   where
     whenFlag flag action = readIORef flag >>= \b -> when b action