event-monad 0.0.1.0 → 0.0.2.0

raw patch · 2 files changed

+40/−23 lines, 2 filesdep ~basedep ~priority-queuedep ~staterefPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, priority-queue, stateref

API changes (from Hackage documentation)

Files

• event-monad.cabal +4/−4
• src/Control/Monad/EventM.hs +36/−19

@@ -1,5 +1,5 @@ name:                   event-monad-version:                0.0.1.0+version:                0.0.2.0 stability:              experimental license:                PublicDomain @@ -28,7 +28,7 @@                         Control.Monad.EventM   other-modules:        Control.Monad.Event.Internal.Types                         Control.Monad.Event.Internal.EventID-  build-depends:        base >= 3, +  build-depends:        base >= 3 && <5,                          containers,                          event-handlers >= 0.0.0.2,                          haskell98,@@ -36,5 +36,5 @@                         mtl,                          pretty,                         prettyclass,-                        priority-queue >= 0.1.2, -                        stateref >= 0.2.1.1+                        priority-queue >= 0.2, +                        stateref >= 0.3 && <0.4

@@ -47,13 +47,13 @@  {- Time management -} instance MonadTime (EventIO t) t where-    getCurrentTime = EventIO (asks currentTime) >>= readRef+    getCurrentTime = EventIO (asks currentTime) >>= readReference  {- Time Management (internal) -} setCurrentTime :: t -> EventIO t () setCurrentTime t1 = do     state <- EventIO ask-    t0 <- atomicModifyRef (currentTime state) (\t0 -> (t1, t0))+    t0 <- atomicModifyReference (currentTime state) (\t0 -> (t1, t0))          invokeHandler onClockChanged (t0,t1) @@ -61,11 +61,11 @@ instance MonadSimControl (EventIO t) where     resumeSimulation = do         state <- EventIO ask-        writeRef (simRunning state) True+        writeReference (simRunning state) True     pauseSimulation = do         state <- EventIO ask-        writeRef (simRunning state) False-    isSimulationRunning = EventIO (asks simRunning) >>= readRef+        writeReference (simRunning state) False+    isSimulationRunning = EventIO (asks simRunning) >>= readReference  {- MonadEvent instance for unadorned (EventIO t) actions -} instance MonadEvent (EventIO t) (EventIO t a) where@@ -147,7 +147,24 @@ -- Several hooks are provided to allow special handling of various events, -- such as the progression of time, the scheduling or canceling or dispatch -- of an event, etc.-instance DefaultStateRef (TVar a) (EventIO t) a+instance HasRef (EventIO t) where+    newRef x = fmap Ref ((newReference :: a -> EventIO t (IORef a)) x)++instance NewRef    (Ref IO a) (EventIO t) a where+    newReference = liftIO . newRef+instance ReadRef   (Ref IO a) (EventIO t) a where+    readReference = liftIO . readReference+instance WriteRef  (Ref IO a) (EventIO t) a where+    writeReference r = liftIO . writeReference r+instance ModifyRef (Ref IO a) (EventIO t) a where+    modifyReference r = liftIO . modifyReference r+    atomicModifyReference r = liftIO . atomicModifyReference r++instance NewRef    (Ref (EventIO t) a) IO a where+    newReference x = do+        r <- newReference x `asTypeOf` (undefined :: IO (IORef a))+        return (Ref r)+ type EventM = EventIO Double newtype EventIO t a = EventIO { unWrapEventIO :: ReaderT (EventIOState t) IO a }     deriving (Functor, Monad, MonadIO, MonadFix)@@ -183,9 +200,9 @@ {- the main state vectors -} data EventIOState t = EventIOState     { currentEvent  :: Maybe (EventDescriptor (EventIO t) t)-    , currentTime   :: TVar t-    , simRunning    :: TVar Bool-    , nextEventId   :: TVar EventID+    , currentTime   :: Ref IO t+    , simRunning    :: Ref IO Bool+    , nextEventId   :: Ref IO EventID     , eventQueue    :: EventQueue t     , handlers      :: EventIOHandlers t     }@@ -211,18 +228,18 @@ getNextEventId :: EventIO t EventID getNextEventId = do     state <- EventIO ask-    atomicModifyRef (nextEventId state) (\i -> (succ i, i))+    atomicModifyReference (nextEventId state) (\i -> (succ i, i))  {- Support for debugging event handlers -} data EventIOHandlers t = EventIOHandlers-    { onEventSchedule  :: TVar (HandlerSet (EventIO t) (EventDescriptor (EventIO t) t) ())-    , onEventCancel    :: TVar (HandlerSet (EventIO t) (Either EventID (EventDescriptor (EventIO t) t)) ())-    , onEventDispatch  :: TVar (HandlerSet (EventIO t) (EventDescriptor (EventIO t) t) ())-    , onEventComplete  :: TVar (HandlerSet (EventIO t) (EventDescriptor (EventIO t) t) ())-    , onClockChanged   :: TVar (HandlerSet (EventIO t) (t, t) ()) -- (old time, new time)+    { onEventSchedule  :: Ref IO (HandlerSet (EventIO t) (EventDescriptor (EventIO t) t) ())+    , onEventCancel    :: Ref IO (HandlerSet (EventIO t) (Either EventID (EventDescriptor (EventIO t) t)) ())+    , onEventDispatch  :: Ref IO (HandlerSet (EventIO t) (EventDescriptor (EventIO t) t) ())+    , onEventComplete  :: Ref IO (HandlerSet (EventIO t) (EventDescriptor (EventIO t) t) ())+    , onClockChanged   :: Ref IO (HandlerSet (EventIO t) (t, t) ()) -- (old time, new time)     } -type HandlerAccessor t a b = EventIOHandlers t -> TVar (HandlerSet (EventIO t) a b)+type HandlerAccessor t a b = EventIOHandlers t -> Ref IO (HandlerSet (EventIO t) a b)  newEventIOHandlers :: IO (EventIOHandlers t) newEventIOHandlers = do@@ -243,17 +260,17 @@ addHandler :: HandlerAccessor t a b -> (a -> EventIO t b) -> EventIO t HandlerID addHandler hSel h = do     hSet <- EventIO (asks (hSel.handlers))-    atomicModifyRef hSet (addHandlerToSet h)+    atomicModifyReference hSet (addHandlerToSet h)  -- |Remove an event handler given its ID, and return it if it was in the set. removeHandler :: HandlerAccessor t a b -> HandlerID -> EventIO t (Maybe (a -> EventIO t b)) removeHandler hSel hId = do     hSet <- EventIO (asks (hSel.handlers))-    atomicModifyRef hSet (removeHandlerFromSet hId)+    atomicModifyReference hSet (removeHandlerFromSet hId)  invokeHandler :: HandlerAccessor t a b -> a -> EventIO t b invokeHandler h args = do-    hSet <- EventIO (asks (h.handlers)) >>= readRef+    hSet <- EventIO (asks (h.handlers)) >>= readReference     invokeHandlers hSet args