-- |-- Module: Control.Wire.Wire-- Copyright: (c) 2012 Ertugrul Soeylemez-- License: BSD3-- Maintainer: Ertugrul Soeylemez <es@ertes.de>---- This is the core module implementing the 'Wire' type.moduleControl.Wire.Wire(-- * WiresWire(..),Time,-- ** Constructing wiresmkFix,mkFixM,mkGen,mkPure,mkState,mkStateM,-- ** Simple predefined wiresconstant,identity,never,-- ** Helper functionsmapOutput,-- * SteppingstepWire,stepWireP)whereimportqualifiedData.BifunctorasBiimportControl.ApplicativeimportControl.ArrowimportControl.CategoryimportControl.MonadimportControl.Monad.FiximportControl.Monad.IdentityimportData.AdditiveGroupimportData.AffineSpaceimportData.CrossimportData.MonoidimportData.ProfunctorimportData.StringimportData.VectorSpaceimportPreludehiding((.),id)-- | Time.typeTime=Double-- | A wire is a signal function from an input value of type @a@ that-- either /produces/ an output value of type @b@ or /inhibits/ with a-- value of type @e@. The underlying monad is @m@.dataWireemab=WGen(Time->a->m(Eithereb,Wireemab))|WPure(Time->a->(Eithereb,Wireemab))instance(AdditiveGroupb,Monadm)=>AdditiveGroup(Wireemab)wherezeroV=purezeroV(^+^)=liftA2(^+^)negateV=fmapnegateVinstance(AdditiveGroup(Diffb),AffineSpaceb,Monadm)=>AffineSpace(Wireemab)wheretypeDiff(Wireemab)=Wireema(Diffb)(.-.)=liftA2(.-.)(.+^)=liftA2(.+^)instance(Monadm,Monoide)=>Alternative(Wireema)whereempty=mkFix(const.const$Leftmempty)(<|>)=loop0whereloop!t2(WPuref1)w2'@(WPuref2)=mkPure$\dtx'->let(mx1,w1)=f1dtx'incasemx1ofLeftex1->let(mx2,w2)=f2(t2+dt)x'in(Bi.first(mappendex1)mx2,loop0w1w2)Right_->(mx1,loop(t2+dt)w1w2')loop!t2w1'w2'=mkGen$\dtx'->do(mx1,w1)<-stepWirew1'dtx'casemx1ofLeftex1->do(mx2,w2)<-stepWirew2'(t2+dt)x'return(Bi.first(mappendex1)mx2,loop0w1w2)Right_->return(mx1,loop(t2+dt)w1w2')instance(Monadm)=>Applicative(Wireema)wherepure=constant(<*>)=loop0whereloop!tx(WPureff)wx'@(WPurefx)=mkPure$\dtx'->let(mf,wf)=ffdtx'incasemfofRightf->let(mx,wx)=fx(tx+dt)x'in(fmapfmx,loop0wfwx)Leftex->(Leftex,loop(tx+dt)wfwx')loop!txwf'wx'=mkGen$\dtx'->do(mf,wf)<-stepWirewf'dtx'casemfofRightf->do(mx,wx)<-stepWirewx'(tx+dt)x'return(fmapfmx,loop0wfwx)Leftex->return(Leftex,loop(tx+dt)wfwx')instance(Monadm)=>Arrow(Wireem)wherearrf=mkFix(const$Right.f)firstw=liftA2(,)(lmapfstw)(arrsnd)secondw=liftA2(,)(arrfst)(lmapsndw)(&&&)=liftA2(,)w1***w2=liftA2(,)(lmapfstw1)(lmapsndw2)instance(Monadm)=>ArrowChoice(Wireem)where(|||)=loop00whereloop!tl!trwl'wr'=mkGen$\dt->either(\x'->do(mx,wl)<-stepWirewl'(tl+dt)x'return(mx,loop0(tr+dt)wlwr'))(\x'->do(mx,wr)<-stepWirewr'(tr+dt)x'return(mx,loop(tl+dt)0wl'wr))w1+++w2=fmapLeftw1|||fmapRightw2left=loop0whereloop!tlwl'=mkGen$\dt->either(liftM(fmapLeft***loop0).stepWirewl'(tl+dt))(\x->return(Right(Rightx),loop(tl+dt)wl'))right=loop0whereloop!trwr'=mkGen$\dt->either(\x->return(Right(Leftx),loop(tr+dt)wr'))(liftM(fmapRight***loop0).stepWirewr'(tr+dt))instance(MonadFixm)=>ArrowLoop(Wireem)whereloopw'=mkGen$\dtx'->liftM(fmapfst***loop).mfix$\~(mx,_)->letfeedbackErr=error"Feedback loop broken by inhibition"instepWirew'dt(x',either(constfeedbackErr)sndmx)instance(Monadm,Monoide)=>ArrowPlus(Wireem)where(<+>)=(<|>)instance(Monadm,Monoide)=>ArrowZero(Wireem)wherezeroArrow=emptyinstance(Monadm)=>Category(Wireem)whereid=identity(.)=loop0whereloop!t2w2'@(WPuref2)(WPuref1)=mkPure$\dtx''->let(mx',w1)=f1dtx''incasemx'ofRightx'->let(mx,w2)=f2(t2+dt)x'in(mx,loop0w2w1)Leftex->(Leftex,loop(t2+dt)w2'w1)loop!t2w2'w1'=mkGen$\dtx''->do(mx',w1)<-stepWirew1'dtx''casemx'ofRightx'->do(mx,w2)<-stepWirew2'(t2+dt)x'return(mx,loop0w2w1)Leftex->return(Leftex,loop(t2+dt)w2'w1)instance(Floatingb,Monadm)=>Floating(Wireemab)wherepi=purepisqrt=fmapsqrt(**)=liftA2(**)exp=fmapexplog=fmaploglogBase=liftA2logBasecos=fmapcos;sin=fmapsin;tan=fmaptanacos=fmapacos;asin=fmapasin;atan=fmapatancosh=fmapcosh;sinh=fmapsinh;tanh=fmaptanhacosh=fmapacosh;asinh=fmapasinh;atanh=fmapatanhinstance(Fractionalb,Monadm)=>Fractional(Wireemab)where(/)=liftA2(/)fromRational=pure.fromRationalrecip=fmaprecipinstance(Monadm)=>Functor(Wireema)wherefmap=mapOutput.fmapinstance(HasCross2b,Monadm)=>HasCross2(Wireemab)wherecross2=fmapcross2instance(HasCross3b,Monadm)=>HasCross3(Wireemab)wherecross3=liftA2cross3instance(HasNormalb,Monadm)=>HasNormal(Wireemab)wherenormalVec=fmapnormalVecinstance(InnerSpaceb,Monadm)=>InnerSpace(Wireemab)where(<.>)=liftA2(<.>)instance(Monadm,Numb)=>Num(Wireemab)where(+)=liftA2(+)(-)=liftA2(-)(*)=liftA2(*)abs=fmapabssignum=fmapsignumfromInteger=pure.fromIntegerinstance(IsStringb,Monadm)=>IsString(Wireemab)wherefromString=pure.fromStringinstance(Monadm,Monoidb)=>Monoid(Wireemab)wheremempty=purememptymappend=liftA2mappendinstance(Monadm)=>Profunctor(Wireem)wherelmapf(WPureg)=WPure(\dt->second(lmapf).gdt.f)lmapf(WGeng)=WGen(\dt->liftM(second(lmapf)).gdt.f)rmap=fmapinstance(Monadm,Readb)=>Read(Wireemab)wherereadsPrecn=map(firstpure).readsPrecninstance(Monadm,VectorSpaceb)=>VectorSpace(Wireemab)wheretypeScalar(Wireemab)=Wireema(Scalarb)(*^)=liftA2(*^)-- | Variant of 'pure' without the 'Monad' constraint. Using 'pure' is-- preferable.constant::b->Wireemabconstant=mkFix.const.const.Right-- | Variant of 'id' without the 'Monad' constraint. Using 'id' is-- preferable.identity::Wireemaaidentity=WPure(\_x->(Rightx,identity))-- | Map the given function over the raw wire output.mapOutput::(Monadm)=>(Eithereb'->Eithereb)->Wireemab'->WireemabmapOutputf(WGeng)=WGen(\dt->liftM(f***mapOutputf).gdt)mapOutputf(WPureg)=WPure(\dt->(f***mapOutputf).gdt)-- | Construct a pure stateless wire from the given function.mkFix::(Time->a->Eithereb)->WireemabmkFixf=letw=mkPure(\dt->(,w).fdt)inw-- | Construct a stateless effectful wire from the given function.mkFixM::(Monadm)=>(Time->a->m(Eithereb))->WireemabmkFixMf=letw=mkGen(\dt->liftM(,w).fdt)inw-- | Construct an effectful wire from the given function.mkGen::(Time->a->m(Eithereb,Wireemab))->WireemabmkGen=WGen-- | Construct a pure wire from the given function.mkPure::(Time->a->(Eithereb,Wireemab))->WireemabmkPure=WPure-- | Construct a pure wire from the given local state transision-- function.mkState::s->(Time->(a,s)->(Eithereb,s))->WireemabmkStates0f=loops0whereloops'=mkPure$\dtx'->let(mx,s)=fdt(x',s')in(mx,loops)-- | Construct a monadic wire from the given local state transision-- function.mkStateM::(Monadm)=>s->(Time->(a,s)->m(Eithereb,s))->WireemabmkStateMs0f=loops0whereloops'=mkGen$\dtx'->liftM(secondloop)(fdt(x',s'))-- | Variant of 'empty' without the 'Monad' constraint. Using 'empty'-- is preferable.never::(Monoide)=>Wireemabnever=mkFix.const.const$Leftmempty-- | Perform an instant of the given wire.stepWire::(Monadm)=>Wireemab->Time->a->m(Eithereb,Wireemab)stepWire(WGenf)dt=fdtstepWire(WPuref)dt=return.fdt-- | Perform an instant of the given pure wire.stepWireP::WireeIdentityab->Time->a->(Eithereb,WireeIdentityab)stepWireP(WGenf)dt=runIdentity.fdtstepWireP(WPuref)dt=fdt