@@ -30,6 +30,9 @@ module Control.Distributed.Process.Internal.Primitives
32 , catchExit
32 , catchExit
34+ -- keep the exception constructor hidden, so that handling exit
35+ -- reasons must take place via the 'catchExit' family of primitives
33 , ProcessExitException()
36 , ProcessExitException()
34 , getSelfPid
37 , getSelfPid
35 , getSelfNode
38 , getSelfNode
@@ -312,11 +315,17 @@ matchIf c p = Match $ MatchMsg $ \msg ->
312 !decoded = decode (messageEncoding msg)
315 !decoded = decode (messageEncoding msg)
313 _ -> Nothing
316 _ -> Nothing
315−-- | Represents a received message and provides two operations on it.
318+-- | Represents a received message and provides two basic operations on it.
316data AbstractMessage = AbstractMessage {
319data AbstractMessage = AbstractMessage {
317 forward :: ProcessId -> Process () -- ^ forward the message to @ProcessId@
320 forward :: ProcessId -> Process () -- ^ forward the message to @ProcessId@
318 , maybeHandleMessage :: forall a b. (Serializable a)
321 , maybeHandleMessage :: forall a b. (Serializable a)
319− => (a -> Process b) -> Process (Maybe b) -- ^ handle the message if it is of the given type
322+ => (a -> Process b) -> Process (Maybe b) {- ^ Handle the message.
323+ If the type of the message matches the type of the first argument to
324+ the supplied expression, then the expression will be evaluated against
325+ it. If this runtime type checking fails, then @Nothing@ will be returned
326+ to indicate the fact. If the check succeeds and evaluation proceeds
327+ however, the resulting value with be wrapped with @Just@.
322-- | Match against an arbitrary message. 'matchAny' removes the first available
331-- | Match against an arbitrary message. 'matchAny' removes the first available
@@ -388,13 +397,15 @@ terminate :: Process a
388terminate = liftIO $ throwIO ProcessTerminationException
397terminate = liftIO $ throwIO ProcessTerminationException
390-- [Issue #110]
399-- [Issue #110]
391−-- | Die immediately - throws a 'ProcessExitException' with the given @reason@
400+-- | Die immediately - throws a 'ProcessExitException' with the given @reason@.
392die :: Serializable a => a -> Process b
401die :: Serializable a => a -> Process b
393die reason = do
402die reason = do
394 pid <- getSelfPid
403 pid <- getSelfPid
395 liftIO $ throwIO (ProcessExitException pid (createMessage reason))
404 liftIO $ throwIO (ProcessExitException pid (createMessage reason))
397−-- | Forceful request to kill a process
406+-- | Forceful request to kill a process. Where 'exit' provides an exception
407+-- that can be caught and handled, 'kill' throws an unexposed exception type
408+-- which cannot be handled explicitly (by type).
398kill :: ProcessId -> String -> Process ()
409kill :: ProcessId -> String -> Process ()
399-- NOTE: We send the message to our local node controller, which will then
410-- NOTE: We send the message to our local node controller, which will then
400-- forward it to a remote node controller (if applicable). Sending it directly
411-- forward it to a remote node controller (if applicable). Sending it directly
@@ -402,7 +413,9 @@ kill :: ProcessId -> String -> Process ()
402-- 'monitor' or 'link' request.
413-- 'monitor' or 'link' request.
403kill them reason = sendCtrlMsg Nothing (Kill them reason)
414kill them reason = sendCtrlMsg Nothing (Kill them reason)
405−-- | Graceful request to exit a process
416+-- | Graceful request to exit a process. Throws 'ProcessExitException' with the
417+-- supplied @reason@ encoded as a message. Any /exit signal/ raised in this
418+-- manner can be handled using the 'catchExit' family of functions.
406exit :: Serializable a => ProcessId -> a -> Process ()
419exit :: Serializable a => ProcessId -> a -> Process ()
407-- NOTE: We send the message to our local node controller, which will then
420-- NOTE: We send the message to our local node controller, which will then
408-- forward it to a remote node controller (if applicable). Sending it directly
421-- forward it to a remote node controller (if applicable). Sending it directly
@@ -410,7 +423,13 @@ exit :: Serializable a => ProcessId -> a -> Process ()
410-- 'monitor' or 'link' request.
423-- 'monitor' or 'link' request.
411exit them reason = sendCtrlMsg Nothing (Exit them (createMessage reason))
424exit them reason = sendCtrlMsg Nothing (Exit them (createMessage reason))
413−-- | Catches ProcessExitException
426+-- | Catches 'ProcessExitException'. The handler will not be applied unless its
427+-- type matches the encoded data stored in the exception (see the /reason/
428+-- argument given to the 'exit' primitive). If the handler cannot be applied,
429+-- the exception will be re-thrown.
431+-- To handle 'ProcessExitException' without regard for /reason/, see 'catch'.
432+-- To handle multiple /reasons/ of differing types, see 'catchesExit'.
414catchExit :: forall a b . (Show a, Serializable a)
433catchExit :: forall a b . (Show a, Serializable a)
415 => Process b
434 => Process b
416 -> (ProcessId -> a -> Process b)
435 -> (ProcessId -> a -> Process b)
@@ -427,6 +446,29 @@ catchExit act exitHandler = catch act handleExit
427 -- bytestrings if the caller doesn't use the value immediately
446 -- bytestrings if the caller doesn't use the value immediately
428 !decoded = decode (messageEncoding msg)
447 !decoded = decode (messageEncoding msg)
449+-- | As 'Control.Exception.catches' but allows for multiple handlers. Because
450+-- 'ProcessExitException' stores the exit @reason@ as a typed, encoded message,
451+-- a handler must accept an input of the expected type. In order to handle
452+-- a list of potentially different handlers (and therefore input types), a
453+-- handler passed to 'catchesExit' must accept 'AbstractMessage' and return
454+-- @Maybe@ (i.e., @Just p@ if it handled the exit reason, otherwise @Nothing@).
456+-- See 'maybeHandleMessage' and 'AsbtractMessage' for more details.
457+catchesExit :: Process b
458+ -> [(ProcessId -> AbstractMessage -> (Process (Maybe b)))]
460+catchesExit act handlers = catch act ((flip handleExit) handlers)
462+ handleExit :: ProcessExitException
463+ -> [(ProcessId -> AbstractMessage -> Process (Maybe b))]
465+ handleExit ex [] = liftIO $ throwIO ex
466+ handleExit ex@(ProcessExitException from msg) (h:hs) = do
467+ r <- h from (abstract msg)
469+ Nothing -> handleExit ex hs
430-- | Our own process ID
472-- | Our own process ID
431getSelfPid :: Process ProcessId
473getSelfPid :: Process ProcessId
432getSelfPid = processId <$> ask
474getSelfPid = processId <$> ask