nqe-0.6.3: Concurrency library in the style of Erlang/OTP
CopyrightNo rights reserved
LicenseUNLICENSE
Maintainerxenog@protonmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Control.Concurrent.NQE.Process

Description

This is the core of the NQE library. It is composed of code to deal with processes and mailboxes. Processes represent concurrent threads that receive messages via a mailbox, also referred to as a channel. NQE is inspired by Erlang/OTP and it stands for “Not Quite Erlang”. A process is analogous to an actor in Scala, or an object in the original (Alan Kay) sense of the word. To implement synchronous communication NQE makes use of STM actions embedded in asynchronous messages.

Synopsis

Documentation

type Listen a = a -> STM () Source #

STM function that receives an event and does something with it.

data Mailbox msg Source #

Channel that only allows messages to be sent to it.

Constructors

forall mbox.OutChan mbox => Mailbox !(mbox msg) !Unique 

Instances

Instances details
OutChan Mailbox Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: Mailbox msg -> STM Bool Source #

sendSTM :: msg -> Mailbox msg -> STM () Source #

Eq (Mailbox msg) Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

(==) :: Mailbox msg -> Mailbox msg -> Bool #

(/=) :: Mailbox msg -> Mailbox msg -> Bool #

Hashable (Mailbox msg) Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

hashWithSalt :: Int -> Mailbox msg -> Int #

hash :: Mailbox msg -> Int #

data Inbox msg Source #

Channel that allows to send or receive messages.

Constructors

forall mbox.(OutChan mbox, InChan mbox) => Inbox !(mbox msg) !Unique 

Instances

Instances details
OutChan Inbox Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: Inbox msg -> STM Bool Source #

sendSTM :: msg -> Inbox msg -> STM () Source #

InChan Inbox Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxEmptySTM :: Inbox msg -> STM Bool Source #

receiveSTM :: Inbox msg -> STM msg Source #

requeueSTM :: msg -> Inbox msg -> STM () Source #

Eq (Inbox msg) Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

(==) :: Inbox msg -> Inbox msg -> Bool #

(/=) :: Inbox msg -> Inbox msg -> Bool #

data Process msg Source #

Async handle and Mailbox for a process.

Constructors

Process 

Instances

Instances details
OutChan Process Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: Process msg -> STM Bool Source #

sendSTM :: msg -> Process msg -> STM () Source #

Eq (Process msg) Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

(==) :: Process msg -> Process msg -> Bool #

(/=) :: Process msg -> Process msg -> Bool #

Hashable (Process msg) Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

hashWithSalt :: Int -> Process msg -> Int #

hash :: Process msg -> Int #

class InChan mbox where Source #

Class for implementation of an Inbox.

Methods

mailboxEmptySTM :: mbox msg -> STM Bool Source #

Are there messages queued?

receiveSTM :: mbox msg -> STM msg Source #

Receive a message.

requeueSTM :: msg -> mbox msg -> STM () Source #

Put a message in the mailbox such that it is received next.

Instances

Instances details
InChan TQueue Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxEmptySTM :: TQueue msg -> STM Bool Source #

receiveSTM :: TQueue msg -> STM msg Source #

requeueSTM :: msg -> TQueue msg -> STM () Source #

InChan TBQueue Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxEmptySTM :: TBQueue msg -> STM Bool Source #

receiveSTM :: TBQueue msg -> STM msg Source #

requeueSTM :: msg -> TBQueue msg -> STM () Source #

InChan Inbox Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxEmptySTM :: Inbox msg -> STM Bool Source #

receiveSTM :: Inbox msg -> STM msg Source #

requeueSTM :: msg -> Inbox msg -> STM () Source #

class OutChan mbox where Source #

Class for implementation of a Mailbox.

Methods

mailboxFullSTM :: mbox msg -> STM Bool Source #

Is this bounded channel full? Always False for unbounded channels.

sendSTM :: msg -> mbox msg -> STM () Source #

Send a message to this channel.

Instances

