event-monad 0.0.2.0 → 0.0.3

raw patch · 6 files changed

+55/−17 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• event-monad.cabal +1/−1
• src/Control/Monad/Event/BasicEvents.hs +19/−5
• src/Control/Monad/Event/Classes.hs +2/−1
• src/Control/Monad/Event/Internal/Types.hs +7/−1
• src/Control/Monad/EventM.hs +11/−7
• src/Control/Monad/EventT.hs +15/−2

@@ -1,5 +1,5 @@ name:                   event-monad-version:                0.0.2.0+version:                0.0.3 stability:              experimental license:                PublicDomain 

@@ -7,26 +7,35 @@         FlexibleInstances,         ExistentialQuantification,         Rank2Types,-        KindSignatures+        KindSignatures,+        DeriveDataTypeable   #-} -module Control.Monad.Event.BasicEvents where+module Control.Monad.Event.BasicEvents+    ( SimControl(..), AdHocEvent(..)+    , (?:), (?::), (&), (&-), (@:)+    ) where  import Control.Monad.Event.Classes  import Control.Monad.Trans import Text.PrettyPrint.HughesPJ import Text.PrettyPrint.HughesPJClass+import Data.Typeable  {- reified simulation control events -} data SimControl (m :: * -> *) = StopSim | StartSim         deriving (Eq, Show) +tyCon_SimControl = mkTyCon "Control.Monad.Event.BasicEvents.SimControl"+instance Typeable1 m => Typeable (SimControl m) where+    typeOf y = mkTyConApp tyCon_SimControl [typeOf1 ((undefined :: SimControl m -> m ()) y)]+ instance Pretty (SimControl m) where     pPrint StopSim  = text "Stop Simulation"     pPrint StartSim = text "Start Simulation" -instance MonadSimControl m => MonadEvent m (SimControl m) where+instance (MonadSimControl m, Typeable1 m) => MonadEvent m (SimControl m) where         describeEvent e         = return (pPrint e)         runEvent StopSim        = pauseSimulation  >> return ()         runEvent StartSim       = resumeSimulation >> return ()@@ -35,7 +44,12 @@  -- |An event with description and effect supplied at run time data AdHocEvent m = AdHocEvent (m Doc) (m ())-instance Monad m => MonadEvent m (AdHocEvent m) where++tyCon_AdHocEvent = mkTyCon "Control.Monad.Event.BasicEvents.AdHocEvent"+instance Typeable1 m => Typeable (AdHocEvent m) where+    typeOf y = mkTyConApp tyCon_AdHocEvent [typeOf1 ((undefined :: AdHocEvent m -> m ()) y)]++instance (Monad m, Typeable1 m) => MonadEvent m (AdHocEvent m) where         describeEvent (AdHocEvent doc _)        = doc         runEvent (AdHocEvent _ action)          = action @@ -81,7 +95,7 @@ -- newly installed handlers.  infixr 0 &--(&-) :: (ScheduleEvent m t e2, MonadEvent m e1) => e1 -> e2 -> AdHocEvent m+(&-) :: (ScheduleEvent m t e2, MonadEvent m e1, Typeable1 m) => e1 -> e2 -> AdHocEvent m e1 &- e2 = e1 & (describeEvent e2 ?:: doNext e2)  

@@ -10,6 +10,7 @@  import Control.Monad.Event.Internal.Types import Text.PrettyPrint.HughesPJ+import Data.Typeable  -- |A type-class for monads with a concept of time.  That concept need not -- necessarily meet any prior conditions - not even an Eq instance.@@ -26,7 +27,7 @@ -- |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+class (Monad m, Typeable e) => MonadEvent m e | e -> m where         describeEvent   :: e -> m Doc         describeEvent e = return (text "Undocumented event - implement describeEvent")         

@@ -15,6 +15,7 @@ import Control.Monad.Event.Internal.EventID  import Text.Printf -- for the benefit of haddock+import Data.Typeable  -- | An existential wrapper containing an event which can be executed in the -- monad 'm'.@@ -25,9 +26,14 @@ -- not able to use it as a 'PrintfArg' in: --  -- > instance MonadEvent (EventT Double IO) (EventDescriptor (EventT Double IO))-data EventDescriptor (m :: * -> *) t = forall e. ScheduleEvent m t e => EventDescriptor +data EventDescriptor (m :: * -> *) t = +    forall e. ScheduleEvent m t e+    => EventDescriptor          { eventId       :: EventID         , eventTime     :: t         , event         :: e         } +tyCon_EventDescriptor = mkTyCon "Control.Monad.Event.Internal.Types.EventDescriptor"+instance Typeable1 m => Typeable1 (EventDescriptor m) where+    typeOf1 y = mkTyConApp tyCon_EventDescriptor [typeOf1 ((undefined :: EventDescriptor m t -> m ()) y)]

