distributed-process-0.6.6: Cloud Haskell: Erlang-style concurrency in Haskell

Safe HaskellNone
LanguageHaskell98

Control.Distributed.Process.Internal.Types

Contents

Description

Types used throughout the Cloud Haskell framework

We collect all types used internally in a single module because many of these data types are mutually recursive and cannot be split across modules.

Synopsis

Node and process identifiers

newtype NodeId #

Node identifier

Constructors

NodeId 

Instances

Eq NodeId # 

Methods

(==) :: NodeId -> NodeId -> Bool #

(/=) :: NodeId -> NodeId -> Bool #

Data NodeId # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> NodeId -> c NodeId #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c NodeId #

toConstr :: NodeId -> Constr #

dataTypeOf :: NodeId -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c NodeId) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId) #

gmapT :: (forall b. Data b => b -> b) -> NodeId -> NodeId #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r #

gmapQ :: (forall d. Data d => d -> u) -> NodeId -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> NodeId -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> NodeId -> m NodeId #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> NodeId -> m NodeId #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> NodeId -> m NodeId #

Ord NodeId # 
Show NodeId # 
Generic NodeId # 

Associated Types

type Rep NodeId :: * -> * #

Methods

from :: NodeId -> Rep NodeId x #

to :: Rep NodeId x -> NodeId #

Binary NodeId # 

Methods

put :: NodeId -> Put #

get :: Get NodeId #

putList :: [NodeId] -> Put #

NFData NodeId # 

Methods

rnf :: NodeId -> () #

Hashable NodeId # 

Methods

hashWithSalt :: Int -> NodeId -> Int #

hash :: NodeId -> Int #

type Rep NodeId # 
type Rep NodeId = D1 (MetaData "NodeId" "Control.Distributed.Process.Internal.Types" "distributed-process-0.6.6-A1fQ9KY6QfxDk1QdVOPPHL" True) (C1 (MetaCons "NodeId" PrefixI True) (S1 (MetaSel (Just Symbol "nodeAddress") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 EndPointAddress)))

data LocalProcessId #

A local process ID consists of a seed which distinguishes processes from different instances of the same local node and a counter

Constructors

LocalProcessId 

Instances

Eq LocalProcessId # 
Data LocalProcessId # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> LocalProcessId -> c LocalProcessId #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c LocalProcessId #

toConstr :: LocalProcessId -> Constr #

dataTypeOf :: LocalProcessId -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c LocalProcessId) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LocalProcessId) #

gmapT :: (forall b. Data b => b -> b) -> LocalProcessId -> LocalProcessId #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r #

gmapQ :: (forall d. Data d => d -> u) -> LocalProcessId -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> LocalProcessId -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> LocalProcessId -> m LocalProcessId #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> LocalProcessId -> m LocalProcessId #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> LocalProcessId -> m LocalProcessId #

Ord LocalProcessId # 
Show LocalProcessId # 
Generic LocalProcessId # 

Associated Types

type Rep LocalProcessId :: * -> * #

Binary LocalProcessId # 
Hashable LocalProcessId # 
type Rep LocalProcessId # 
type Rep LocalProcessId = D1 (MetaData "LocalProcessId" "Control.Distributed.Process.Internal.Types" "distributed-process-0.6.6-A1fQ9KY6QfxDk1QdVOPPHL" False) (C1 (MetaCons "LocalProcessId" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "lpidUnique") SourceUnpack SourceStrict DecidedUnpack) (Rec0 Int32)) (S1 (MetaSel (Just Symbol "lpidCounter") SourceUnpack SourceStrict DecidedUnpack) (Rec0 Int32))))

data ProcessId #

Process identifier

Constructors

ProcessId 

Fields

Instances

Eq ProcessId # 
Data ProcessId # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ProcessId -> c ProcessId #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ProcessId #

toConstr :: ProcessId -> Constr #

dataTypeOf :: ProcessId -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c ProcessId) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProcessId) #

gmapT :: (forall b. Data b => b -> b) -> ProcessId -> ProcessId #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ProcessId -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ProcessId -> r #

gmapQ :: (forall d. Data d => d -> u) -> ProcessId -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ProcessId -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ProcessId -> m ProcessId #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ProcessId -> m ProcessId #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ProcessId -> m ProcessId #

Ord ProcessId # 
Show ProcessId # 
Generic ProcessId # 

Associated Types

type Rep ProcessId :: * -> * #

Binary ProcessId # 
NFData ProcessId # 

Methods

rnf :: ProcessId -> () #

