distributed-process-client-server-0.1.3.1: The Cloud Haskell Application Platform

Copyright(c) Tim Watson 2012 - 2013
LicenseBSD3 (see the file LICENSE)
MaintainerTim Watson <watson.timothy@gmail.com>
Stabilityexperimental
Portabilitynon-portable (requires concurrency)
Safe HaskellNone
LanguageHaskell98

Control.Distributed.Process.ManagedProcess.Server

Contents

Description

The Server Portion of the Managed Process API.

Synopsis

Server actions

condition :: forall a b. (Serializable a, Serializable b) => (a -> b -> Bool) -> Condition a b Source

Creates a Condition from a function that takes a process state a and an input message b and returns a Bool indicating whether the associated handler should run.

state :: forall s m. Serializable m => (s -> Bool) -> Condition s m Source

Create a Condition from a function that takes a process state a and returns a Bool indicating whether the associated handler should run.

input :: forall s m. Serializable m => (m -> Bool) -> Condition s m Source

Creates a Condition from a function that takes an input message m and returns a Bool indicating whether the associated handler should run.

reply :: Serializable r => r -> s -> Process (ProcessReply r s) Source

Instructs the process to send a reply and continue running.

replyWith :: Serializable r => r -> ProcessAction s -> Process (ProcessReply r s) Source

Instructs the process to send a reply and evaluate the ProcessAction.

noReply :: Serializable r => ProcessAction s -> Process (ProcessReply r s) Source

Instructs the process to skip sending a reply and evaluate a ProcessAction

continue :: s -> Process (ProcessAction s) Source

Instructs the process to continue running and receiving messages.

timeoutAfter :: Delay -> s -> Process (ProcessAction s) Source

Instructs the process loop to wait for incoming messages until Delay is exceeded. If no messages are handled during this period, the timeout handler will be called. Note that this alters the process timeout permanently such that the given Delay will remain in use until changed.

hibernate :: TimeInterval -> s -> Process (ProcessAction s) Source

Instructs the process to hibernate for the given TimeInterval. Note that no messages will be removed from the mailbox until after hibernation has ceased. This is equivalent to calling threadDelay.

stop :: ExitReason -> Process (ProcessAction s) Source

Instructs the process to terminate, giving the supplied reason. If a valid shutdownHandler is installed, it will be called with the ExitReason returned from this call, along with the process state.

stopWith :: s -> ExitReason -> Process (ProcessAction s) Source

As stop, but provides an updated state for the shutdown handler.

replyTo :: Serializable m => CallRef m -> m -> Process () Source

Sends a reply explicitly to a caller.

replyTo = sendTo

replyChan :: Serializable m => SendPort m -> m -> Process () Source

Sends a reply to a SendPort (for use in handleRpcChan et al).

replyChan = sendChan

Stateless actions

noReply_ :: forall s r. Serializable r => s -> Process (ProcessReply r s) Source

Continue without giving a reply to the caller - equivalent to continue, but usable in a callback passed to the handleCall family of functions.

haltNoReply_ :: Serializable r => ExitReason -> Process (ProcessReply r s) Source

Halt process execution during a call handler, without paying any attention to the expected return type.

continue_ :: s -> Process (ProcessAction s) Source

Version of continue that can be used in handlers that ignore process state.

timeoutAfter_ :: Delay -> s -> Process (ProcessAction s) Source

Version of timeoutAfter that can be used in handlers that ignore process state.

action (\(TimeoutPlease duration) -> timeoutAfter_ duration)

hibernate_ :: TimeInterval -> s -> Process (ProcessAction s) Source

Version of hibernate that can be used in handlers that ignore process state.

action (\(HibernatePlease delay) -> hibernate_ delay)

stop_ :: ExitReason -> s -> Process (ProcessAction s) Source

Version of stop that can be used in handlers that ignore process state.

action (\ClientError -> stop_ ExitNormal)

Server handler/callback creation

handleCall :: (Serializable a, Serializable b) => (s -> a -> Process (ProcessReply b s)) -> Dispatcher s Source

Constructs a call handler from a function in the Process monad. > handleCall = handleCallIf (const True)

handleCallIf Source

Arguments

:: (Serializable a, Serializable b) 
=> Condition s a

predicate that must be satisfied for the handler to run

-> (s -> a -> Process (ProcessReply b s))

a reply yielding function over the process state and input message

-> Dispatcher s 

Constructs a call handler from an ordinary function in the Process monad. Given a function f :: (s -> a -> Process (ProcessReply b s)), the expression handleCall f will yield a Dispatcher for inclusion in a Behaviour specification for the GenProcess. Messages are only dispatched to the handler if the supplied condition evaluates to True.

handleCallFrom :: forall s a b. (Serializable a, Serializable b) => (s -> CallRef b -> a -> Process (ProcessReply b s)) -> Dispatcher s Source

As handleCall but passes the CallRef to the handler function. This can be useful if you wish to reply later to the caller by, e.g., spawning a process to do some work and have it replyTo caller response out of band. In this case the callback can pass the CallRef to the worker (or stash it away itself) and return noReply.

handleCallFromIf Source

Arguments

:: (Serializable a, Serializable b) 
=> Condition s a

predicate that must be satisfied for the handler to run

-> (s -> CallRef b -> a -> Process (ProcessReply b s))

a reply yielding function over the process state, sender and input message

-> Dispatcher s 

As handleCallFrom but only runs the handler if the supplied Condition evaluates to True.

handleRpcChan :: forall s a b. (Serializable a, Serializable b) => (s -> SendPort b -> a -> Process (ProcessAction s)) -> Dispatcher s Source

