@@ -19,10 +19,15 @@ module Control.Distributed.Process.Internal.Primitives
21 , matchUnknown
21 , matchUnknown
22− , AbstractMessage(..)
23 , matchAny
22 , matchAny
24 , matchAnyIf
23 , matchAnyIf
25 , matchChan
24 , matchChan
26 -- * Process management
31 -- * Process management
27 , terminate
32 , terminate
28 , ProcessTerminationException(..)
33 , ProcessTerminationException(..)
@@ -320,44 +325,108 @@ matchIf c p = Match $ MatchMsg $ \msg ->
320 !decoded = decode (messageEncoding msg)
325 !decoded = decode (messageEncoding msg)
321 _ -> Nothing
326 _ -> Nothing
323−-- | Represents a received message and provides two basic operations on it.
328+-- | Match against any message, regardless of the underlying (contained) type
324−data AbstractMessage = AbstractMessage {
329+matchMessage :: (Message -> Process Message) -> Match Message
325− forward :: ProcessId -> Process () -- ^ forward the message to @ProcessId@
330+matchMessage p = Match $ MatchMsg $ \msg -> Just (p msg)
326− , maybeHandleMessage :: forall a b. (Serializable a)
331+
327− => (a -> Process b) -> Process (Maybe b) {- ^ Handle the message.
332+-- | Match against any message (regardless of underlying type) that satisfies a predicate
333+matchMessageIf :: (Message -> Bool) -> (Message -> Process Message) -> Match Message
334+matchMessageIf c p = Match $ MatchMsg $ \msg ->
336+ True -> Just (p msg)
339+-- | Forward a raw 'Message' to the given 'ProcessId'.
340+forward :: Message -> ProcessId -> Process ()
341+forward msg them = do
343+ liftIO $ sendPayload (processNode proc)
344+ (ProcessIdentifier (processId proc))
345+ (ProcessIdentifier them)
347+ (messageToPayload msg)
349+-- | Wrap a 'Serializable' value in a 'Message'. Note that 'Message's are
350+-- 'Serializable' - like the datum they contain - but remember that deserializing
351+-- a 'Message' will yield a 'Message', not the type within it! To obtain the
352+-- wrapped datum, use 'unwrapMessage' or 'handleMessage' with a specific type.
356+-- self <- getSelfPid
357+-- send self (wrapMessage "blah")
358+-- Nothing <- expectTimeout 1000000 :: Process (Maybe String)
359+-- (Just m) <- expectTimeout 1000000 :: Process (Maybe Message)
360+-- "blah" <- unwrapMessage m :: Process (Maybe String)
363+wrapMessage :: Serializable a => a -> Message
364+wrapMessage = createMessage
366+-- | Attempt to unwrap a raw 'Message'.
367+-- If the type of the decoded message payload matches the expected type, the
368+-- value will be returned with @Just@, otherwise @Nothing@ indicates the types
371+-- This expression, for example, will evaluate to @Nothing@
372+-- > unwrapMessage (wrapMessage "foobar") :: Process (Maybe Int)
374+-- Whereas this expression, will yield @Just "foo"@
375+-- > unwrapMessage (wrapMessage "foo") :: Process (Maybe String)
377+unwrapMessage :: forall a. Serializable a => Message -> Process (Maybe a)
379+ case messageFingerprint msg == fingerprint (undefined :: a) of
380+ True -> return (Just (decoded))
383+ -- Make sure the value is fully decoded so that we don't hang to
384+ -- bytestrings when the calling process doesn't evaluate immediately
385+ !decoded = decode (messageEncoding msg)
388+-- | Attempt to handle a raw 'Message'.
328− If the type of the message matches the type of the first argument to
389+-- If the type of the message matches the type of the first argument to
329− the supplied expression, then the expression will be evaluated against
390+-- the supplied expression, then the message will be decoded and the expression
330− it. If this runtime type checking fails, then @Nothing@ will be returned
391+-- evaluated against its value. If this runtime type checking fails however,
331− to indicate the fact. If the check succeeds and evaluation proceeds
392+-- @Nothing@ will be returned to indicate the fact. If the check succeeds and
332− however, the resulting value with be wrapped with @Just@.
393+-- evaluation proceeds, the resulting value with be wrapped with @Just@.
334− }
395+-- Intended for use in `catchesExit` and `matchAny` primitives.
397+handleMessage :: forall a b. (Serializable a)
398+ => Message -> (a -> Process b) -> Process (Maybe b)
399+handleMessage msg proc = do
400+ case messageFingerprint msg == fingerprint (undefined :: a) of
401+ True -> do { r <- proc (decoded :: a); return (Just r) }
404+ !decoded = decode (messageEncoding msg)
336-- | Match against an arbitrary message. 'matchAny' removes the first available
407-- | Match against an arbitrary message. 'matchAny' removes the first available
337−-- message from the process mailbox, and via the 'AbstractMessage' type,
408+-- message from the process mailbox. To handle arbitrary /raw/ messages once
338−-- supports forwarding /or/ handling the message /if/ it is of the correct
409+-- removed from the mailbox, see 'handleMessage' and 'unwrapMessage'.
339−-- type. If /not/ of the right type, then the 'AbstractMessage'
340−-- @maybeHandleMessage@ function will not evaluate the supplied expression,
341−-- /but/ the message will still have been removed from the process mailbox!
343−matchAny :: forall b. (AbstractMessage -> Process b) -> Match b
411+matchAny :: forall b. (Message -> Process b) -> Match b
344−matchAny p = Match $ MatchMsg $ Just . p . abstract
412+matchAny p = Match $ MatchMsg $ \msg -> Just (p msg)
346−-- | Match against an arbitrary message. 'matchAnyIf' will /only/ remove the
414+-- | Match against an arbitrary message. Intended for use with 'handleMessage'
415+-- and 'unwrapMessage', this function /only/ removes a message from the process
347−-- message from the process mailbox, /if/ the supplied condition matches. The
416+-- mailbox, /if/ the supplied condition matches. The success (or failure) of
348−-- success (or failure) of runtime type checks in @maybeHandleMessage@ does not
417+-- runtime type checks deferred to @handleMessage@ and friends is irrelevant
349−-- count here, i.e., if the condition evaluates to @True@ then the message will
418+-- here, i.e., if the condition evaluates to @True@ then the message will
350-- be removed from the process mailbox and decoded, but that does /not/
419-- be removed from the process mailbox and decoded, but that does /not/
351−-- guarantee that an expression passed to @maybeHandleMessage@ will pass the
420+-- guarantee that an expression passed to @handleMessage@ will pass the
352−-- runtime type checks and therefore be evaluated. If the types do not match
421+-- runtime type checks and therefore be evaluated.
353−-- up, then @maybeHandleMessage@ returns 'Nothing'.
422+--
354matchAnyIf :: forall a b. (Serializable a)
423matchAnyIf :: forall a b. (Serializable a)
355 => (a -> Bool)
424 => (a -> Bool)
356− -> (AbstractMessage -> Process b)
425+ -> (Message -> Process b)
357 -> Match b
426 -> Match b
358matchAnyIf c p = Match $ MatchMsg $ \msg ->
427matchAnyIf c p = Match $ MatchMsg $ \msg ->
359 case messageFingerprint msg == fingerprint (undefined :: a) of
428 case messageFingerprint msg == fingerprint (undefined :: a) of
360− True | c decoded -> Just (p (abstract msg))
429+ True | c decoded -> Just (p msg)
362 decoded :: a
431 decoded :: a
363 -- Make sure the value is fully decoded so that we don't hang to
432 -- Make sure the value is fully decoded so that we don't hang to
@@ -365,24 +434,6 @@ matchAnyIf c p = Match $ MatchMsg $ \msg ->
365 !decoded = decode (messageEncoding msg)
434 !decoded = decode (messageEncoding msg)
366 _ -> Nothing
435 _ -> Nothing
368−abstract :: Message -> AbstractMessage
369−abstract msg = AbstractMessage {
370− forward = \them -> do
372− liftIO $ sendPayload (processNode proc)
373− (ProcessIdentifier (processId proc))
374− (ProcessIdentifier them)
376− (messageToPayload msg)
377− , maybeHandleMessage = \(proc :: (a -> Process b)) -> do
378− case messageFingerprint msg == fingerprint (undefined :: a) of
379− True -> do { r <- proc (decoded :: a); return (Just r) }
382− !decoded = decode (messageEncoding msg)
386-- | Remove any message from the queue
437-- | Remove any message from the queue
387matchUnknown :: Process b -> Match b
438matchUnknown :: Process b -> Match b
388matchUnknown p = Match $ MatchMsg (const (Just p))
439matchUnknown p = Match $ MatchMsg (const (Just p))
@@ -461,16 +512,16 @@ catchExit act exitHandler = catch act handleExit
462-- See 'maybeHandleMessage' and 'AsbtractMessage' for more details.
513-- See 'maybeHandleMessage' and 'AsbtractMessage' for more details.
463catchesExit :: Process b
514catchesExit :: Process b
464− -> [(ProcessId -> AbstractMessage -> (Process (Maybe b)))]
515+ -> [(ProcessId -> Message -> (Process (Maybe b)))]
465 -> Process b
516 -> Process b
466catchesExit act handlers = catch act ((flip handleExit) handlers)
517catchesExit act handlers = catch act ((flip handleExit) handlers)
468 handleExit :: ProcessExitException
519 handleExit :: ProcessExitException
469− -> [(ProcessId -> AbstractMessage -> Process (Maybe b))]
520+ -> [(ProcessId -> Message -> Process (Maybe b))]
470 -> Process b
521 -> Process b
471 handleExit ex [] = liftIO $ throwIO ex
522 handleExit ex [] = liftIO $ throwIO ex
472 handleExit ex@(ProcessExitException from msg) (h:hs) = do
523 handleExit ex@(ProcessExitException from msg) (h:hs) = do
473− r <- h from (abstract msg)
524+ r <- h from msg
474 case r of
525 case r of
475 Nothing -> handleExit ex hs
526 Nothing -> handleExit ex hs
476 Just p -> return p
527 Just p -> return p