Hashable ProcessId # 
type Rep ProcessId # 
type Rep ProcessId = D1 (MetaData "ProcessId" "Control.Distributed.Process.Internal.Types" "distributed-process-0.6.6-A1fQ9KY6QfxDk1QdVOPPHL" False) (C1 (MetaCons "ProcessId" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "processNodeId") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 NodeId)) (S1 (MetaSel (Just Symbol "processLocalId") SourceUnpack SourceStrict DecidedUnpack) (Rec0 LocalProcessId))))

data Identifier #

Union of all kinds of identifiers

Instances

Eq Identifier # 
Ord Identifier # 
Show Identifier # 
Generic Identifier # 

Associated Types

type Rep Identifier :: * -> * #

Binary Identifier # 
NFData Identifier # 

Methods

rnf :: Identifier -> () #

Hashable Identifier # 
type Rep Identifier # 
type Rep Identifier = D1 (MetaData "Identifier" "Control.Distributed.Process.Internal.Types" "distributed-process-0.6.6-A1fQ9KY6QfxDk1QdVOPPHL" False) ((:+:) (C1 (MetaCons "NodeIdentifier" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 NodeId))) ((:+:) (C1 (MetaCons "ProcessIdentifier" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 ProcessId))) (C1 (MetaCons "SendPortIdentifier" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 SendPortId)))))

Local nodes and processes

data LocalNode #

Local nodes

Constructors

LocalNode 

Fields

data ValidLocalNodeState #

Constructors

ValidLocalNodeState 

Fields

withValidLocalState :: LocalNode -> (ValidLocalNodeState -> IO r) -> IO r #

Wrapper around withMVar that checks that the local node is still in a valid state.

modifyValidLocalState :: LocalNode -> (ValidLocalNodeState -> IO (ValidLocalNodeState, a)) -> IO (Maybe a) #

Wrapper around modifyMVar that checks that the local node is still in a valid state.

modifyValidLocalState_ :: LocalNode -> (ValidLocalNodeState -> IO ValidLocalNodeState) -> IO () #

Wrapper around modifyMVar_ that checks that the local node is still in a valid state.

data Tracer #

Provides access to the trace controller

Constructors

Tracer 

Fields

data MxEventBus #

Local system management event bus state

Constructors

MxEventBusInitialising 
MxEventBus 

Fields

newtype Process a #

The Cloud Haskell Process type

Constructors

Process 

Instances

Monad Process # 

Methods

(>>=) :: Process a -> (a -> Process b) -> Process b #

(>>) :: Process a -> Process b -> Process b #

return :: a -> Process a #

fail :: String -> Process a #

Functor Process # 

Methods

fmap :: (a -> b) -> Process a -> Process b #

(<$) :: a -> Process b -> Process a #

MonadFix Process # 

Methods

mfix :: (a -> Process a) -> Process a #

Applicative Process # 

Methods

pure :: a -> Process a #

(<*>) :: Process (a -> b) -> Process a -> Process b #

(*>) :: Process a -> Process b -> Process b #

(<*) :: Process a -> Process b -> Process a #

MonadIO Process # 

Methods

liftIO :: IO a -> Process a #

MonadThrow Process # 

Methods

throwM :: Exception e => e -> Process a #

MonadCatch Process # 

Methods

catch :: Exception e => Process a -> (e -> Process a) -> Process a #

MonadMask Process # 

Methods

mask :: ((forall a. Process a -> Process a) -> Process b) -> Process b #

uninterruptibleMask :: ((forall a. Process a -> Process a) -> Process b) -> Process b #

MonadReader LocalProcess Process # 
Serializable b => MkTDict (Process b) # 

runLocalProcess :: LocalProcess -> Process a -> IO a #

Deconstructor for Process (not exported to the public API)

Typed channels

data SendPortId #

A send port is identified by a SendPortId.

You cannot send directly to a SendPortId; instead, use newChan to create a SendPort.

Constructors

SendPortId 

Fields

Instances

Eq SendPortId # 
Ord SendPortId # 
Show SendPortId # 
Generic SendPortId # 

Associated Types

type Rep SendPortId :: * -> * #

Binary SendPortId # 
NFData SendPortId # 

Methods

rnf :: SendPortId -> () #

Hashable SendPortId # 
type Rep SendPortId # 
type Rep SendPortId = D1 (MetaData "SendPortId" "Control.Distributed.Process.Internal.Types" "distributed-process-0.6.6-A1fQ9KY6QfxDk1QdVOPPHL" False) (C1 (MetaCons "SendPortId" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "sendPortProcessId") SourceUnpack SourceStrict DecidedUnpack) (Rec0 ProcessId)) (S1 (MetaSel (Just Symbol "sendPortLocalId") SourceUnpack SourceStrict DecidedUnpack) (Rec0 LocalSendPortId))))

data TypedChannel #

Constructors

Serializable a => TypedChannel (Weak (TQueue a)) 

