b1bc105 · distributed-process

git.iko.soy/distributed-process

on master help sign in

Improve exception handling in callLocal.

b1bc105Alexander Vershilov12 years ago

src/Control/Distributed/Process.hs+14−14

compare with master

unifiedsplit

@@ -163,7 +163,12 @@ import Prelude hiding (catch)

163import Control.Monad.IO.Class (liftIO)

164import Control.Applicative ((<$>))

165import Control.Monad.Reader (ask)

166−import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)

166+import Control.Concurrent.MVar

167+ ( MVar

168+ , newEmptyMVar

169+ , takeMVar

170+ , putMVar

171+ )

167import Control.Distributed.Static

172import Control.Distributed.Static

168 ( Closure

173 ( Closure

169 , closure

174 , closure

@@ -305,7 +310,7 @@ import Control.Distributed.Process.Internal.Spawn

305 , spawnSupervised

310 , spawnSupervised

306 , call

311 , call

307 )

312 )

308−import Control.Exception (SomeException, throwIO)

313+import Control.Exception (SomeException, throw)

309

314

310-- INTERNAL NOTES

315-- INTERNAL NOTES

311--

316--

@@ -401,15 +406,10 @@ spawnChannelLocal proc = do

401-- messages sent to the caller process, and also allows silently dropping late

406-- messages sent to the caller process, and also allows silently dropping late

402-- or duplicate messages sent to the isolated process after it exits.

407-- or duplicate messages sent to the isolated process after it exits.

403-- Silently dropping messages may not always be the best approach.

408-- Silently dropping messages may not always be the best approach.

404−callLocal ::

409+callLocal :: Process a -> Process a

405− Process a -- ^ Process to run

406− -> Process a -- ^ Value returned

407−callLocal proc = do

410+callLocal proc = mask $ \release -> do

408− mv <- liftIO newEmptyMVar

411+ mv <- liftIO newEmptyMVar :: Process (MVar (Either SomeException a))

409− self <- getSelfPid

410− _ <- spawnLocal $ do

411− link self

412− try proc >>= liftIO . putMVar mv

412+ child <- spawnLocal $ try (release proc) >>= liftIO . putMVar mv

413− liftIO $ takeMVar mv >>=

413+ rs <- liftIO (takeMVar mv) `onException`

414+ (kill child "exception in parent process" >> liftIO (takeMVar mv))

414− either (throwIO :: SomeException -> IO a) return

415+ either throw return rs

415−