Simplify code

Author: qnikst

src/Control/Distributed/Process.hs

@@ -163,17 +163,11 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Applicative ((<$>))
 import Control.Monad.Reader (ask)
 import Control.Concurrent.MVar
-  ( newEmptyMVar
+  ( MVar
+  , newEmptyMVar
   , takeMVar
   , putMVar
   )
-import Control.Concurrent.STM (atomically)
-import Control.Concurrent.STM.TMVar
-  ( TMVar
-  , newEmptyTMVarIO
-  , putTMVar
-  , takeTMVar
-  )
 import Control.Distributed.Static
   ( Closure
   , closure
@@ -413,29 +407,23 @@ spawnChannelLocal proc = do
 callLocal ::
      Process a  -- ^ Process to run
   -> Process a  -- ^ Value returned
-callLocal proc = do 
+callLocal proc = mask_ $ do
   parent <- getSelfPid
-  mv    <- liftIO newEmptyTMVarIO :: Process (TMVar (Either SomeException a))
+  mv    <- liftIO newEmptyMVar :: Process (MVar (Either SomeException a))
   child <- spawnLocal $ mask $ \release -> do
-             link parent
              ep <- try $ release $ proc
-             liftIO $ atomically $ putTMVar mv ep
-  withMonitor child $ do
-    fetchResult child mv `catch` (\e -> do exit child (show (e::SomeException))
-                                           waitForExit child 
-                                           liftIO $ throwIO e)
+             liftIO $ putMVar mv ep
+  liftIO (fetchResult mv) `onException`
+    (do exit child "exception in parent process"
+        waitForExit child)
   where
-    waitForExit child =
-        receiveWait
-            [ matchIf (\(ProcessMonitorNotification _ ch _) -> child == ch)
-                      (\_ -> return ())
-            ]
-    fetchResult child mv = do
-        receiveWait
-            [ matchSTM (takeTMVar mv)
-                       (\rs -> do waitForExit child -- avoid monitor events leak
-                                  liftIO $ either throwIO return rs)
-            , matchIf  (\(ProcessMonitorNotification _ ch _) -> child == ch)
-                       (\(ProcessMonitorNotification _ _ reason) ->
-                            fail $ "callLocal: remote process died: " ++ show reason)
-            ]
+    waitForExit child = do
+      bracket (monitor child)
+              (unmonitor)
+              (\mRef -> receiveWait
+                   [ matchIf (\(ProcessMonitorNotification ref _ _) -> ref == mRef)
+                             (\_ -> return ())
+                   ])
+    fetchResult mv = do
+        rs <- takeMVar mv
+        liftIO $ either throwIO return rs