{-
- ``Control/Monad/Event/BasicEvents''
-}{-# LANGUAGE
MultiParamTypeClasses,
FunctionalDependencies,
FlexibleInstances,
ExistentialQuantification,
Rank2Types,
KindSignatures
#-}moduleControl.Monad.Event.BasicEventswhereimportControl.Monad.Event.ClassesimportControl.Monad.TransimportText.PrettyPrint.HughesPJimportText.PrettyPrint.HughesPJClass{- reified simulation control events -}dataSimControl(m::*->*)=StopSim|StartSimderiving(Eq,Show)instancePretty(SimControlm)wherepPrintStopSim=text"Stop Simulation"pPrintStartSim=text"Start Simulation"instanceMonadSimControlm=>MonadEventm(SimControlm)wheredescribeEvente=return(pPrinte)runEventStopSim=pauseSimulation>>return()runEventStartSim=resumeSimulation>>return()-- |An event with description and effect supplied at run timedataAdHocEventm=AdHocEvent(mDoc)(m())instanceMonadm=>MonadEventm(AdHocEventm)wheredescribeEvent(AdHocEventdoc_)=docrunEvent(AdHocEvent_action)=action-- |An infix operator to construct an event from a description and an actioninfixr2?:(?:)::(Monadm,Prettydesc)=>desc->ma->AdHocEventmdescription?:action=AdHocEvent(return(pPrintdescription))(action>>return())-- |Same thing, but use an action to generate the descriptioninfixr2?::(?::)::(Monadm)=>mDoc->ma->AdHocEventmdescription?::action=AdHocEvent(description)(action>>return())-- |An infix operator for sequential composition of eventsinfixr0&(&)::(MonadEventme1,MonadEventme2)=>e1->e2->AdHocEventme1&e2=doc?::e3wheredoc=dod1<-describeEvente1d2<-describeEvente2return(fsep[d1,d2])e3=dorunEvente1runEvente2-- |A version of '&' that preserves distinctness of events-- at the expense of being able to guarantee \"proper\" interleaving-- with other events scheduled at the same time. For example, suppose a-- composite event e1 &- e2 of this type is scheduled, then a third-- event e3 is scheduled for the same time. The \"expected\" order of-- execution is e1; e2; e3. What actually happens is e1; e3; e2 - -- because (e1 &- e2) runs, having the effect of running e1 and -- scheduling e2, then e3 runs (because it's next in the queue),-- then e2 finally runs. This situation could be solved by changing-- the semantics for 'doNext' as proposed there.-- -- This is primarily useful for separating an initial 'SetDebugHandlers'-- event from the other event(s) being fired at the start-- of the simulation, so that they will be \"seen\" by the -- newly installed handlers.infixr0&-(&-)::(ScheduleEventmte2,MonadEventme1)=>e1->e2->AdHocEventme1&-e2=e1&(describeEvente2?::doNexte2)-- |An infix operator for defining a \"delayed\" event - or rather a -- new event that schedules its payload at a later timeinfixr1@:(@:)::(ScheduleEventmte,Prettyt,Numt)=>e->t->AdHocEventme@:t=doc?::scheduleEventIntewheredoc=dodescription<-describeEventereturn(parens(text"@"<+>text"+"<>pPrintt)<>colon<+>description)