-- |-- Module: Control.Wire.Session-- Copyright: (c) 2012 Ertugrul Soeylemez-- License: BSD3-- Maintainer: Ertugrul Soeylemez <es@ertes.de>---- Wire sessions.moduleControl.Wire.Session(-- * Performing instantsstepSession,stepSession_,stepSessionP,stepSessionP_,-- * Testing wirestestWire,testWireP,-- ** Helper functionstestPrint,-- * SessionsSession(..),-- ** Generic sessionsgenSession,-- ** Specific session typesclockSession,counterSession,frozenSession)whereimportControl.ConcurrentimportControl.ExceptionimportControl.MonadimportControl.Monad.IdentityimportControl.Monad.TransimportControl.Wire.TypesimportControl.Wire.WireimportData.MonoidimportData.Time.ClockimportSystem.IO-- | A session value contains time-related information.newtypeSessionm=Session{sessionUpdate::m(Time,Sessionm)}-- | Construct a session using real time. This session type uses-- 'getCurrentTime'. If you have a faster time source, you may want to-- use 'genSession' instead and construct your own clock.clockSession::(MonadIOm)=>SessionmclockSession=Session$dot0<-liftIOgetCurrentTimereturn(0,loopt0)whereloopt'=Session$dot<-liftIOgetCurrentTimeletdt=realToFrac(diffUTCTimett')return(dt,loopt)-- | Construct a simple counter session. The time delta is the given-- argument at every instant.counterSession::(Monadm)=>Time-- ^ Time delta for every instant.->SessionmcounterSessiondt=lets=Session(return(dt,s))ins-- | Construct a frozen session. Same as @'counterSession' 0@.frozenSession::(Monadm)=>SessionmfrozenSession=counterSession0-- | Construct a generic session from the given initial session value-- and the update function. You can use this function to implement your-- own clock.---- If you just want to use real time, you may want to use-- 'clockSession'.genSession::(Monadm)=>a->(a->m(Time,a))->SessionmgenSessions'f=Session$do(t,s)<-fs'return(t,genSessionsf)-- | Perform an instant of the given wire as part of a wire session.---- This is a convenience function. You can also construct time deltas-- yourself entirely circumventing 'Session'. This can be useful, if-- there is really no need for an effectful monad.stepSession::(MonadIOm)=>Wireemab-- ^ Wire to step.->Sessionm-- ^ Current session state.->a-- ^ Input value.->m(Eithereb,Wireemab,Sessionm)stepSessionw'(Sessionupdate)x'=do(dt,s)<-update(mx,w)<-stepWirew'dtx'mx`seq`return(mx,w,s)-- | Like 'stepSession', but throws an exception instead of returning an-- 'Either' value.stepSession_::(MonadIOm)=>WireMmab-- ^ Wire to step.->Sessionm-- ^ Current session state.->a-- ^ Input value.->m(b,WireMmab,Sessionm)stepSession_w's'x'=do(mx,w,s)<-stepSessionw's'x'letthrowM=liftIO.throwIOemptyErr=toException(userError"empty inhibition signal")x<-either(throwM.maybeemptyErrid.getLast)returnmxreturn(x,w,s)-- | Like 'stepSession', but for pure wires.stepSessionP::(Monadm)=>WireeIdentityab-- ^ Wire to step.->Sessionm-- ^ Current session state.->a-- ^ Input value.->m(Eithereb,WireeIdentityab,Sessionm)stepSessionPw'(Sessionupdate)!x'=do(dt,s)<-updatelet(mx,w)=stepWirePw'dtx'mx`seq`return(mx,w,s)-- | Like 'stepSessionP', but throws an exception instead of returning an-- 'Either' value.stepSessionP_::(MonadIOm)=>WirePab-- ^ Wire to step.->Sessionm-- ^ Current session state.->a-- ^ Input value.->m(b,WirePab,Sessionm)stepSessionP_w's'!x'=do(mx,w,s)<-stepSessionPw's'x'letthrowM=liftIO.throwIOemptyErr=toException(userError"empty inhibition signal")x<-either(throwM.maybeemptyErrid.getLast)returnmxreturn(x,w,s)-- | @testPrint n int mx@ prints a formatted version of @mx@ to stderr,-- if @n@ is zero. It returns @mod (succ n) int@. Requires @n >= 0@ to-- work properly.---- This function is used to implement the /printing interval/ used in-- 'testWire' and 'testWireM'.testPrint::(Showe)=>Int->Int->EithereString->IOInttestPrintn'intmx=doletn=letnn=n'+1inifnn>=intthen0elsennwhen(n'==0)$dohPutStrstderr"\r\027[K"hPutStrstderr(either(("(I) "++).show)idmx)hFlushstderrn`seq`returnn-- | Runs the given wire continuously and prints its result to stderr.-- Runs forever until an exception is raised.---- The /printing interval/ sets the instants/printing ratio. The higher-- this value, the less often the output is printed. Examples: 1000-- means to print at every 1000-th instant, 1 means to print at every-- instant.testWire::forallabem.(MonadIOm,Showe)=>Int-- ^ Printing interval.->Int-- ^ 'threadDelay' between instants.->ma-- ^ Input generator.->Sessionm-- ^ Initial session value.->WireemaString-- ^ Wire to test.->mbtestWireintdelaygetInput=loop0whereloop::Int->Sessionm->WireemaString->mbloopn's'w'=dox'<-getInput(mx,w,s)<-stepSessionw's'x'n<-mx`seq`liftIO(testPrintn'intmx)when(delay>0)(liftIO(threadDelaydelay))loopnsw-- | Like 'testWire', but for pure wires.testWireP::forallabem.(MonadIOm,Showe)=>Int-- ^ Printing interval.->Int-- ^ 'threadDelay' between instants.->ma-- ^ Input generator.->Sessionm-- ^ Initial session value.->WireeIdentityaString-- ^ Wire to test.->mbtestWirePintdelaygetInput=loop0whereloop::Int->Sessionm->WireeIdentityaString->mbloopn's'w'=dox'<-getInput(mx,w,s)<-stepSessionPw's'x'n<-mx`seq`liftIO(testPrintn'intmx)when(delay>0)(liftIO(threadDelaydelay))loopnsw