{- - ``Control/Monad/Event/Classes'' - (c) 2008 Cook, J. MR SSD, Inc. -} {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} module Control.Monad.Event.Classes where import Control.Monad.Event.Internal.Types import Text.PrettyPrint.Leijen -- |A type-class for monads with a concept of time. That concept need not -- necessarily meet any prior conditions - not even an Eq instance. class Monad m => MonadTime m t | m -> t where getCurrentTime :: m t -- |A monad in which there is a concept of running and not-running and -- unrestricted operations for switching between them. class Monad m => MonadSimControl m where resumeSimulation :: m () pauseSimulation :: m () isSimulationRunning :: m Bool -- |A monad in which there is a concept of an \"event\" - an action with a -- sort of a special status, which can be described for humans and can be -- otherwise manipulated in monads implementing the classes to follow. class Monad m => MonadEvent m e | e -> m where describeEvent :: e -> m Doc describeEvent e = return (text "Undocumented event - implement describeEvent") runEvent :: e -> m () -- | A monad which can schedule events for later execution. For obvious -- reasons, such a monad must also have a concept of events (covering the -- event that the user is trying to schedule) and a concept of time. class (MonadEvent m e, MonadTime m t) => ScheduleEvent m t e | m -> t, e -> m where -- |Schedule an event for execution at a time (relative to the current time). -- The meaning of \"relative to\" is left entirely up to the -- implementor, however it will generally be the case that time is -- an instance of 'Num' and that \"relative to\" means something -- along the lines of \"at now + _\". -- -- Returns an 'EventID' that can be used to identify the event -- if needed later (for example, to cancel it). scheduleEventIn :: t -> e -> m EventID -- |schedule an event to run at the current time. This does not -- constitute a promise to execute immediately or in any particular -- order relative to other events that have been or will be -- scheduled for the current time. -- -- If an implementor has a time type which is an instance of 'Num', then -- 'doNext' should be equivalent to 'scheduleEventIn' 0 - unless the -- monad's documentation clearly warns to the contrary in a really big -- typeface. ; ) Note that this clause may change to also strongly -- suggest that 'doNext' put its event at the very front of the queue -- (ie, before any other events already scheduled for the current time). doNext :: e -> m () -- | A monad in which an event (presumably one previously scheduled) -- can be canceled. class MonadTime m t => CancelEvent m t | m -> t where -- |Cancel an event given its 'EventID'. If successful (and -- if the monad's implementation allows it), an 'EventDescriptor' -- (an existential wrapper describing an event, its ID, and -- the time at which it would have run) containing the -- canceled event is returned. cancelEvent :: EventID -> m (Maybe (EventDescriptor m t)) -- | A monad in which an 'EventDescriptor' for the currently-executing -- event, if any, can be obtained. class MonadTime m t => GetCurrentEvent m t | m -> t where getCurrentEvent :: m (Maybe (EventDescriptor m t)) -- | A monad in which the currently executing event can be rescheduled. -- Note that calling 'retryEventIn' does not terminate the currently -- executing event - although perhaps it should. Until a more permanent -- decision is made, it's probably best to make 'retryEventIn' the last -- action of an event when it is used, to minimize impact of future changes. class MonadTime m t => RetryEvent m t | m -> t where retryEventIn :: t -> m EventID -- |A monad in which information about the event queue can be retrieved. class MonadTime m t => MonadEventQueueInfo m t | m -> t where -- |Return the number of events currently scheduled. eventQueueSize :: m Int -- |Return a list of (some or all of) the events coming up. -- There is no obligation on the part of the monad to provide -- anything at all. eventQueueContents :: m [EventDescriptor m t]