newtype SendPort a #

The send send of a typed channel (serializable)

Constructors

SendPort 

Fields

Instances

Eq (SendPort a) # 

Methods

(==) :: SendPort a -> SendPort a -> Bool #

(/=) :: SendPort a -> SendPort a -> Bool #

Ord (SendPort a) # 

Methods

compare :: SendPort a -> SendPort a -> Ordering #

(<) :: SendPort a -> SendPort a -> Bool #

(<=) :: SendPort a -> SendPort a -> Bool #

(>) :: SendPort a -> SendPort a -> Bool #

(>=) :: SendPort a -> SendPort a -> Bool #

max :: SendPort a -> SendPort a -> SendPort a #

min :: SendPort a -> SendPort a -> SendPort a #

Show (SendPort a) # 

Methods

showsPrec :: Int -> SendPort a -> ShowS #

show :: SendPort a -> String #

showList :: [SendPort a] -> ShowS #

Generic (SendPort a) # 

Associated Types

type Rep (SendPort a) :: * -> * #

Methods

from :: SendPort a -> Rep (SendPort a) x #

to :: Rep (SendPort a) x -> SendPort a #

Serializable a => Binary (SendPort a) # 

Methods

put :: SendPort a -> Put #

get :: Get (SendPort a) #

putList :: [SendPort a] -> Put #

NFData a => NFData (SendPort a) # 

Methods

rnf :: SendPort a -> () #

Hashable a => Hashable (SendPort a) # 

Methods

hashWithSalt :: Int -> SendPort a -> Int #

hash :: SendPort a -> Int #

type Rep (SendPort a) # 
type Rep (SendPort a) = D1 (MetaData "SendPort" "Control.Distributed.Process.Internal.Types" "distributed-process-0.6.6-A1fQ9KY6QfxDk1QdVOPPHL" True) (C1 (MetaCons "SendPort" PrefixI True) (S1 (MetaSel (Just Symbol "sendPortId") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 SendPortId)))

newtype ReceivePort a #

The receive end of a typed channel (not serializable)

Note that ReceivePort implements Functor, Applicative, Alternative and Monad. This is especially useful when merging receive ports.

Constructors

ReceivePort 

Fields

Messages

data Message #

Messages consist of their typeRep fingerprint and their encoding

Instances

isEncoded :: Message -> Bool #

internal use only.

createMessage :: Serializable a => a -> Message #

Turn any serialiable term into a message

createUnencodedMessage :: Serializable a => a -> Message #

Turn any serializable term into an unencoded/local message

unsafeCreateUnencodedMessage :: Serializable a => a -> Message #

Turn any serializable term into an unencodede/local message, without evalutaing it! This is a dangerous business.

messageToPayload :: Message -> [ByteString] #

Serialize a message

payloadToMessage :: [ByteString] -> Message #

Deserialize a message

Node controller user-visible data types

data MonitorRef #

MonitorRef is opaque for regular Cloud Haskell processes

Constructors

MonitorRef 

Fields

Instances

data ProcessRegistrationException #

Exception thrown when a process attempts to register a process under an already-registered name or to unregister a name that hasn't been registered. Returns the name and the identifier of the process that owns it, if any.

data DiedReason #

Why did a process die?

Constructors

DiedNormal

Normal termination

DiedException !String

The process exited with an exception (provided as String because Exception does not implement Binary)

DiedDisconnect

We got disconnected from the process node

DiedNodeDown

The process node died

DiedUnknownId

Invalid (processnodechannel) identifier

newtype DidUnmonitor #

(Asynchronous) reply from unmonitor

Constructors

DidUnmonitor MonitorRef 

newtype DidUnlinkProcess #

(Asynchronous) reply from unlink

newtype DidUnlinkNode #

(Asynchronous) reply from unlinkNode

Constructors

DidUnlinkNode NodeId 

newtype DidUnlinkPort #

(Asynchronous) reply from unlinkPort

newtype SpawnRef #

SpawnRef are used to return pids of spawned processes

Constructors

SpawnRef Int32 

data DidSpawn #

(Asynchronius) reply from spawn

data WhereIsReply #

(Asynchronous) reply from whereis

data RegisterReply #

(Asynchronous) reply from register and unregister

Node controller internal data types

data NCMsg #

Messages to the node controller

Instances

Show NCMsg # 

Methods

showsPrec :: Int -> NCMsg -> ShowS #

show :: NCMsg -> String #

showList :: [NCMsg] -> ShowS #

Binary NCMsg # 

Methods

put :: NCMsg -> Put #

get :: Get NCMsg #

putList :: [NCMsg] -> Put #

Accessors

Utilities

forever' :: Monad m => m a -> m b #