-- Communicating Haskell Processes.-- Copyright (c) 2008, University of Kent.-- All rights reserved.-- -- Redistribution and use in source and binary forms, with or without-- modification, are permitted provided that the following conditions are-- met:---- * Redistributions of source code must retain the above copyright-- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above copyright-- notice, this list of conditions and the following disclaimer in the-- documentation and/or other materials provided with the distribution.-- * Neither the name of the University of Kent nor the names of its-- contributors may be used to endorse or promote products derived from-- this software without specific prior written permission.---- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-- | A collection of useful common processes that are useful when plumbing-- together a process network. All the processes here rethrow poison when-- it is encountered, as this gives the user maximum flexibility (they can-- let it propagate it, or ignore it).---- The names here overlap with standard Prelude names. This is-- deliberate, as the processes act in a similar manner to the-- corresponding Prelude versions. It is expected that you will do-- something like:---- > import qualified Control.Concurrent.CHP.Common as Common---- or:---- > import qualified Control.Concurrent.CHP.Common as CHP---- to circumvent this problem.moduleControl.Concurrent.CHP.CommonwhereimportControl.MonadimportControl.Parallel.StrategiesimportqualifiedData.TraversableasTraversableimportPrelude(Bool(..),Maybe(..),Enum,Ord,($),(<),Int,otherwise,(.))importqualifiedPreludeimportControl.Concurrent.CHP-- | Forever forwards the value onwards, unchanged. Adding this to your process-- network effectively adds a single-place buffer.id::(ReadableChannelr,Poisonable(ra),WriteableChannelw,Poisonable(wa))=>ra->wa->CHP()idin_out=(forever$dox<-readChannelin_writeChanneloutx)`onPoisonRethrow`(poisonin_>>poisonout)-- | Forever forwards the value onwards. This is-- like 'id' but does not add any buffering to your network, and its presence-- is indetectable to the process either side.---- extId is a unit of the associative operator 'Control.Concurrent.CHP.Utils.|->|'.---- The behaviour of this process was corrected in version 1.1.0 to work properly-- when the reader of its output channel was offering choice.extId::Chanina->Chanouta->CHP()extIdin_out=doc<-oneToOneChannelforever$extReadChannelin_(writeChannel(writerc))<&>extWriteChannelout(readChannel(readerc))-- | A process that waits for an input, then sends it out on /all/ its output-- channels (in order) during an extended rendezvous. This is often used to send the-- output on to both the normal recipient (without introducing buffering) and-- also to a listener process that wants to examine the value. If the listener-- process is first in the list, and does not take the input immediately, the-- value will not be sent to the other recipients until it does. The name-- of the process derives from the notion of a wire-tap, since the listener-- is hidden from the other processes (it does not visibly change the semantics-- for them -- except when the readers of the channels are offering a choice).tap::Chanina->[Chanouta]->CHP()tapin_outs=(forever$extReadChannelin_(\x->mapM_(Prelude.flipwriteChannelx)outs))`onPoisonRethrow`(poisonin_>>poisonAllouts)-- | Sends out a single value first (the prefix) then behaves like id.prefix::a->Chanina->Chanouta->CHP()prefixxin_out=(writeChanneloutx>>idin_out)`onPoisonRethrow`(poisonin_>>poisonout)-- | Discards the first value it receives then act likes id.---- Added in version 1.5.0.tail::Chanina->Chanouta->CHP()tailinputoutput=doreadChannelinput`onPoisonRethrow`(poisoninput>>poisonoutput)idinputoutput-- | Forever reads in a value, and then sends out its successor (using 'Prelude.succ').succ::Enuma=>Chanina->Chanouta->CHP()succ=mapPrelude.succ-- | Reads in a value, and sends it out in parallel on all the given output-- channels.parDelta::Chanina->[Chanouta]->CHP()parDeltain_outs=(forever$dox<-readChannelin_runParallel_$Prelude.map(Prelude.flipwriteChannelx)outs)`onPoisonRethrow`(poisonin_>>mapM_poisonouts)-- | Forever reads in a value, transforms it using the given function, and sends it-- out again. Note that the transformation is not applied strictly, so don't-- assume that this process will actually perform the computation. If you-- require a strict transformation, use 'map''.map::(a->b)->Chanina->Chanoutb->CHP()mapfin_out=forever(readChannelin_>>=writeChannelout.f)`onPoisonRethrow`(poisonin_>>poisonout)-- | Like 'map', but applies the transformation strictly before sending on-- the value.---- Added in version 1.1.0.map'::NFDatab=>(a->b)->Chanina->Chanoutb->CHP()map'fin_out=forever(readChannelin_>>=writeChannelStrictout.f)`onPoisonRethrow`(poisonin_>>poisonout)-- | Forever reads in a value, and then based on applying the given function-- either discards it (if the function returns False) or sends it on (if-- the function returns True).filter::(a->Bool)->Chanina->Chanouta->CHP()filterfin_out=forever(dox<-readChannelin_when(fx)(writeChanneloutx))`onPoisonRethrow`(poisonin_>>poisonout)-- | Streams all items in a 'Data.Traversable.Traversable' container out-- in the order given by 'Data.Traversable.mapM' on the output channel (one at-- a time). Lists, 'Prelude.Maybe', and 'Data.Set.Set' are all instances-- of 'Data.Traversable.Traversable', so this can be used for all of-- those.stream::Traversable.Traversablet=>Chanin(ta)->Chanouta->CHP()streamin_out=(forever$doxs<-readChannelin_Traversable.mapM(writeChannelout)xs)`onPoisonRethrow`(poisonin_>>poisonout)-- | Forever waits for input from one of its many channels and sends it-- out again on the output channel.merger::[Chanina]->Chanouta->CHP()mergerinsout=(forever$alt(Prelude.mapreadChannelins)>>=writeChannelout)`onPoisonRethrow`(poisonAllins>>poisonout)-- | Sends out the specified value on the given channel the specified number-- of times, then finishes.replicate::Int->a->Chanouta->CHP()replicatenxc=replicateM_n(writeChannelcx)`onPoisonRethrow`poisonc-- | Forever sends out the same value on the given channel, until poisoned.-- Similar to the white-hole processes in some other frameworks.repeat::a->Chanouta->CHP()repeatxc=(forever$writeChannelcx)`onPoisonRethrow`poisonc-- | Forever reads values from the channel and discards them, until poisoned.-- Similar to the black-hole processes in some other frameworks.consume::Chanina->CHP()consumec=(forever$readChannelc)`onPoisonRethrow`poisonc-- | For the duration of the given process, acts as a consume process, but stops-- when the given process stops. Note that there could be a timing issue where-- extra inputs are consumed at the end of the lifetime of the process.-- Note also that while poison from the given process will be propagated on the-- consumption channel, there is no mechanism to propagate poison from the consumption-- channel into the given process.---- Added in version 1.2.0.consumeAlongside::Chanina->CHPb->CHPbconsumeAlongsidein_proc=doc<-oneToOneChannel'$chanLabel"consumeAlongside-Internal"(x,_)<-((dox<-procwriteChannel(writerc)()returnx)`onPoisonRethrow`poison(writerc))<||>(inner(readerc)`onPoisonRethrow`poison(readerc))returnxwhereinnerc=docont<-alt[readChannelc>>returnFalse,readChannelin_>>returnTrue]ifconttheninnercelsereturn()-- | Forever reads a value from both its input channels in parallel, then joins-- the two values using the given function and sends them out again. For example,-- @join (,) c d@ will pair the values read from @c@ and @d@ and send out the-- pair on the output channel, whereas @join (&&)@ will send out the conjunction-- of two boolean values, @join (==)@ will read two values and output whether-- they are equal or not, etc.join::(a->b->c)->Chanina->Chaninb->Chanoutc->CHP()joinfin0in1out=(forever$do[Prelude.Leftx,Prelude.Righty]<-runParallel[liftMPrelude.Left$readChannelin0,liftMPrelude.Right$readChannelin1]writeChannelout$fxy)`onPoisonRethrow`(poisonin0>>poisonin1>>poisonout)-- | Forever reads a value from all its input channels in parallel, then joins-- the values into a list in the same order as the channels, and sends them out again.joinList::[Chanina]->Chanout[a]->CHP()joinListinsout=(forever$runParMapMreadChannelins>>=writeChannelout)`onPoisonRethrow`(poisonAllins>>poisonout)-- | Forever reads a pair from its input channel, then in parallel sends out-- the first and second parts of the pair on its output channels.---- Added in version 1.0.2.split::Chanin(a,b)->Chanouta->Chanoutb->CHP()splitin_outAoutB=(forever$do(a,b)<-readChannelin_writeChanneloutAa<||>writeChanneloutBb)`onPoisonRethrow`(poisonin_>>poisonoutA>>poisonoutB)-- | A sorter process. When it receives its first @Just x@ data item, it keeps-- it. When it receieves a second, it keeps the lowest of the two, and sends-- out the other one. When it receives Nothing, it sends out its data value,-- then sends Nothing too. The overall effect when chaining these things together-- is a sorting pump. You inject all the values with Just, then send in a-- single Nothing to get the results out (in reverse order).sorter::Orda=>Chanin(Maybea)->Chanout(Maybea)->CHP()sorter=sorter'(<)-- | Like sorter, but with a custom comparison method. You should pass in-- the equivalent of less-than: (<).sorter'::foralla.(a->a->Bool)->Chanin(Maybea)->Chanout(Maybea)->CHP()sorter'ltin_out=internalNothing`onPoisonRethrow`(poisonin_>>poisonout)whereinternal::Maybea->CHP()internalcurVal=donewVal<-readChannelin_case(curVal,newVal)of-- Flush, but we're empty:(Nothing,Nothing)->dowriteChanneloutnewValinternalcurVal-- Flush:(Just_,Nothing)->dowriteChanneloutcurValwriteChanneloutnewValinternalcurVal-- New value, we were empty:(Nothing,Just_)->internalnewVal-- New value, we had one already:(Justcur,Justnew)|new`lt`cur->dowriteChanneloutcurValinternalnewVal|otherwise->dowriteChanneloutnewValinternalcurVal-- | A shared variable process. Given an initial value and two channels, it-- continually offers to output its current value or read in a new one.---- Added in version 1.1.1---- Note that prior to version 1.2.0 (i.e. in version 1.1.1) there was a bug where-- poison would not be propagated between the input and output.valueStore::(ReadableChannelr,Poisonable(ra),WriteableChannelw,Poisonable(wa))=>a->ra->wa->CHP()valueStorevalinputoutput=innerval`onPoisonRethrow`(poisoninput>>poisonoutput)whereinnerx=((writeChanneloutputx>>returnx)<->readChannelinput)>>=inner-- | A shared variable process. The same as valueStore, but initially waits-- to read its starting value before then offering to either output its current-- value or read in a new one.---- Added in version 1.1.1---- Note that prior to version 1.2.0 (i.e. in version 1.1.1) there was a bug where-- poison would not be propagated between the input and output.valueStore'::(ReadableChannelr,Poisonable(ra),WriteableChannelw,Poisonable(wa))=>ra->wa->CHP()valueStore'inputoutput=(readChannelinput>>=\x->valueStorexinputoutput)`onPoisonRethrow`(poisoninput>>poisonoutput)-- | Continually waits for a specific time on the given clock, each time applying-- the function to work out the next specific time to wait for. The most common-- thing to pass is Prelude.succ or (+1).---- Added in version 1.2.0.advanceTime::(Waitablec,Ordt)=>(t->t)->Enrolledct->CHP()advanceTimefc=dot<-getCurrentTimecinner(ft)whereinnert=waitc(Justt)>>=inner.f