Instances details
OutChan TQueue Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: TQueue msg -> STM Bool Source #

sendSTM :: msg -> TQueue msg -> STM () Source #

OutChan TBQueue Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: TBQueue msg -> STM Bool Source #

sendSTM :: msg -> TBQueue msg -> STM () Source #

OutChan Process Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: Process msg -> STM Bool Source #

sendSTM :: msg -> Process msg -> STM () Source #

OutChan Inbox Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: Inbox msg -> STM Bool Source #

sendSTM :: msg -> Inbox msg -> STM () Source #

OutChan Mailbox Source # 
Instance details

Defined in Control.Concurrent.NQE.Process

Methods

mailboxFullSTM :: Mailbox msg -> STM Bool Source #

sendSTM :: msg -> Mailbox msg -> STM () Source #

inboxToMailbox :: Inbox msg -> Mailbox msg Source #

Get a send-only Mailbox for an Inbox.

wrapChannel :: (MonadIO m, InChan mbox, OutChan mbox) => mbox msg -> m (Inbox msg) Source #

Wrap a channel in an Inbox

newInbox :: MonadIO m => m (Inbox msg) Source #

Create an unbounded Inbox.

newBoundedInbox :: MonadIO m => Natural -> m (Inbox msg) Source #

Inbox with upper bound on number of allowed queued messages.

send :: (MonadIO m, OutChan mbox) => msg -> mbox msg -> m () Source #

Send a message to a channel.

receive :: (InChan mbox, MonadIO m) => mbox msg -> m msg Source #

Receive a message from a channel.

query :: (MonadIO m, OutChan mbox) => (Listen response -> request) -> mbox request -> m response Source #

Send request to channel and wait for a response. The request STM action will be created by this function.

queryU :: (MonadUnliftIO m, OutChan mbox) => Int -> (Listen response -> request) -> mbox request -> m (Maybe response) Source #

Do a query but timeout after u microseconds. Return Nothing if timeout reached.

queryS :: (MonadUnliftIO m, OutChan mbox) => Int -> (Listen response -> request) -> mbox request -> m (Maybe response) Source #

Do a query but timeout after s seconds. Return Nothing if timeout reached.

receiveMatch :: (MonadIO m, InChan mbox) => mbox msg -> (msg -> Maybe a) -> m a Source #

Test all messages in a channel against the supplied function and return the first matching message. Will block until a match is found. Messages that do not match remain in the channel.

receiveMatchU :: (MonadUnliftIO m, InChan mbox) => Int -> mbox msg -> (msg -> Maybe a) -> m (Maybe a) Source #

Like receiveMatch but with a timeout set at u microseconds. Returns Nothing if timeout is reached.

receiveMatchS :: (MonadUnliftIO m, InChan mbox) => Int -> mbox msg -> (msg -> Maybe a) -> m (Maybe a) Source #

Like receiveMatch but with a timeout set at s seconds. Returns Nothing if timeout is reached.

receiveMatchSTM :: InChan mbox => mbox msg -> (msg -> Maybe a) -> STM a Source #

Match a message in the channel as an atomic STM action.

mailboxEmpty :: (MonadIO m, InChan mbox) => mbox msg -> m Bool Source #

Check if the channel is empty.

requeueListSTM :: InChan mbox => [msg] -> mbox msg -> STM () Source #

Put a list of messages at the start of a channel, so that the last element of the list is the next message to be received.

withProcess :: MonadUnliftIO m => (Inbox msg -> m ()) -> (Process msg -> m a) -> m a Source #

Run a process in the background and pass it to a function. Stop the background process once the function returns. Background process exceptions are re-thrown in the current thread.

process :: MonadUnliftIO m => (Inbox msg -> m ()) -> m (Process msg) Source #

Run a process in the background and return the Process handle. Background process exceptions are re-thrown in the current thread.

newMailbox :: MonadUnliftIO m => m (Inbox msg, Mailbox msg) Source #

Create an unbounded inbox and corresponding mailbox.