Creates a handler for a typed channel RPC style interaction. The handler takes a SendPort b to reply to, the initial input and evaluates to a ProcessAction. It is the handler code's responsibility to send the reply to the SendPort.

handleRpcChanIf :: forall s a b. (Serializable a, Serializable b) => Condition s a -> (s -> SendPort b -> a -> Process (ProcessAction s)) -> Dispatcher s Source

As handleRpcChan, but only evaluates the handler if the supplied condition is met.

handleCast :: Serializable a => (s -> a -> Process (ProcessAction s)) -> Dispatcher s Source

Constructs a cast handler from an ordinary function in the Process monad. > handleCast = handleCastIf (const True)

handleCastIf Source

Arguments

:: Serializable a 
=> Condition s a

predicate that must be satisfied for the handler to run

-> (s -> a -> Process (ProcessAction s))

an action yielding function over the process state and input message

-> Dispatcher s 

Constructs a cast handler from an ordinary function in the Process monad. Given a function f :: (s -> a -> Process (ProcessAction s)), the expression handleCall f will yield a Dispatcher for inclusion in a Behaviour specification for the GenProcess.

handleInfo :: forall s a. Serializable a => (s -> a -> Process (ProcessAction s)) -> DeferredDispatcher s Source

Creates a generic input handler (i.e., for received messages that are not sent using the cast or call APIs) from an ordinary function in the Process monad.

handleRaw :: forall s. (s -> Message -> Process (ProcessAction s)) -> DeferredDispatcher s Source

Handle completely raw input messages.

handleDispatch :: forall s a. Serializable a => (s -> a -> Process (ProcessAction s)) -> Dispatcher s Source

Constructs a handler for both call and cast messages. handleDispatch = handleDispatchIf (const True)

handleDispatchIf :: forall s a. Serializable a => Condition s a -> (s -> a -> Process (ProcessAction s)) -> Dispatcher s Source

Constructs a handler for both call and cast messages. Messages are only dispatched to the handler if the supplied condition evaluates to True. Handlers defined in this way have no access to the call context (if one exists) and cannot therefore reply to calls.

handleExit :: forall s a. Serializable a => (s -> ProcessId -> a -> Process (ProcessAction s)) -> ExitSignalDispatcher s Source

Creates an exit handler scoped to the execution of any and all the registered call, cast and info handlers for the process.

handleExitIf :: forall s a. Serializable a => (s -> a -> Bool) -> (s -> ProcessId -> a -> Process (ProcessAction s)) -> ExitSignalDispatcher s Source

Stateless handlers

action Source

Arguments

:: Serializable a 
=> (a -> s -> Process (ProcessAction s))

a function from the input message to a stateless action, cf continue_

-> Dispatcher s 

Constructs an action handler. Like handleDispatch this can handle both cast and call messages, but you won't know which you're dealing with. This can be useful where certain inputs require a definite action, such as stopping the server, without concern for the state (e.g., when stopping we need only decide to stop, as the terminate handler can deal with state cleanup etc). For example:

action (MyCriticalSignal -> stop_ ExitNormal)

handleCall_ :: (Serializable a, Serializable b) => (a -> Process b) -> Dispatcher s Source

Constructs a call handler from a function in the Process monad. The handler expression returns the reply, and the action will be set to continue.

handleCall_ = handleCallIf_ $ input (const True)

handleCallIf_ Source

Arguments

:: (Serializable a, Serializable b) 
=> Condition s a

predicate that must be satisfied for the handler to run

-> (a -> Process b)

a function from an input message to a reply

-> Dispatcher s 

Constructs a call handler from an ordinary function in the Process monad. This variant ignores the state argument present in handleCall and handleCallIf and is therefore useful in a stateless server. Messges are only dispatched to the handler if the supplied condition evaluates to True

See handleCall

handleCallFrom_ :: forall s a b. (Serializable a, Serializable b) => (CallRef b -> a -> Process (ProcessReply b s)) -> Dispatcher s Source

A variant of handleCallFrom_ that ignores the state argument.

handleCallFromIf_ :: forall s a b. (Serializable a, Serializable b) => Condition s a -> (CallRef b -> a -> Process (ProcessReply b s)) -> Dispatcher s Source

A variant of handleCallFromIf that ignores the state argument.

handleRpcChan_ :: forall a b. (Serializable a, Serializable b) => (SendPort b -> a -> Process (ProcessAction ())) -> Dispatcher () Source

A variant of handleRpcChan that ignores the state argument.

handleRpcChanIf_ :: forall a b. (Serializable a, Serializable b) => Condition () a -> (SendPort b -> a -> Process (ProcessAction ())) -> Dispatcher () Source

A variant of handleRpcChanIf that ignores the state argument.

handleCast_ :: Serializable a => (a -> s -> Process (ProcessAction s)) -> Dispatcher s Source

Version of handleCast that ignores the server state.

handleCastIf_ Source

Arguments

:: Serializable a 
=> Condition s a

predicate that must be satisfied for the handler to run

-> (a -> s -> Process (ProcessAction s))

a function from the input message to a stateless action, cf continue_

-> Dispatcher s 

Version of handleCastIf that ignores the server state.

Working with Control Channels

handleControlChan Source

Arguments

:: Serializable a 
=> ControlChannel a

the receiving end of the control channel

-> (s -> a -> Process (ProcessAction s))

an action yielding function over the process state and input message

-> Dispatcher s 

Constructs a control channel handler from a function in the Process monad. The handler expression returns no reply, and the control message is treated in the same fashion as a cast.

handleControlChan = handleControlChanIf $ input (const True)

handleControlChan_ :: forall s a. Serializable a => ControlChannel a -> (a -> s -> Process (ProcessAction s)) -> Dispatcher s Source

Version of handleControlChan that ignores the server state.