@@ -9,7 +9,8 @@     FlexibleInstances,     UndecidableInstances,     TypeSynonymInstances,-    KindSignatures+    KindSignatures,+    DeriveDataTypeable   #-}  @@ -21,8 +22,10 @@     , runEventGraph     , runEventGraphWithState     +    , EventIOState     , newEventIOState     +    , HandlerAccessor     , onClockChanged     , onEventDispatch     , onEventComplete@@ -42,6 +45,7 @@ import Data.StateRef import Control.Monad.Reader import Control.Monad.Loops+import Data.Typeable  import Text.PrettyPrint.HughesPJ @@ -68,17 +72,17 @@     isSimulationRunning = EventIO (asks simRunning) >>= readReference  {- MonadEvent instance for unadorned (EventIO t) actions -}-instance MonadEvent (EventIO t) (EventIO t a) where+instance (Typeable a, Typeable t) => MonadEvent (EventIO t) (EventIO t a) where     describeEvent e = return (text "Undocumented Event")     runEvent e = e >> return () -instance MonadEvent (EventIO t) (IO a) where+instance (Typeable a, Typeable t) => MonadEvent (EventIO t) (IO a) where     describeEvent e = EventIO . lift . return $ text "Undocumented Event"     runEvent e = EventIO . lift $ (e >> return ())  {- MonadEvent instance for Event Descriptors - this does most of      the real grunt work of running an event  -}-instance Show t => MonadEvent (EventIO t) (EventDescriptor (EventIO t) t) where+instance (Typeable t, Show t) => MonadEvent (EventIO t) (EventDescriptor (EventIO t) t) where     describeEvent (EventDescriptor {eventId = eid, eventTime = t, event = e}) = do         eventDescription <- describeEvent e         return (@@ -167,7 +171,7 @@  type EventM = EventIO Double newtype EventIO t a = EventIO { unWrapEventIO :: ReaderT (EventIOState t) IO a }-    deriving (Functor, Monad, MonadIO, MonadFix)+    deriving (Functor, Monad, MonadIO, MonadFix, Typeable)  {- Running (EventIO t) actions and whole event graphs -} -- |Run an 'EventT' wrapped action.  This is a \"raw\" action - there is no @@ -179,7 +183,7 @@ -- |Repeatedly pull and run the next event in the queue until it's  -- empty or until the simulation is paused using 'pauseSimulation' -- or something equivalent.-runEventGraphWithState :: (Ord t, Show t) => EventIOState t -> IO ()+runEventGraphWithState :: (Ord t, Show t, Typeable t) => EventIOState t -> IO () runEventGraphWithState state = runEventIO (whileJust_ dequeueNextEvent runEvent) state  -- |Initialize the event queue and other stuff, run the provided \"start @@ -187,7 +191,7 @@ -- paused. runEventGraph ::     ( MonadEvent (EventIO t) e-    , Ord t, Num t, Show t+    , Ord t, Num t, Show t, Typeable t     ) => e -> IO (EventIOState t) runEventGraph e = do     state <- newEventIOState 0

@@ -18,9 +18,11 @@     , runEventGraph     , runEventGraphWithState     +    , EventT_RState, EventT_RWState     , newEventT_RState     , newEventT_RWState     +    , HandlerAccessor     , onClockChanged     , onEventDispatch     , onEventComplete@@ -40,6 +42,8 @@ import Control.Monad.RWS import Control.Monad.Loops +import Data.Typeable+ import Text.PrettyPrint.HughesPJ  import IO@@ -79,13 +83,13 @@     isSimulationRunning = EventT (gets simRunning)  {- MonadEvent instance for unadorned (EventT t m) actions -}-instance Monad m => MonadEvent (EventT t m) (EventT t m a) where+instance (Monad m, Typeable (EventT t m a)) => MonadEvent (EventT t m) (EventT t m a) where     describeEvent e = return (text "Undocumented Event")     runEvent e = e >> return ()  {- MonadEvent instance for Event Descriptors - this does most of      the real grunt work of running an event  -}-instance (Monad m, Show t) => MonadEvent (EventT t m) (EventDescriptor (EventT t m) t) where+instance (Monad m, Show t, Typeable t, Typeable1 m) => MonadEvent (EventT t m) (EventDescriptor (EventT t m) t) where     describeEvent (EventDescriptor {eventId = eid, eventTime = t, event = e}) = do         eventDescription <- describeEvent e         return (@@ -157,6 +161,13 @@ newtype EventT t m a = EventT { unWrapEventT :: RWST (EventT_RState t m) () (EventT_RWState t m) m a }     deriving (Functor, Monad, MonadIO) +tyCon_EventT = mkTyCon "Control.Monad.EventT.EventT"+instance (Typeable t, Typeable1 m) => Typeable1 (EventT t m) where+    typeOf1 y = mkTyConApp tyCon_EventT +        [ typeOf  ((undefined :: EventT t m a -> t)    y)+        , typeOf1 ((undefined :: EventT t m a -> m ()) y)+        ]+ instance MonadTrans (EventT t) where     lift = EventT . lift @@ -242,6 +253,7 @@ -- or something equivalent. runEventGraphWithState ::      ( Monad m, Ord t, Show t+    , Typeable t, Typeable1 m     ) => EventT_RState t m -> EventT_RWState t m -> m (EventT_RWState t m) runEventGraphWithState rState rwState = do     (_, rwState) <- runEventT (whileJust_ dequeueNextEvent runEvent) rState rwState@@ -253,6 +265,7 @@ runEventGraph ::     ( Monad m, MonadEvent (EventT t m) e     , Ord t, Num t, Show t+    , Typeable t, Typeable1 m     ) => e -> m (EventT_RState t m, EventT_RWState t m) runEventGraph e = do     let rState  = newEventT_RState