git.iko.soy/distributed-process
on master help sign in
Added ProcessId to ProcessKillException, changed catchExit signature, and changed ProcessExitException show
cdedc03RodLogic
distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs+7−7
compare with master
unifiedsplit
@@ -344,13 +344,13 @@ kill them reason = do
344 else sendCtrlMsg (Just nid) (Kill them reason)
344 else sendCtrlMsg (Just nid) (Kill them reason)
345
345
346-- | Thrown by 'kill'
346-- | Thrown by 'kill'
347−newtype ProcessKillException =
347+data ProcessKillException =
348− ProcessKillException String
348+ ProcessKillException !ProcessId !String
349 deriving (Typeable)
349 deriving (Typeable)
350
350
351instance Exception ProcessKillException
351instance Exception ProcessKillException
352instance Show ProcessKillException where
352instance Show ProcessKillException where
353− show (ProcessKillException reason) = reason
353+ show (ProcessKillException pid reason) = "Kill by " ++ show pid ++ " : " ++ reason
354
354
355
355
356-- | Graceful request to exit a process
356-- | Graceful request to exit a process
@@ -372,18 +372,18 @@ data ProcessExitException =
372
372
373instance Exception ProcessExitException
373instance Exception ProcessExitException
374instance Show ProcessExitException where
374instance Show ProcessExitException where
375− show (ProcessExitException _ reason) = show reason
375+ show (ProcessExitException pid _) = "Exit by " ++ show pid
376
376
377-- | Catches ProcessExitException
377-- | Catches ProcessExitException
378−catchExit :: forall a b . (Show a, Serializable a) => Process b -> (ProcessId -> a -> Process ()) -> Process b
378+catchExit :: forall a b . (Show a, Serializable a) => Process b -> (ProcessId -> a -> Process b) -> Process b
379catchExit act exitHandler = catch act handleExit
379catchExit act exitHandler = catch act handleExit
380 where
380 where
381 handleExit ex@(ProcessExitException from msg) =
381 handleExit ex@(ProcessExitException from msg) =
382 if messageFingerprint msg == fingerprint (undefined :: a)
382 if messageFingerprint msg == fingerprint (undefined :: a)
383 then do
383 then do
384 let reason = decoded
384 let reason = decoded
385− exitHandler from reason
385+ _ <- exitHandler from reason
386− liftIO . throwIO $ ProcessKillException (show reason)
386+ liftIO $ throwIO ex
387 else liftIO $ throwIO ex
387 else liftIO $ throwIO ex
388 where
388 where
389 decoded :: a
389 decoded :: a
distributed-process/src/Control/Distributed/Process/Node.hs+2−2
@@ -725,8 +725,8 @@ ncEffectNamedSend from label msg = do
725
725
726-- [Issue #69]
726-- [Issue #69]
727ncEffectKill :: ProcessId -> ProcessId -> String -> NC ()
727ncEffectKill :: ProcessId -> ProcessId -> String -> NC ()
728−ncEffectKill _ to reason =
728+ncEffectKill from to reason =
729− throwException to $ ProcessKillException reason
729+ throwException to $ ProcessKillException from reason
730
730
731-- [Issue #69]
731-- [Issue #69]
732ncEffectExit :: ProcessId -> ProcessId -> Message -> NC ()
732ncEffectExit :: ProcessId -> ProcessId -> Message -> NC ()