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 module provides an extended process registry, offering slightly altered
semantics to the built in register
and unregister
primitives and a richer
set of features:
- Associate (unique) keys with a process or (unique key per-process) values
- Use any
Keyable
algebraic data type as keys - Query for process with matching keys values properties
- Atomically give away names
- Forceibly re-allocate names to/from a third party
- Subscribing To Registry Events
It is possible to monitor a registry for changes and be informed whenever changes take place. All subscriptions are key based, which means that you can subscribe to name or property changes for any process, so that any property changes matching the key you've subscribed to will trigger a notification (i.e., regardless of the process to which the property belongs).
The different types of event are defined by the KeyUpdateEvent
type.
Processes subscribe to registry events using monitorName
or its counterpart
monitorProperty
. If the operation succeeds, this will evaluate to an
opaque reference that can be used when subsequently handling incoming
notifications, which will be delivered to the subscriber's mailbox as
RegistryKeyMonitorNotification keyIdentity opaqueRef event
, where event
has the type KeyUpdateEvent
.
Subscribers can filter the types of event they receive by using the lower
level monitor
function (defined in this module - not the one defined
in distributed-process' Primitives
) and passing a list of filtering
KeyUpdateEventMask
. Without these filters in place, a monitor event will
be fired for every pertinent change.
- data KeyType
- data Key a = Key {}
- class (Show a, Eq a, Hashable a, Serializable a) => Keyable a
- data Registry k v = Registry {}
- start :: forall k v. (Keyable k, Serializable v) => Process (Registry k v)
- run :: forall k v. (Keyable k, Serializable v) => Registry k v -> Process ()
- addName :: forall k v. Keyable k => Registry k v -> k -> Process RegisterKeyReply
- addProperty :: (Keyable k, Serializable v) => Registry k v -> k -> v -> Process RegisterKeyReply
- registerName :: forall k v. Keyable k => Registry k v -> k -> ProcessId -> Process RegisterKeyReply
- registerValue :: (Resolvable b, Keyable k, Serializable v) => Registry k v -> b -> k -> v -> Process RegisterKeyReply
- giveAwayName :: forall k v. Keyable k => Registry k v -> k -> ProcessId -> Process ()
- data RegisterKeyReply
- unregisterName :: forall k v. Keyable k => Registry k v -> k -> Process UnregisterKeyReply
- data UnregisterKeyReply
- lookupName :: forall k v. Keyable k => Registry k v -> k -> Process (Maybe ProcessId)
- lookupProperty :: (Keyable k, Serializable v) => Registry k v -> k -> Process (Maybe v)
- registeredNames :: forall k v. Keyable k => Registry k v -> ProcessId -> Process [k]
- foldNames :: forall b k v. Keyable k => Registry k v -> b -> (b -> (k, ProcessId) -> Process b) -> Process b
- data SearchHandle k v
- member :: (Keyable k, Serializable v) => k -> SearchHandle k v -> Bool
- queryNames :: forall b k v. Keyable k => Registry k v -> (SearchHandle k ProcessId -> Process b) -> Process b
- findByProperty :: forall k v. Keyable k => Registry k v -> k -> Process [ProcessId]
- findByPropertyValue :: (Keyable k, Serializable v, Eq v) => Registry k v -> k -> v -> Process [ProcessId]
- monitor :: forall k v. Keyable k => Registry k v -> Key k -> Maybe [KeyUpdateEventMask] -> Process RegKeyMonitorRef
- monitorName :: forall k v. Keyable k => Registry k v -> k -> Process RegKeyMonitorRef
- monitorProp :: forall k v. Keyable k => Registry k v -> k -> ProcessId -> Process RegKeyMonitorRef
- unmonitor :: forall k v. Keyable k => Registry k v -> RegKeyMonitorRef -> Process ()
- await :: forall k v. Keyable k => Registry k v -> k -> Process (AwaitResult k)
- awaitTimeout :: forall k v. Keyable k => Registry k v -> Delay -> k -> Process (AwaitResult k)
- data AwaitResult k
- data KeyUpdateEventMask
- data KeyUpdateEvent
- = KeyRegistered { }
- | KeyUnregistered
- | KeyLeaseExpired
- | KeyOwnerDied {
- diedReason :: !DiedReason
- | KeyOwnerChanged {
- previousOwner :: !ProcessId
- newOwner :: !ProcessId
- data RegKeyMonitorRef
- data RegistryKeyMonitorNotification k = RegistryKeyMonitorNotification !k !RegKeyMonitorRef !KeyUpdateEvent !ProcessId
Registry Keys
Describes how a key will be used - for storing names or properties.
KeyTypeAlias | the key will refer to a name (i.e., named process) |
KeyTypeProperty | the key will refer to a (per-process) property |
A registered key. Keys can be mapped to names or (process-local) properties
in the registry. The keyIdentity
holds the key's value (e.g., a string or
similar simple data type, which must provide a Keyable
instance), whilst
the keyType
and keyScope
describe the key's intended use and ownership.
class (Show a, Eq a, Hashable a, Serializable a) => Keyable a Source
The Keyable
class describes types that can be used as registry keys.
The constraints ensure that the key can be stored and compared appropriately.
Defining / Starting A Registry
A phantom type, used to parameterise registry startup with the required key and value types.
Registration / Unregistration
addName :: forall k v. Keyable k => Registry k v -> k -> Process RegisterKeyReply Source
Associate the calling process with the given (unique) key.
addProperty :: (Keyable k, Serializable v) => Registry k v -> k -> v -> Process RegisterKeyReply Source
Associate the given (non-unique) property with the current process. If the property already exists, it will be overwritten with the new value.
registerName :: forall k v. Keyable k => Registry k v -> k -> ProcessId -> Process RegisterKeyReply Source
Register the item at the given address.
registerValue :: (Resolvable b, Keyable k, Serializable v) => Registry k v -> b -> k -> v -> Process RegisterKeyReply Source
Register an item at the given address and associate it with a value. If the property already exists, it will be overwritten with the new value.
giveAwayName :: forall k v. Keyable k => Registry k v -> k -> ProcessId -> Process () Source
Atomically transfer a (registered) name to another process. Has no effect if the name does is not registered to the calling process!
data RegisterKeyReply Source
The (return) value of an attempted registration.
RegisteredOk | The given key was registered successfully |
AlreadyRegistered | The key was already registered |
unregisterName :: forall k v. Keyable k => Registry k v -> k -> Process UnregisterKeyReply Source
Un-register a (unique) name for the calling process.
data UnregisterKeyReply Source
The result of an un-registration attempt.
UnregisterOk | The given key was successfully unregistered |
UnregisterInvalidKey | The given key was invalid and could not be unregistered |
UnregisterKeyNotFound | The given key was not found (i.e., was not registered) |
Queries / Lookups
lookupName :: forall k v. Keyable k => Registry k v -> k -> Process (Maybe ProcessId) Source
Lookup the process identified by the supplied key. Evaluates to
Nothing
if the key is not registered.
lookupProperty :: (Keyable k, Serializable v) => Registry k v -> k -> Process (Maybe v) Source
Lookup the value of a named property for the calling process. Evaluates to
Nothing
if the property (key) is not registered. If the assignment to a
value of type v
does not correspond to the type of properties stored by
the registry, the calling process will exit with the reason set to
InvalidPropertyType
.
registeredNames :: forall k v. Keyable k => Registry k v -> ProcessId -> Process [k] Source
Obtain a list of all registered keys.
foldNames :: forall b k v. Keyable k => Registry k v -> b -> (b -> (k, ProcessId) -> Process b) -> Process b Source
Monadic left fold over all registered names/keys. The fold takes place in the evaluating process.
data SearchHandle k v Source
Keyable k => Functor (SearchHandle k) Source | |
Keyable k => Foldable (SearchHandle k) Source |
member :: (Keyable k, Serializable v) => k -> SearchHandle k v -> Bool Source
Tests whether or not the supplied key is registered, evaluated in the calling process.
queryNames :: forall b k v. Keyable k => Registry k v -> (SearchHandle k ProcessId -> Process b) -> Process b Source
Evaluate a query on a SearchHandle
, in the calling process.
findByPropertyValue :: (Keyable k, Serializable v, Eq v) => Registry k v -> k -> v -> Process [ProcessId] Source
Monitoring / Waiting
monitor :: forall k v. Keyable k => Registry k v -> Key k -> Maybe [KeyUpdateEventMask] -> Process RegKeyMonitorRef Source
Low level monitor operation. For the given key, set up a monitor
filtered by any KeyUpdateEventMask
entries that are supplied.
monitorName :: forall k v. Keyable k => Registry k v -> k -> Process RegKeyMonitorRef Source
Monitor changes to the supplied name.
monitorProp :: forall k v. Keyable k => Registry k v -> k -> ProcessId -> Process RegKeyMonitorRef Source
Monitor changes to the supplied (property) key.
unmonitor :: forall k v. Keyable k => Registry k v -> RegKeyMonitorRef -> Process () Source
Remove a previously set monitor.
await :: forall k v. Keyable k => Registry k v -> k -> Process (AwaitResult k) Source
Await registration of a given key. This function will subsequently block the evaluating process until the key is registered and a registration event is dispatched to the caller's mailbox.
awaitTimeout :: forall k v. Keyable k => Registry k v -> Delay -> k -> Process (AwaitResult k) Source
Await registration of a given key, but give up and return AwaitTimeout
if registration does not take place within the specified time period (delay
).
data AwaitResult k Source
The result of an await
operation.
RegisteredName !ProcessId !k | The name was registered |
ServerUnreachable !DiedReason | The server was unreachable (or died) |
AwaitTimeout | The operation timed out |
Eq k => Eq (AwaitResult k) Source | |
Show k => Show (AwaitResult k) Source | |
Generic (AwaitResult k) Source | |
Keyable k => Binary (AwaitResult k) Source | |
type Rep (AwaitResult k) Source |
data KeyUpdateEventMask Source
Used to describe a subset of monitoring events to listen for.
OnKeyRegistered | receive an event when a key is registered |
OnKeyUnregistered | receive an event when a key is unregistered |
OnKeyOwnershipChange | receive an event when a key's owner changes |
OnKeyLeaseExpiry | receive an event when a key's lease expires |
data KeyUpdateEvent Source
Provides information about a key monitoring event.
data RegKeyMonitorRef Source
An opaque reference used for matching monitoring events. See
RegistryKeyMonitorNotification
for more details.
data RegistryKeyMonitorNotification k Source
This message is delivered to processes which are monioring a
registry key. The opaque monitor reference will match (i.e., be equal
to) the reference returned from the monitor
function, which the
KeyUpdateEvent
describes the change that took place.
Keyable k => Eq (RegistryKeyMonitorNotification k) Source | |
Keyable k => Show (RegistryKeyMonitorNotification k) Source | |
Generic (RegistryKeyMonitorNotification k) Source | |
Keyable k => Binary (RegistryKeyMonitorNotification k) Source | |
type Rep (RegistryKeyMonitorNotification k) Source |