@@ -103,13 +103,13 @@ import Data.Int (Int32)
103103import Data.Typeable (Typeable)
104104import Data.Foldable (forM_)
105105import Data.Maybe (isJust)
106−import Control.Monad (void, liftM2, liftM3, when, unless, forever)
106+import Control.Monad (void, when, unless, forever)
107107import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT)
108108import Control.Monad.IO.Class (MonadIO, liftIO)
109109import Control.Monad.State (MonadState, StateT, evalStateT, gets, modify)
110−import Control.Applicative ((<$>))
110+import Control.Applicative ((<$>), (<*>))
111111import Control.Category ((>>>))
112−import Control.Exception (Exception, throwIO, catch)
112+import Control.Exception (Exception, throwIO, catch, SomeException)
113113import Control.Concurrent (forkIO)
114114import Control.Concurrent.MVar ( MVar
115115 , newMVar
@@ -294,6 +294,7 @@ data MonitorReply = ProcessDied MonitorRef ProcessId DiedReason
294294
295295data DiedReason =
296296 DiedNormal
297+ | DiedException String -- TODO: would prefer SomeException instead of String, but exceptions don't implement Binary
297298 | DiedDisconnect
298299 | DiedNodeDown
299300
@@ -527,13 +528,24 @@ forkProcess node proc = do
527528 , lproc
528529 )
529530 void . forkIO $ do
530− runLocalProcess lproc proc
531− -- [Unified: Table 4]
532− let pid = processId lproc
533− writeChan (localCtrlChan node) $ NodeCtrlMsg
534− { ctrlMsgSender = Left pid
535− , ctrlMsgSignal = Died (Left pid) DiedNormal
536− }
531+ catch (do
532+ runLocalProcess lproc proc
533+ -- [Unified: Table 4]
534+ let pid = processId lproc
535+ writeChan (localCtrlChan node) $ NodeCtrlMsg
536+ { ctrlMsgSender = Left pid
537+ , ctrlMsgSignal = Died (Left pid) DiedNormal
538+ }
539+ )
540+ (\ex -> do
541+ let pid = processId lproc
542+ err = show (ex :: SomeException)
543+ writeChan (localCtrlChan node) $ NodeCtrlMsg
544+ { ctrlMsgSender = Left pid
545+ , ctrlMsgSignal = Died (Left pid) (DiedException err)
546+ }
547+ )
548+
537549 return (processId lproc)
538550
539551handleIncomingMessages :: LocalNode -> IO ()
@@ -727,19 +739,19 @@ runLocalProcess lproc proc = runReaderT (unProcess proc) lproc
727739
728740instance Binary LocalProcessId where
729741 put lpid = put (lpidUnique lpid) >> put (lpidCounter lpid)
730− get = liftM2 LocalProcessId get get
742+ get = LocalProcessId <$> get <*> get
731743
732744instance Binary ProcessId where
733745 put pid = put (processNodeId pid) >> put (processLocalId pid)
734− get = liftM2 ProcessId get get
746+ get = ProcessId <$> get <*> get
735747
736748instance Binary MonitorReply where
737749 put (ProcessDied ref pid reason) = put ref >> put pid >> put reason
738− get = liftM3 ProcessDied get get get
750+ get = ProcessDied <$> get <*> get <*> get
739751
740752instance Binary NodeCtrlMsg where
741753 put msg = put (ctrlMsgSender msg) >> put (ctrlMsgSignal msg)
742− get = liftM2 NodeCtrlMsg get get
754+ get = NodeCtrlMsg <$> get <*> get
743755
744756instance Binary ProcessSignal where
745757 put (Monitor pid ref) = putWord8 0 >> put pid >> put ref
@@ -747,20 +759,22 @@ instance Binary ProcessSignal where
747759 get = do
748760 header <- getWord8
749761 case header of
750− 0 -> liftM2 Monitor get get
751− 1 -> liftM2 Died get get
762+ 0 -> Monitor <$> get <*> get
763+ 1 -> Died <$> get <*> get
752764 _ -> fail "ProcessSignal.get: invalid"
753765
754766instance Binary DiedReason where
755− put DiedNormal = putWord8 0
756− put DiedDisconnect = putWord8 1
757− put DiedNodeDown = putWord8 2
767+ put DiedNormal = putWord8 0
768+ put (DiedException e) = putWord8 1 >> put e
769+ put DiedDisconnect = putWord8 2
770+ put DiedNodeDown = putWord8 3
758771 get = do
759772 header <- getWord8
760773 case header of
761774 0 -> return DiedNormal
762− 1 -> return DiedDisconnect
763− 2 -> return DiedNodeDown
775+ 1 -> DiedException <$> get
776+ 2 -> return DiedDisconnect
777+ 3 -> return DiedNodeDown
764778 _ -> fail "DiedReason.get: invalid"
765779
766780--------------------------------------------------------------------------------