Safe Haskell | None |
---|---|
Language | Haskell2010 |
This package defines a wrapper over the sessiontypes library that allows for evaluating session typed programs to Cloud Haskell programs.
The goal of this library is to allow a user to define two dual session typed programs, spawn two processes and have these processes evaluate the programs.
Session types guarantee that the resulting Cloud Haskell programs correctly implement the protocol and that they are non-deadlocking.
We define a session typed program with an indexed monad Session
that is both a reader monad and a wrapper over a STTerm
that uses Process
as its underlying monad.
This module exports the most important parts of this library:
- Control.Distributed.Session.Session: Defines the
Session
monad andSessionInfo
that is used as the environment ofSession
. - Control.Distributed.Session.Eval: Defines the interpreter for evaluation a
Session
to aProcess
. - Control.Distributed.Session.Spawn: Defines several combinators for spawning sessions.
- Control.Distributed.Session.Closure: Module for constructing closures of sessions.
- Control.Distributed.Session.STChannel: Session typed channel that allows for transmitting values of different types.
- Control.Distributed.Session.Lifted: Exports lifted functions from the distributed-process package.
Additionally we defined wrappers for using the interpreters defined in the sessiontypes package on a Session
:
- module Control.SessionTypes
- newtype Session s r a = Session {
- runSessionC :: Maybe SessionInfo -> IxC Process s r a
- data SessionInfo = SessionInfo {}
- runSession :: Session s r a -> Maybe SessionInfo -> STTerm Process s r a
- liftP :: Process a -> Session s s a
- liftST :: STTerm Process s r a -> Session s r a
- callLocalSessionP :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Process (a, ProcessId)
- callLocalSession :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Session k k (a, ProcessId)
- callRemoteSessionP :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (SpawnSession a ()) -> Process (a, ProcessId)
- callRemoteSession :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (SpawnSession a ()) -> Session k k (a, ProcessId)
- callRemoteSessionP' :: NodeId -> Closure (SpawnSession () ()) -> Process ProcessId
- callRemoteSession' :: NodeId -> Closure (SpawnSession () ()) -> Session s s ProcessId
- spawnLLSessionP :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Process (ProcessId, ProcessId)
- spawnLLSession :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Session t t (ProcessId, ProcessId)
- spawnLRSessionP :: NodeId -> Closure (SpawnSession () ()) -> Process (ProcessId, ProcessId)
- spawnLRSession :: NodeId -> Closure (SpawnSession () ()) -> Session s s (ProcessId, ProcessId)
- spawnRRSessionP :: NodeId -> NodeId -> Closure (SpawnSession () ()) -> Process (ProcessId, ProcessId)
- spawnRRSession :: NodeId -> NodeId -> Closure (SpawnSession () ()) -> Session s s (ProcessId, ProcessId)
- evalSession :: forall s r a. HasConstraint Serializable s => Session s r a -> SessionInfo -> Process a
- evalSessionEq :: Session s s a -> Process a
- evalSessionEq' :: Session s s a -> SessionInfo -> Process a
- data SpawnSession a b where
- SpawnSession :: (HasConstraintST Serializable s, HasConstraintST Serializable (DualST s), Typeable a, Typeable b) => Session (Cap '[] s) r a -> Session (Cap '[] (DualST s)) r b -> SpawnSession a b
- data SessionWrap a where
- SessionWrap :: Session s s a -> SessionWrap a
- sessionRemoteTable :: RemoteTable -> RemoteTable
- remoteSessionStatic :: Static (SerializableDict a -> Closure (SessionWrap a) -> Process a)
- remoteSessionClosure :: Static (SerializableDict a) -> Closure (SessionWrap a) -> Closure (Process a)
- remoteSessionStatic' :: Static (Closure (SessionWrap ()) -> Process ())
- remoteSessionClosure' :: Closure (SessionWrap ()) -> Closure (Process ())
- spawnChannelStatic :: Static (SerializableDict a -> Closure (ReceivePort a -> SessionWrap ()) -> ReceivePort a -> Process ())
- spawnChannelClosure :: Static (SerializableDict a) -> Closure (ReceivePort a -> SessionWrap ()) -> Closure (ReceivePort a -> Process ())
- evalLocalSession :: Typeable a => (ProcessId, NodeId, Closure (SpawnSession a ())) -> Process a
- remoteSpawnSessionStatic :: Static (SerializableDict a -> (ProcessId, NodeId, Closure (SpawnSession a ())) -> Process ())
- remoteSpawnSessionClosure :: Static (SerializableDict a) -> (ProcessId, NodeId, Closure (SpawnSession a ())) -> Closure (Process ())
- remoteSpawnSessionStatic' :: Static ((ProcessId, NodeId, Closure (SpawnSession () ())) -> Process ())
- remoteSpawnSessionClosure' :: (ProcessId, NodeId, Closure (SpawnSession () ())) -> Closure (Process ())
- rrSpawnSessionSendStatic :: Static ((ProcessId, NodeId, Closure (SpawnSession () ())) -> Process ())
- rrSpawnSessionSendClosure :: (ProcessId, NodeId, Closure (SpawnSession () ())) -> Closure (Process ())
- rrSpawnSessionExpectStatic :: Static ((NodeId, Closure (SpawnSession () ())) -> Process ())
- rrSpawnSessionExpectClosure :: (NodeId, Closure (SpawnSession () ())) -> Closure (Process ())
- data Message = Serializable a => Message a
- data STSendPort l = STSendPort (SendPort Message)
- data STReceivePort l = STReceivePort (ReceivePort Message)
- type STChan s = (STSendPort (RemoveRecv s), STReceivePort (RemoveSend s))
- type STChanBi s r = (STSendPort (RemoveRecv s), STReceivePort (RemoveSend r))
- type UTChan = (SendPort Message, ReceivePort Message)
- newSTChan :: Proxy s -> Process (STChan s)
- newSTChanBi :: Proxy s -> Proxy r -> Process (STChanBi s r)
- newUTChan :: Process UTChan
- toSTChan :: UTChan -> Proxy s -> STChan s
- toSTChanBi :: UTChan -> Proxy s -> Proxy r -> STChanBi s r
- sendProxy :: STSendPort s -> Proxy s
- recvProxy :: STReceivePort s -> Proxy s
- sendSTChan :: Serializable a => STSendPort (Cap ctx (a :!> l)) -> a -> Process (STSendPort (Cap ctx l))
- recvSTChan :: Serializable a => STReceivePort (Cap ctx (a :?> l)) -> Process (a, STReceivePort (Cap ctx l))
- class STSplit m where
- class STRec m where
- data STChannelT m p q a = STChannelT {
- runSTChannelT :: (STSendPort (Left p), STReceivePort (Right p)) -> m (a, (STSendPort (Left q), STReceivePort (Right q)))
- sendSTChanM :: Serializable a => a -> STChannelT Process (Cap ctx (a :!> l) :*: r) (Cap ctx l :*: r) ()
- recvSTChanM :: Serializable a => STChannelT Process (l :*: Cap ctx (a :?> r)) (l :*: Cap ctx r) a
- sel1ChanM :: STChannelT Process (Cap lctx (Sel (l ': ls)) :*: Cap rctx (Sel (r ': rs))) (Cap lctx l :*: Cap rctx r) ()
- sel2ChanM :: STChannelT Process (Cap lctx (Sel (s1 ': (t1 ': xs1))) :*: Cap rctx (Sel (s2 ': (t2 ': xs2)))) (Cap lctx (Sel (t1 ': xs1)) :*: Cap rctx (Sel (t2 ': xs2))) ()
- off1ChanM :: STChannelT Process (Cap lctx (Off (l ': ls)) :*: Cap rctx (Off (r ': rs))) (Cap lctx l :*: Cap rctx r) ()
- off2ChanM :: STChannelT Process (Cap lctx (Off (s1 ': (t1 ': xs1))) :*: Cap rctx (Off (s2 ': (t2 ': xs2)))) (Cap lctx (Off (t1 ': xs1)) :*: Cap rctx (Off (t2 ': xs2))) ()
- recChanM :: STChannelT Process (Cap sctx (R s) :*: Cap rctx (R r)) (Cap (s ': sctx) s :*: Cap (r ': rctx) r) ()
- wkChanM :: STChannelT Process (Cap (t ': sctx) (Wk s) :*: Cap (k ': rctx) (Wk r)) (Cap sctx s :*: Cap rctx r) ()
- varChanM :: STChannelT Process (Cap (s ': sctx) V :*: Cap (r ': rctx) V) (Cap (s ': sctx) s :*: Cap (r ': rctx) r) ()
- epsChanM :: STChannelT Process (Cap ctx Eps :*: Cap ctx Eps) (Cap ctx Eps :*: Cap ctx Eps) ()
- utsend :: Serializable a => ProcessId -> a -> Session s s ()
- usend :: Serializable a => ProcessId -> a -> Session s s ()
- expect :: Serializable a => Session s s a
- expectTimeout :: Serializable a => Int -> Session s s (Maybe a)
- newChan :: Serializable a => Session s s (SendPort a, ReceivePort a)
- sendChan :: Serializable a => SendPort a -> a -> Session s s ()
- receiveChan :: Serializable a => ReceivePort a -> Session s s a
- receiveChanTimeout :: Serializable a => Int -> ReceivePort a -> Session s s (Maybe a)
- mergePortsBiased :: Serializable a => [ReceivePort a] -> Session s s (ReceivePort a)
- mergePortsRR :: Serializable a => [ReceivePort a] -> Session s s (ReceivePort a)
- unsafeSend :: Serializable a => ProcessId -> a -> Session s s ()
- unsafeSendChan :: Serializable a => SendPort a -> a -> Session s s ()
- unsafeNSend :: Serializable a => String -> a -> Session s s ()
- unsafeNSendRemote :: Serializable a => NodeId -> String -> a -> Session s s ()
- receiveWait :: [Match b] -> Session s s b
- receiveTimeout :: Int -> [Match b] -> Session s s (Maybe b)
- unwrapMessage :: Serializable a => Message -> Session s s (Maybe a)
- handleMessage :: Serializable a => Message -> (a -> Session s s b) -> Session r r (Maybe b)
- handleMessage_ :: Serializable a => Message -> (a -> Session s s ()) -> Session r r ()
- handleMessageP :: Serializable a => Message -> (a -> Process b) -> Session s s (Maybe b)
- handleMessageP_ :: Serializable a => Message -> (a -> Process ()) -> Session s s ()
- handleMessageIf :: Serializable a => Message -> (a -> Bool) -> (a -> Session s s b) -> Session r r (Maybe b)
- handleMessageIf_ :: Serializable a => Message -> (a -> Bool) -> (a -> Session s s ()) -> Session r r ()
- handleMessageIfP :: Serializable a => Message -> (a -> Bool) -> (a -> Process b) -> Session s s (Maybe b)
- handleMessageIfP_ :: Serializable a => Message -> (a -> Bool) -> (a -> Process ()) -> Session s s ()
- forward :: Message -> ProcessId -> Session s s ()
- uforward :: Message -> ProcessId -> Session s s ()
- delegate :: ProcessId -> (Message -> Bool) -> Session s s ()
- relay :: ProcessId -> Session s s ()
- proxy :: Serializable a => ProcessId -> (a -> Session s s Bool) -> Session r r ()
- proxyP :: Serializable a => ProcessId -> (a -> Process Bool) -> Session s s ()
- spawn :: NodeId -> Closure (SessionWrap ()) -> Session s s ProcessId
- spawnP :: NodeId -> Closure (Process ()) -> Session s s ProcessId
- call :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (SessionWrap a) -> Session r r a
- callP :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (Process a) -> Session s s a
- terminate :: Session s s a
- die :: Serializable a => a -> Session s s b
- kill :: ProcessId -> String -> Session s s ()
- exit :: Serializable a => ProcessId -> a -> Session s s ()
- catchExit :: (Show a, Serializable a) => Session s s b -> (ProcessId -> a -> Session r r b) -> Session t t b
- catchExitP :: (Show a, Serializable a) => Process b -> (ProcessId -> a -> Process b) -> Session s s b
- catchesExit :: Session s s b -> [ProcessId -> Message -> Session r r (Maybe b)] -> Session t t b
- catchesExitP :: Process b -> [ProcessId -> Message -> Process (Maybe b)] -> Session s s b
- getSelfPid :: Session s s ProcessId
- getSelfNode :: Session s s NodeId
- getOthPid :: Session s s (Maybe ProcessId)
- getOthNode :: Session s s (Maybe NodeId)
- getProcessInfo :: ProcessId -> Session s s (Maybe ProcessInfo)
- getNodeStats :: NodeId -> Session s s (Either DiedReason NodeStats)
- link :: ProcessId -> Session s s ()
- linkNode :: NodeId -> Session s s ()
- unlink :: ProcessId -> Session s s ()
- unlinkNode :: NodeId -> Session s s ()
- monitor :: ProcessId -> Session s s MonitorRef
- monitorNode :: NodeId -> Session s s MonitorRef
- monitorPort :: Serializable a => SendPort a -> Session s s MonitorRef
- unmonitor :: MonitorRef -> Session s s ()
- withMonitor :: ProcessId -> (MonitorRef -> Session s s a) -> Session r r a
- withMonitor_ :: ProcessId -> Session s s a -> Session r r a
- withMonitorP :: ProcessId -> (MonitorRef -> Process a) -> Session s s a
- withMonitorP_ :: ProcessId -> Process a -> Session s s a
- unStatic :: Typeable a => Static a -> Session s s a
- unClosure :: Typeable a => Closure a -> Session s s a
- say :: String -> Session s s ()
- register :: String -> ProcessId -> Session s s ()
- unregister :: String -> Session s s ()
- whereis :: String -> Session s s (Maybe ProcessId)
- nsend :: Serializable a => String -> a -> Session s s ()
- registerRemoteAsync :: NodeId -> String -> ProcessId -> Session s s ()
- reregisterRemoteAsync :: NodeId -> String -> ProcessId -> Session s s ()
- whereisRemoteAsync :: NodeId -> String -> Session s s ()
- nsendRemote :: Serializable a => NodeId -> String -> a -> Session s s ()
- spawnAsync :: NodeId -> Closure (SessionWrap ()) -> Session r r SpawnRef
- spawnAsyncP :: NodeId -> Closure (Process ()) -> Session s s SpawnRef
- spawnSupervised :: NodeId -> Closure (SessionWrap ()) -> Session s s (ProcessId, MonitorRef)
- spawnSupervisedP :: NodeId -> Closure (Process ()) -> Session s s (ProcessId, MonitorRef)
- spawnLink :: NodeId -> Closure (SessionWrap ()) -> Session s s ProcessId
- spawnLinkP :: NodeId -> Closure (Process ()) -> Session s s ProcessId
- spawnMonitor :: NodeId -> Closure (SessionWrap ()) -> Session s s (ProcessId, MonitorRef)
- spawnMonitorP :: NodeId -> Closure (Process ()) -> Session s s (ProcessId, MonitorRef)
- spawnChannel :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (ReceivePort a -> SessionWrap ()) -> Session s s (SendPort a)
- spawnChannelP :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (ReceivePort a -> Process ()) -> Session s s (SendPort a)
- spawnLocal :: Session s s () -> Session r r ProcessId
- spawnLocalP :: Process () -> Session s s ProcessId
- spawnChannelLocal :: Serializable a => (ReceivePort a -> Session s s ()) -> Session r r (SendPort a)
- spawnChannelLocalP :: Serializable a => (ReceivePort a -> Process ()) -> Session s s (SendPort a)
- callLocal :: Session s s a -> Session s s a
- callLocalP :: Process a -> Session s s a
- reconnect :: ProcessId -> Session s s ()
- reconnectPort :: SendPort a -> Session s s ()
Core
module Control.SessionTypes
Session
Data types
newtype Session s r a Source #
Session
is defined as a newtype wrapper over a function that takes a `Maybe SessionInfo` and returns an indexed codensity monad transformer over the Process
monad.
Session
is also a reader monad that has a Maybe SessionInfo as its environment. SessionInfo
is wrapped in a Maybe
, because we also allow a session to be run singularly.
In which case there is no other Session to communicate with and therefore is there also no need for a SessionInfo
.
The function returns the indexed codensity monad and not simply a STTerm
, because from benchmarking the codensity monad gave us significant performance improvements for free.
Session | |
|
data SessionInfo Source #
The SessionInfo data type tells us information about another Session
. Namely, the Session
that is in a session with the Session
that this specific SessionInfo
belongs to.
runSession :: Session s r a -> Maybe SessionInfo -> STTerm Process s r a Source #
Evaluates a session to a STTerm
Lifting
Spawning sessions
Call
callLocalSessionP :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Process (a, ProcessId) Source #
callLocalSession :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Session k k (a, ProcessId) Source #
Sessioned version of callLocalSessionP
callRemoteSessionP :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (SpawnSession a ()) -> Process (a, ProcessId) Source #
Calls a remote session consisting of two dual Session
s.
Spawns a remote process for the second Session
and runs the first Session
on the current process.
Returns the result of the frist Session
and the ProcessId
of the second Session
.
The arguments of this function are described as follows:
- Static (SerializableDict a): Describes how to serialize a value of type
a
- NodeId: The node identifier of the node that the second
Session
should be spawned to. - Closure (SpawnSession a ()): A closure of a wrapper over two dual
Session
s.
Requires sessionRemoteTable
callRemoteSession :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (SpawnSession a ()) -> Session k k (a, ProcessId) Source #
Sessioned version of callRemoteSession
Requires sessionRemoteTable
callRemoteSessionP' :: NodeId -> Closure (SpawnSession () ()) -> Process ProcessId Source #
Same as callRemoteSessionP
, but we no longer need to provide a static serializable dictionary, because the result type of the first session is unit.
Requires sessionRemoteTable
callRemoteSession' :: NodeId -> Closure (SpawnSession () ()) -> Session s s ProcessId Source #
Sessioned version of callRemoteSessionP'
Requires sessionRemoteTable
Spawn
spawnLLSessionP :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Process (ProcessId, ProcessId) Source #
spawnLLSession :: (HasConstraint Serializable s, HasConstraint Serializable (Dual s)) => Session s r a -> Session (Dual s) r b -> Session t t (ProcessId, ProcessId) Source #
Sessioned version of spawnLLSession
spawnLRSessionP :: NodeId -> Closure (SpawnSession () ()) -> Process (ProcessId, ProcessId) Source #
Spawns one Session
local and spawns another Session
remote.
Returns the ProcessId
of both spawned processes.
The arguments are described as follows:
- NodeId: The node identifier of the node that the second
Session
should be spawned to. - Closure (SpawnSession () ()): A closure of a wrapper over two dual
Session
s.
Requires sessionRemoteTable
spawnLRSession :: NodeId -> Closure (SpawnSession () ()) -> Session s s (ProcessId, ProcessId) Source #
Sessioned version of spawnLRSessionP
Requires sessionRemoteTable
spawnRRSessionP :: NodeId -> NodeId -> Closure (SpawnSession () ()) -> Process (ProcessId, ProcessId) Source #
Spawns a remote session. Both Session
arguments are spawned remote.
Returns the ProcessId
of both spawned processes.
The arguments are described as follows:
- NodeId: The node identifier of the node that the first
Session
should be spawned to. - NodeId: The node identifier of the node that the second
Session
should be spawned to. - Closure (SpawnSession () ()): A closure of a wrapper over two dual
Session
s.
Requires sessionRemoteTable
spawnRRSession :: NodeId -> NodeId -> Closure (SpawnSession () ()) -> Session s s (ProcessId, ProcessId) Source #
Sessioned version of SpawnRRSession
Requires sessionRemoteTable
Eval
evalSession :: forall s r a. HasConstraint Serializable s => Session s r a -> SessionInfo -> Process a Source #
This function unpacks a Session
to a STTerm
using a given SessionInfo
.
It then evaluates the STTerm
by mapping Cloud Haskell semantics to each constructor of STTerm
.
The function relies on that there exists another session (on a different process) that is also being evaluated (using evalSession) and acts as the dual the session that function is now evaluating.
The underlying communication method is a session typed channel (STChannelT
). There should be no interference from other processes, unless
you go through the effort of sharing the send port.
evalSessionEq :: Session s s a -> Process a Source #
Similar to evalSession
, except for that it does not evaluate session typed actions.
Only returns and lifted computations are evaluated. This also means that there does not need to be a dual session that is evaluated on a different process.
It also assumes that SessionInfo
is not used. Use evalSessionEq'
if this is not the case.
evalSessionEq' :: Session s s a -> SessionInfo -> Process a Source #
Same as evalSessionEq
, but you may now provide a SessionInfo
.
Closures
Encapsulation
data SpawnSession a b where Source #
Data type that encapsulates two sessions for the purpose of remotely spawning them
The session types of the sessions are existentially quantified, but we still ensure duality and constrain them properly, such that they can be passed to evalSession
.
SpawnSession :: (HasConstraintST Serializable s, HasConstraintST Serializable (DualST s), Typeable a, Typeable b) => Session (Cap '[] s) r a -> Session (Cap '[] (DualST s)) r b -> SpawnSession a b |
data SessionWrap a where Source #
Data type that encapsulates a single session performing no session typed action that can be remotely spawned.
We use this data type mostly for convenience in combination with evalSessionEq
allowing us to avoid the Serializable
constraint.
SessionWrap :: Session s s a -> SessionWrap a |
RemoteTable
sessionRemoteTable :: RemoteTable -> RemoteTable Source #
RemoteTable that binds all in this module defined static functions to their corresponding evaluation functions.
Static and Closures
Singular
remoteSessionStatic :: Static (SerializableDict a -> Closure (SessionWrap a) -> Process a) Source #
Static function for remotely spawning a single session
When remotely spawning any session we must always pass it the ProcessId
and NodeId
of the spawning process.
We must pass a Closure of a SessionWrap
instead of just a SessionWrap
, because that would require
serializing a SessionWrap
which is not possible.
Furthermore, we must also pass a SerializableDict
that shows how to serialize a value of type a
.
remoteSessionClosure :: Static (SerializableDict a) -> Closure (SessionWrap a) -> Closure (Process a) Source #
Closure function for remotely spawning a single session
remoteSessionStatic' :: Static (Closure (SessionWrap ()) -> Process ()) Source #
Same as remoteSessionStatic
, except that we do not need to provide a SerializableDict
.
remoteSessionClosure' :: Closure (SessionWrap ()) -> Closure (Process ()) Source #
Same as remoteSessionClosure
, except that we do not need to provide a SerializableDict
.
SpawnChannel
spawnChannelStatic :: Static (SerializableDict a -> Closure (ReceivePort a -> SessionWrap ()) -> ReceivePort a -> Process ()) Source #
A static function specific to the lifted spawnChannel
function that can be found in Control.Distributed.Session.Lifted
spawnChannelClosure :: Static (SerializableDict a) -> Closure (ReceivePort a -> SessionWrap ()) -> Closure (ReceivePort a -> Process ()) Source #
A closure specific to the lifted spawnChannel
function that can be found in Control.Distributed.Session.Lifted
Local Remote Evaluation
evalLocalSession :: Typeable a => (ProcessId, NodeId, Closure (SpawnSession a ())) -> Process a Source #
Function that evalutes the first argument of a SpawnSession
in a local manner.
It is local in that we do not create an accompanying closure.
remoteSpawnSessionStatic :: Static (SerializableDict a -> (ProcessId, NodeId, Closure (SpawnSession a ())) -> Process ()) Source #
Static function for remotely evaluating the second argument of a SpawnSession
.
This function works dually to evalLocalSession
.
remoteSpawnSessionClosure :: Static (SerializableDict a) -> (ProcessId, NodeId, Closure (SpawnSession a ())) -> Closure (Process ()) Source #
Closure for remotely evaluating the second argument of a SpawnSession
remoteSpawnSessionStatic' :: Static ((ProcessId, NodeId, Closure (SpawnSession () ())) -> Process ()) Source #
Same as remoteSpawnSessionStatic
, except for that we do not need to provide a SerializableDict
.
remoteSpawnSessionClosure' :: (ProcessId, NodeId, Closure (SpawnSession () ())) -> Closure (Process ()) Source #
Same as remoteSpawnSessionClosure
, except for that we do not need to provide a SerializableDict
.
Remote Remote Evaluation
rrSpawnSessionSendStatic :: Static ((ProcessId, NodeId, Closure (SpawnSession () ())) -> Process ()) Source #
Static function for remotely evaluating the second argument of a SpawnSession
This function is very similar to remoteSpawnSessionStatic'
. The difference is that this function assumes that
the other session was also remotely spawned.
Therefore we require an extra send of the ProcessId
of the to be spawned process.
rrSpawnSessionSendClosure :: (ProcessId, NodeId, Closure (SpawnSession () ())) -> Closure (Process ()) Source #
Closure for remotely evaluating the second argument of a SpawnSession
.
rrSpawnSessionExpectStatic :: Static ((NodeId, Closure (SpawnSession () ())) -> Process ()) Source #
Closure for remotely evaluating the first argument of a SpawnSession
This function acts dual to rrSpawnSessionSend
and assumes that it will first receive a ProcessId
.
rrSpawnSessionExpectClosure :: (NodeId, Closure (SpawnSession () ())) -> Closure (Process ()) Source #
Closure for remotely evaluating the first argument of a SpawnSession
.
STChannel
Data types
Basic message type that existentially quantifies the content of the message
Serializable a => Message a |
data STSendPort l Source #
Session typed send port as a wrapper over SendPort Message. It is parameterized with a capability/sessiontype.
data STReceivePort l Source #
Session typed receive port as a wrapper over ReceivePort Message. It is parameterized with a capability/sessiontype.
Type synonyms
type STChan s = (STSendPort (RemoveRecv s), STReceivePort (RemoveSend s)) Source #
Type synonym for a session typed channel given a single session type
This removes recv session types from the given session type as it is passed to the send port type
Also removes send session types from the given session type as it is passed to the receive port type
type STChanBi s r = (STSendPort (RemoveRecv s), STReceivePort (RemoveSend r)) Source #
Same as STChan
, but it is given a session type for the send port type and a separate session type for the receive port type
Create
newSTChan :: Proxy s -> Process (STChan s) Source #
Creates a new session typed channel given a single session type
newSTChanBi :: Proxy s -> Proxy r -> Process (STChanBi s r) Source #
Creates a new session typed channel given separate session types for the send port and receive port
toSTChan :: UTChan -> Proxy s -> STChan s Source #
Converts an unsession typed channel to a session typed channel
toSTChanBi :: UTChan -> Proxy s -> Proxy r -> STChanBi s r Source #
Converts an unsession typed channel to a session typed channel
sendProxy :: STSendPort s -> Proxy s Source #
Converts a session typed send port into a Proxy
recvProxy :: STReceivePort s -> Proxy s Source #
Converts a session typed receive port into a Proxy
Usage
sendSTChan :: Serializable a => STSendPort (Cap ctx (a :!> l)) -> a -> Process (STSendPort (Cap ctx l)) Source #
Sends a message using a session typed send port
recvSTChan :: Serializable a => STReceivePort (Cap ctx (a :?> l)) -> Process (a, STReceivePort (Cap ctx l)) Source #
Receives a message using a session typed receive port
class STSplit m where Source #
Type class that defines combinators for branching on a session typed port
sel1Chan :: m (Cap ctx (Sel (s ': xs))) -> m (Cap ctx s) Source #
select the first branch of a selection using the given port
sel2Chan :: m (Cap ctx (Sel (s ': (t ': xs)))) -> m (Cap ctx (Sel (t ': xs))) Source #
select the second branch of a selection using the given port
off1Chan :: m (Cap ctx (Off (s ': xs))) -> m (Cap ctx s) Source #
select the first branch of an offering using the given port
off2Chan :: m (Cap ctx (Off (s ': (t ': xs)))) -> m (Cap ctx (Off (t ': xs))) Source #
select the second branch of an offering using the given port
Type class for recursion on a session typed port
Channel transformer
data STChannelT m p q a Source #
Indexed monad transformer that is indexed by two products of session types
This monad also acts as a state monad that whose state is defined by a session typed channel and dependent on the indexing of the monad.
STChannelT | |
|
sendSTChanM :: Serializable a => a -> STChannelT Process (Cap ctx (a :!> l) :*: r) (Cap ctx l :*: r) () Source #
Send a message
Only the session type of the send port needs to be adjusted
recvSTChanM :: Serializable a => STChannelT Process (l :*: Cap ctx (a :?> r)) (l :*: Cap ctx r) a Source #
receive a message
Only the session type of the receive port needs to be adjusted
sel1ChanM :: STChannelT Process (Cap lctx (Sel (l ': ls)) :*: Cap rctx (Sel (r ': rs))) (Cap lctx l :*: Cap rctx r) () Source #
select the first branch of a selection
Both ports are now adjusted. This is similarly so for the remaining combinators.
sel2ChanM :: STChannelT Process (Cap lctx (Sel (s1 ': (t1 ': xs1))) :*: Cap rctx (Sel (s2 ': (t2 ': xs2)))) (Cap lctx (Sel (t1 ': xs1)) :*: Cap rctx (Sel (t2 ': xs2))) () Source #
select the second branch of a selection
off1ChanM :: STChannelT Process (Cap lctx (Off (l ': ls)) :*: Cap rctx (Off (r ': rs))) (Cap lctx l :*: Cap rctx r) () Source #
select the first branch of an offering
off2ChanM :: STChannelT Process (Cap lctx (Off (s1 ': (t1 ': xs1))) :*: Cap rctx (Off (s2 ': (t2 ': xs2)))) (Cap lctx (Off (t1 ': xs1)) :*: Cap rctx (Off (t2 ': xs2))) () Source #
select the second branch of an offering
recChanM :: STChannelT Process (Cap sctx (R s) :*: Cap rctx (R r)) (Cap (s ': sctx) s :*: Cap (r ': rctx) r) () Source #
delimit scope of recursion
wkChanM :: STChannelT Process (Cap (t ': sctx) (Wk s) :*: Cap (k ': rctx) (Wk r)) (Cap sctx s :*: Cap rctx r) () Source #
weaken scope of recursion
varChanM :: STChannelT Process (Cap (s ': sctx) V :*: Cap (r ': rctx) V) (Cap (s ': sctx) s :*: Cap (r ': rctx) r) () Source #
recursion variable (recurse here)
epsChanM :: STChannelT Process (Cap ctx Eps :*: Cap ctx Eps) (Cap ctx Eps :*: Cap ctx Eps) () Source #
ports are no longer usable
Lifted
expect :: Serializable a => Session s s a Source #
expectTimeout :: Serializable a => Int -> Session s s (Maybe a) Source #
newChan :: Serializable a => Session s s (SendPort a, ReceivePort a) Source #
receiveChan :: Serializable a => ReceivePort a -> Session s s a Source #
receiveChanTimeout :: Serializable a => Int -> ReceivePort a -> Session s s (Maybe a) Source #
mergePortsBiased :: Serializable a => [ReceivePort a] -> Session s s (ReceivePort a) Source #
mergePortsRR :: Serializable a => [ReceivePort a] -> Session s s (ReceivePort a) Source #
unsafeSend :: Serializable a => ProcessId -> a -> Session s s () Source #
unsafeSendChan :: Serializable a => SendPort a -> a -> Session s s () Source #
unsafeNSend :: Serializable a => String -> a -> Session s s () Source #
unsafeNSendRemote :: Serializable a => NodeId -> String -> a -> Session s s () Source #
receiveWait :: [Match b] -> Session s s b Source #
unwrapMessage :: Serializable a => Message -> Session s s (Maybe a) Source #
handleMessage :: Serializable a => Message -> (a -> Session s s b) -> Session r r (Maybe b) Source #
handleMessage_ :: Serializable a => Message -> (a -> Session s s ()) -> Session r r () Source #
handleMessageP :: Serializable a => Message -> (a -> Process b) -> Session s s (Maybe b) Source #
handleMessageP_ :: Serializable a => Message -> (a -> Process ()) -> Session s s () Source #
handleMessageIf :: Serializable a => Message -> (a -> Bool) -> (a -> Session s s b) -> Session r r (Maybe b) Source #
handleMessageIf_ :: Serializable a => Message -> (a -> Bool) -> (a -> Session s s ()) -> Session r r () Source #
handleMessageIfP :: Serializable a => Message -> (a -> Bool) -> (a -> Process b) -> Session s s (Maybe b) Source #
handleMessageIfP_ :: Serializable a => Message -> (a -> Bool) -> (a -> Process ()) -> Session s s () Source #
call :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (SessionWrap a) -> Session r r a Source #
callP :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (Process a) -> Session s s a Source #
die :: Serializable a => a -> Session s s b Source #
catchExit :: (Show a, Serializable a) => Session s s b -> (ProcessId -> a -> Session r r b) -> Session t t b Source #
catchExitP :: (Show a, Serializable a) => Process b -> (ProcessId -> a -> Process b) -> Session s s b Source #
catchesExit :: Session s s b -> [ProcessId -> Message -> Session r r (Maybe b)] -> Session t t b Source #
getSelfPid :: Session s s ProcessId Source #
getSelfNode :: Session s s NodeId Source #
getProcessInfo :: ProcessId -> Session s s (Maybe ProcessInfo) Source #
getNodeStats :: NodeId -> Session s s (Either DiedReason NodeStats) Source #
unlinkNode :: NodeId -> Session s s () Source #
monitorNode :: NodeId -> Session s s MonitorRef Source #
monitorPort :: Serializable a => SendPort a -> Session s s MonitorRef Source #
unmonitor :: MonitorRef -> Session s s () Source #
withMonitor :: ProcessId -> (MonitorRef -> Session s s a) -> Session r r a Source #
withMonitorP :: ProcessId -> (MonitorRef -> Process a) -> Session s s a Source #
unregister :: String -> Session s s () Source #
nsendRemote :: Serializable a => NodeId -> String -> a -> Session s s () Source #
spawnAsync :: NodeId -> Closure (SessionWrap ()) -> Session r r SpawnRef Source #
spawnSupervised :: NodeId -> Closure (SessionWrap ()) -> Session s s (ProcessId, MonitorRef) Source #
spawnSupervisedP :: NodeId -> Closure (Process ()) -> Session s s (ProcessId, MonitorRef) Source #
spawnMonitor :: NodeId -> Closure (SessionWrap ()) -> Session s s (ProcessId, MonitorRef) Source #
spawnMonitorP :: NodeId -> Closure (Process ()) -> Session s s (ProcessId, MonitorRef) Source #
spawnChannel :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (ReceivePort a -> SessionWrap ()) -> Session s s (SendPort a) Source #
spawnChannelP :: Serializable a => Static (SerializableDict a) -> NodeId -> Closure (ReceivePort a -> Process ()) -> Session s s (SendPort a) Source #
spawnChannelLocal :: Serializable a => (ReceivePort a -> Session s s ()) -> Session r r (SendPort a) Source #
spawnChannelLocalP :: Serializable a => (ReceivePort a -> Process ()) -> Session s s (SendPort a) Source #
callLocalP :: Process a -> Session s s a Source #
reconnectPort :: SendPort a -> Session s s () Source #