-- |-- Module: FRP.NetWire.Wire-- Copyright: (c) 2011 Ertugrul Soeylemez-- License: BSD3-- Maintainer: Ertugrul Soeylemez <es@ertes.de>---- The module contains the main 'Wire' type.moduleFRP.NetWire.Wire(-- * WiresWire(..),WireState(..),-- * Auxilliary typesInhibitException(..),Output,SF,Time,-- * UtilitiescleanupWireState,inhibitEx,initWireState,mkGen,noEvent,toGen)whereimportControl.ApplicativeimportControl.ArrowimportControl.CategoryimportControl.Concurrent.STMimportControl.Exception(Exception(..),SomeException)importControl.MonadimportControl.Monad.FiximportControl.Monad.IO.ClassimportData.Functor.IdentityimportData.TypeableimportPreludehiding((.),id)importSystem.Random.Mersenne-- | Inhibition exception with an informative message. This exception-- is the result of signal inhibition, where no further exception-- information is available.dataInhibitException=InhibitExceptionStringderiving(Read,Show,Typeable)instanceExceptionInhibitException-- | Functor for output signals.typeOutput=EitherSomeException-- | Signal functions are wires over the identity monad.typeSF=WireIdentity-- | Time.typeTime=Double-- | A wire is a network of signal transformers.dataWire::(*->*)->*->*->*whereWArr::(a->b)->WiremabWGen::(WireStatem->a->m(Outputb,Wiremab))->Wiremab-- | This instance corresponds to the 'ArrowPlus' and 'ArrowZero'-- instances.instanceMonadm=>Alternative(Wirema)whereempty=zeroArrow(<|>)=(<+>)-- | Applicative interface to signal networks.instanceMonadm=>Applicative(Wirema)wherepure=arr.constwf<*>wx=wf&&&wx>>>arr(uncurry($))-- | Arrow interface to signal networks.instanceMonadm=>Arrow(Wirem)wherearr=WArrfirst(WGenf)=WGen$\ws(x',y)->liftM(fmap(,y)***first)(fwsx')first(WArrf)=WArr(firstf)second(WGenf)=WGen$\ws(x,y')->liftM(fmap(x,)***second)(fwsy')second(WArrf)=WArr(secondf)(***)=wsidebyside0(&&&)=wboth0-- | Signal routing. Unused routes are frozen, until they are put back-- into use.instanceMonadm=>ArrowChoice(Wirem)whereleftw'=wl0wherewlt'=WGen$\ws@(wsDTime->dt)mx'->lett=t'+dtint`seq`casemx'ofLeftx'->liftM(fmapLeft***left)(toGenw'(ws{wsDTime=t})x')Rightx->return(pure(Rightx),wlt)rightw'=wl0wherewlt'=WGen$\ws@(wsDTime->dt)mx'->lett=t'+dtint`seq`casemx'ofRightx'->liftM(fmapRight***right)(toGenw'(ws{wsDTime=t})x')Leftx->return(pure(Leftx),wlt)wf'+++wg'=wl00wf'wg'wherewltf'tg'wf'wg'=WGen$\ws@(wsDTime->dt)mx'->lettf=tf'+dttg=tg'+dtintf`seq`tg`seq`casemx'ofLeftx'->do(mx,wf)<-toGenwf'(ws{wsDTime=tf})x'return(fmapLeftmx,wl0tgwfwg')Rightx'->do(mx,wg)<-toGenwg'(ws{wsDTime=tg})x'return(fmapRightmx,wltf0wf'wg)wf'|||wg'=wl00wf'wg'wherewltf'tg'wf'wg'=WGen$\ws@(wsDTime->dt)mx'->lettf=tf'+dttg=tg'+dtintf`seq`tg`seq`casemx'ofLeftx'->do(mx,wf)<-toGenwf'(ws{wsDTime=tf})x'return(mx,wl0tgwfwg')Rightx'->do(mx,wg)<-toGenwg'(ws{wsDTime=tg})x'return(mx,wltf0wf'wg)-- | Value recursion. Warning: Recursive signal networks must never-- inhibit. Make use of 'FRP.NetWire.Tools.exhibit' or-- 'FRP.NetWire.Event.event'.instanceMonadFixm=>ArrowLoop(Wirem)whereloopw'=WGen$\wsx'->dorec(Right(x,d),w)<-toGenw'ws(x',d)return(Rightx,loopw)-- | Left-biased signal network combination. If the left arrow-- inhibits, the right arrow is tried. If both inhibit, their-- combination inhibits.instanceMonadm=>ArrowPlus(Wirem)wherewf'@(WGen_)<+>wg'=wl0wf'wg'wherewlt'wf'wg'=WGen$\ws@(wsDTime->dt)x'->dolett=t'+dt(mx,wf)<-toGenwf'wsx'casemxofRight_->t`seq`return(mx,wltwfwg')Left_->do(mx2,wg)<-t`seq`toGenwg'(ws{wsDTime=t})x'return(mx2,wl0wfwg)wa@(WArr_)<+>_=wa-- | The zero arrow always inhibits.instanceMonadm=>ArrowZero(Wirem)wherezeroArrow=mkGen$\__->return(Left(inhibitEx"Signal inhibited"),zeroArrow)-- | Identity signal network and signal network sequencing.instanceMonadm=>Category(Wirem)whereid=WArrid(.)=flip(wcompose0)-- | Map over the result of a signal network.instanceMonadm=>Functor(Wirema)wherefmapf=(>>>arrf)-- | The state of the wire.dataWireState::(*->*)->*whereImpureState::MonadIOm=>{wsDTime::Double,-- ^ Time difference for current instant.wsRndGen::MTGen,-- ^ Random number generator.wsReqVar::TVarInt-- ^ Request counter.}->WireStatemPureState::{wsDTime::Double}->WireStatem-- | Clean up wire state.cleanupWireState::WireStatem->IO()cleanupWireState_=return()-- | Construct an 'InhibitException' wrapped in a 'SomeException'.inhibitEx::String->SomeExceptioninhibitEx=toException.InhibitException-- | Initialize wire state.initWireState::MonadIOm=>IO(WireStatem)initWireState=ImpureState<$>pure0<*>getStdGen<*>newTVarIO0-- | Create a generic wire from the given function. This is a smart-- constructor. Please use it instead of the 'WGen' constructor.mkGen::(WireStatem->a->m(Outputb,Wiremab))->WiremabmkGen=WGen-- | Construct an 'InhibitException' wrapped in a 'SomeException' with a-- message indicating that a certain event did not happen.noEvent::SomeExceptionnoEvent=inhibitEx"No event"-- | Extract the transition function of a wire.toGen::Monadm=>Wiremab->WireStatem->a->m(Outputb,Wiremab)toGen(WGenf)wsx=fwsxtoGenwf@(WArrf)_x=return(Right(fx),wf)-- | Efficient signal sharing.wboth::Monadm=>Time->Wiremab->Wiremac->Wirema(b,c)wbotht'(WGenf)wg'@(WGeng)=WGen$\ws@(wsDTime->dt)x'->dolett=t'+dt(mx1,wf)<-t`seq`fwsx'casemx1ofLeftex->return(Leftex,wbothtwfwg')Right_->do(mx2,wg)<-gwsx'return(liftA2(,)mx1mx2,wboth0wfwg)wbotht'wf@(WArrf)(WGeng)=WGen$\wsx'->do(mx2,wg)<-gwsx'return(fmap(fx',)mx2,wbotht'wfwg)wbotht'(WGenf)wg@(WArrg)=WGen$\wsx'->do(mx1,wf)<-fwsx'return(fmap(,gx')mx1,wbotht'wfwg)wboth_(WArrf)(WArrg)=WArr(f&&&g)-- | Efficient forward-composition of two wires.wcompose::Monadm=>Time->Wiremab->Wirembc->Wiremacwcomposet'(WGenf)wg'@(WGeng)=WGen$\ws@(wsDTime->dt)x''->dolett=t'+dt(mx',wf)<-t`seq`fwsx''casemx'ofLeftex->return(Leftex,wcomposetwfwg')Rightx'->do(mx,wg)<-g(ws{wsDTime=t})x'return(mx,wcompose0wfwg)wcomposet'wf@(WArrf)(WGeng)=WGen$\wsx'->do(mx,wg)<-gws(fx')return(mx,wcomposet'wfwg)wcomposet'(WGenf)wg@(WArrg)=WGen$\wsx'->do(mx,wf)<-fwsx'return(fmapgmx,wcomposet'wfwg)wcompose_(WArrf)(WArrg)=WArr(g.f)-- | Run two signals through two signal networks.wsidebyside::Monadm=>Time->Wiremac->Wirembd->Wirem(a,b)(c,d)wsidebysidet'(WGenf)wg'@(WGeng)=WGen$\ws@(wsDTime->dt)(x',y')->dolett=t'+dt(mx,wf)<-t`seq`fwsx'casemxofLeftex->return(Leftex,wsidebysidetwfwg')Right_->do(my,wg)<-gwsy'return(liftA2(,)mxmy,wsidebyside0wfwg)wsidebysidet'wf@(WArrf)(WGeng)=WGen$\ws(x',y')->do(my,wg)<-gwsy'return(fmap(fx',)my,wsidebysidet'wfwg)wsidebysidet'(WGenf)wg@(WArrg)=WGen$\ws(x',y')->do(mx,wf)<-fwsx'return(fmap(,gy')mx,wsidebysidet'wfwg)wsidebyside_(WArrf)(WArrg)=WArr(f***g)