Copyright | (c) Tim Watson 2012 - 2013 |
---|---|
License | BSD3 (see the file LICENSE) |
Maintainer | Tim Watson <watson.timothy@gmail.com> |
Stability | experimental |
Portability | non-portable (requires concurrency) |
Safe Haskell | None |
Language | Haskell98 |
The Server Portion of the Managed Process API.
- condition :: forall a b. (Serializable a, Serializable b) => (a -> b -> Bool) -> Condition a b
- state :: forall s m. Serializable m => (s -> Bool) -> Condition s m
- input :: forall s m. Serializable m => (m -> Bool) -> Condition s m
- reply :: Serializable r => r -> s -> Process (ProcessReply r s)
- replyWith :: Serializable r => r -> ProcessAction s -> Process (ProcessReply r s)
- noReply :: Serializable r => ProcessAction s -> Process (ProcessReply r s)
- continue :: s -> Process (ProcessAction s)
- timeoutAfter :: Delay -> s -> Process (ProcessAction s)
- hibernate :: TimeInterval -> s -> Process (ProcessAction s)
- stop :: ExitReason -> Process (ProcessAction s)
- stopWith :: s -> ExitReason -> Process (ProcessAction s)
- replyTo :: Serializable m => CallRef m -> m -> Process ()
- replyChan :: Serializable m => SendPort m -> m -> Process ()
- noReply_ :: forall s r. Serializable r => s -> Process (ProcessReply r s)
- haltNoReply_ :: Serializable r => ExitReason -> Process (ProcessReply r s)
- continue_ :: s -> Process (ProcessAction s)
- timeoutAfter_ :: Delay -> s -> Process (ProcessAction s)
- hibernate_ :: TimeInterval -> s -> Process (ProcessAction s)
- stop_ :: ExitReason -> s -> Process (ProcessAction s)
- handleCall :: (Serializable a, Serializable b) => (s -> a -> Process (ProcessReply b s)) -> Dispatcher s
- handleCallIf :: forall s a b. (Serializable a, Serializable b) => Condition s a -> (s -> a -> Process (ProcessReply b s)) -> Dispatcher s
- handleCallFrom :: forall s a b. (Serializable a, Serializable b) => (s -> CallRef b -> a -> Process (ProcessReply b s)) -> Dispatcher s
- handleCallFromIf :: forall s a b. (Serializable a, Serializable b) => Condition s a -> (s -> CallRef b -> a -> Process (ProcessReply b s)) -> Dispatcher s
- handleRpcChan :: forall s a b. (Serializable a, Serializable b) => (s -> SendPort b -> a -> Process (ProcessAction s)) -> Dispatcher s
- handleRpcChanIf :: forall s a b. (Serializable a, Serializable b) => Condition s a -> (s -> SendPort b -> a -> Process (ProcessAction s)) -> Dispatcher s
- handleCast :: Serializable a => (s -> a -> Process (ProcessAction s)) -> Dispatcher s
- handleCastIf :: forall s a. Serializable a => Condition s a -> (s -> a -> Process (ProcessAction s)) -> Dispatcher s
- handleInfo :: forall s a. Serializable a => (s -> a -> Process (ProcessAction s)) -> DeferredDispatcher s
- handleRaw :: forall s. (s -> Message -> Process (ProcessAction s)) -> DeferredDispatcher s
- handleDispatch :: forall s a. Serializable a => (s -> a -> Process (ProcessAction s)) -> Dispatcher s
- handleDispatchIf :: forall s a. Serializable a => Condition s a -> (s -> a -> Process (ProcessAction s)) -> Dispatcher s
- handleExit :: forall s a. Serializable a => (s -> ProcessId -> a -> Process (ProcessAction s)) -> ExitSignalDispatcher s
- handleExitIf :: forall s a. Serializable a => (s -> a -> Bool) -> (s -> ProcessId -> a -> Process (ProcessAction s)) -> ExitSignalDispatcher s
- action :: forall s a. Serializable a => (a -> s -> Process (ProcessAction s)) -> Dispatcher s
- handleCall_ :: (Serializable a, Serializable b) => (a -> Process b) -> Dispatcher s
- handleCallIf_ :: forall s a b. (Serializable a, Serializable b) => Condition s a -> (a -> Process b) -> Dispatcher s
- handleCallFrom_ :: forall s a b. (Serializable a, Serializable b) => (CallRef b -> a -> Process (ProcessReply b s)) -> Dispatcher s
- handleCallFromIf_ :: forall s a b. (Serializable a, Serializable b) => Condition s a -> (CallRef b -> a -> Process (ProcessReply b s)) -> Dispatcher s
- handleRpcChan_ :: forall a b. (Serializable a, Serializable b) => (SendPort b -> a -> Process (ProcessAction ())) -> Dispatcher ()
- handleRpcChanIf_ :: forall a b. (Serializable a, Serializable b) => Condition () a -> (SendPort b -> a -> Process (ProcessAction ())) -> Dispatcher ()
- handleCast_ :: Serializable a => (a -> s -> Process (ProcessAction s)) -> Dispatcher s
- handleCastIf_ :: forall s a. Serializable a => Condition s a -> (a -> s -> Process (ProcessAction s)) -> Dispatcher s
- handleControlChan :: forall s a. Serializable a => ControlChannel a -> (s -> a -> Process (ProcessAction s)) -> Dispatcher s
- handleControlChan_ :: forall s a. Serializable a => ControlChannel a -> (a -> s -> Process (ProcessAction s)) -> Dispatcher s
Server actions
condition :: forall a b. (Serializable a, Serializable b) => (a -> b -> Bool) -> Condition a b Source
state :: forall s m. Serializable m => (s -> Bool) -> Condition s m Source
input :: forall s m. Serializable m => (m -> Bool) -> Condition s m Source
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)
:: (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
.
:: (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)
:: 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
:: Serializable a | |
=> (a -> s -> Process (ProcessAction s)) | a function from the input message to a stateless action, cf |
-> 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
:: (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.
:: 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 |
-> Dispatcher s |
Version of handleCastIf
that ignores the server state.
Working with Control Channels
:: 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.