PriorityChansConverger-0.1: Read single output from an array of inputs - channels with priorities

Control.Concurrent.PriorityChansConverger.PriorityChansConvergerSTM

Contents

Description

Abbreviation for the PriorityChansConverger is PCC.

Based on STM.TChans, extended with capacity control (see Control.Concurrent.STM.TChan.TChanB).

When user reads from the PCC, the choice is made - from which channel to read. System selects a nonempty channel, whose /(CurrentPriority, StartPriority)/ tuple is max. The side effect of the channel selection is it's CurrentPriority decrease by one, if it's value becomes less than one, then the CurrentPriority is set to StartPriority.

Synopsis

PriorityChansConverger ADT and it's administration

decPriority :: (CurrentPriority, StartPriority) -> (CurrentPriority, StartPriority)Source

Decrease CurrentPriority by one, if it's value becomes less than one, then the CurrentPriority is set to StartPriority.

data Ord k => PriorityChansConvergerSTM k e Source

Constructors

PriorityChansConvergerSTM 

Fields

pccStruct :: Map k (PriorityChan k e)

All channels. Convenient to use for input. Map keys == pcID of elements.

pccEmpties :: TVar (Map (CurrentPriority, StartPriority) [PriorityChan k e])

Empty channels. Map keys == pcPriorityTV of elements.

pccNonEmpties :: TVar (Map (CurrentPriority, StartPriority) [PriorityChan k e])

Nonempty channels. Map keys == pcPriorityTV of elements. Convenient for taking output.

pccConcurrentUISupport :: Maybe ConcurrentUISupport

For testing and debugging purposes.

newPriorityChansConvergerSTM_wCUIS :: Ord k => Maybe ConcurrentUISupport -> Map k (StartPriority, ChanCapacity) -> STM (PriorityChansConvergerSTM k e)Source

PCC constructor with an option to enable utility ConcurrentUISupport (which is useful for debugging).

PriorityChansConvergerSTM mutation

isOfStructPCC_STM :: Ord k => Map k (StartPriority, ChanCapacity) -> PriorityChansConvergerSTM k e -> STM (PCC_ContainsGivenSpecification, NothingElseIsInStruct)Source

Checks:

  • If PCC contains all channels, constructable by given specification.
  • If PCC contains nothing else, than mentioned in the given specification.

mutatePCC_STM :: Ord k => Map k (StartPriority, ChanCapacity) -> PriorityChansConvergerSTM k e -> STM (PriorityChansConvergerSTM k e)Source

Updates PCC with given specification. New channels may be added or existing alerted. But no operation for removing channels.

PriorityChansConvergerSTM I/O

writeInPCC_STM :: Ord k => PermitToBlock -> k -> e -> PriorityChansConvergerSTM k e -> STM (Maybe FailureReasonWPCC)Source

If blocking is on, then blocks, when trying to write to a full channel (where's no free space).

interruptableWriteInPCC_STM :: Ord k => STM InterruptShouldWe -> k -> e -> PriorityChansConvergerSTM k e -> STM (Either () (Maybe FailureReasonWPCC))Source

Wrapper around (writeInPCC_STM True) - blocking write. Uses interruptableSTM. If returns Left, then transaction ended with interrupting condition.

readFromPCC_STM :: Ord k => PermitToBlock -> PriorityChansConvergerSTM k e -> STM (Maybe (k, e))Source

If PermitToBlock is True, then never returns Nothing.

interruptableReadFromPCC_STM :: Ord k => STM InterruptShouldWe -> PriorityChansConvergerSTM k e -> STM (Either () (k, e))Source

Wrapper around (readFromPCC_STM True) - blocking read. Uses interruptableSTM. If returns Left, then transaction ended with interrupting condition.

flushPCC2List_STM :: Ord k => PriorityChansConvergerSTM k e -> STM [(k, e)]Source

Composition of readFromPCC_STMs. Lazy (doublecheck that).

flushPCC2List_STM' :: Ord k => PriorityChansConvergerSTM k e -> STM [(k, e)]Source

Strict. Should be a bit faster than flushPCC2List_STM.

fastFlushPCC2List_STM' :: Ord k => PriorityChansConvergerSTM k e -> STM [(k, e)]Source

Strict. This is a fast flush, it doesn't deal with priorities.

freeSpaceInPCCInput_STM :: Ord k => PriorityChansConvergerSTM k e -> k -> STM (Maybe ChanContentAmountMeasure)Source

Free space in referenced channel = Capacity - Load.

filterOutPCCElements_STM' :: Ord k => PriorityChansConvergerSTM k e -> (e -> TakeElementOutShouldWe) -> STM [(k, e)]Source

Strict.

Take everything, applu filter, return what's left in the PCC, return what's taken out.

PriorityChansConvergerSTM representation

showPCC_STM :: (Ord k, Show k, Show e) => PriorityChansConvergerSTM k e -> STM StringSource

Used wrapped in (unsafePerformIO . atomically) in the definition of show instance.

showPC_STM :: (Show e, Show k) => PriorityChan k e -> STM StringSource

Used wrapped in (unsafePerformIO . atomically) in the definition of show instance.

Helpers

interruptableSTM :: STM InterruptShouldWe -> STM a -> STM (Maybe a)Source

For interruptableSTM interrupter subj, when interrupter returns True, the transaction returns Nothing. Else the result of subj is waited and returned wrapped into Just.