control-event 1.2.1.0 → 1.2.1.1
raw patch · 2 files changed
+36/−36 lines, 2 filesdep ~containersdep ~stmdep ~time
Dependency ranges changed: containers, stm, time
Files
- Control/Event.hs +32/−32
- control-event.cabal +4/−4
Control/Event.hs view
@@ -3,16 +3,16 @@ -- requiring later IO actions. For a simpler system that uses relative times -- see Control.Event.Relative module Control.Event (- EventId- ,EventSystem- ,noEvent- ,initEventSystem- ,addEvent- ,addEventSTM- ,cancelEvent- ,cancelEventSTM- ,evtSystemSize- ) where+ EventId+ ,EventSystem+ ,noEvent+ ,initEventSystem+ ,addEvent+ ,addEventSTM+ ,cancelEvent+ ,cancelEventSTM+ ,evtSystemSize+ ) where import Prelude hiding (lookup, catch) import Control.Concurrent (forkIO, myThreadId, ThreadId, threadDelay)@@ -75,10 +75,10 @@ -- earlier, alarm time. expireEvents :: EventSystem -> IO () expireEvents es = do- block (do- tid <- myThreadId- forever $ catch (unblock (setTID (Just tid) es >> expireEvents' es))- (\TimerReset -> return ()) )+ block (do+ tid <- myThreadId+ forever $ catch (unblock (setTID (Just tid) es >> expireEvents' es))+ (\TimerReset -> return ()) ) where setTID i es = atomically (writeTVar (esThread es) i) @@ -113,17 +113,17 @@ writeTVar (esAlarm evtSys) newAlarm writeTVar (esEvents evtSys) newMap exps <- readTVar (esExpired evtSys)- writeTVar (esExpired evtSys) (exp:exps) )+ writeTVar (esExpired evtSys) (exp:exps) ) where getEarlierKeys :: UTCTime -> Map UTCTime EventSet -> ([EventSet], Map UTCTime EventSet) getEarlierKeys clk m = case deleteFindMinM m of Just ((k,es), m') ->- if k < clk- then let (exp, lastMap) = getEarlierKeys clk m'- in (es:exp, lastMap)- else ([], m)- Nothing -> ([], m)+ if k < clk+ then let (exp, lastMap) = getEarlierKeys clk m'+ in (es:exp, lastMap)+ else ([], m)+ Nothing -> ([], m) getAlarm m | size m == 0 = never | otherwise = fst $ findMin m@@ -136,9 +136,9 @@ monitorExpiredQueue exp = do exp <- atomically (do e <- readTVar exp- case e of- (a:as) -> writeTVar exp [] >> return e- _ -> retry )+ case e of+ (a:as) -> writeTVar exp [] >> return e+ _ -> retry ) mapM_ (mapM_ runEvents) exp -- |Runs all provided events (which must have expired)@@ -159,7 +159,7 @@ num = case old of Nothing -> 0 Just (n,_) -> n- eid = EvtId clk num + eid = EvtId clk num writeTVar (esEvents sys) newMap alm <- readTVar (esAlarm sys) when (clk < alm || alm == never)@@ -183,10 +183,10 @@ prev :: Maybe EventSet (prev,newMap) = insertLookupWithKey (\_ _ (cnt, old) -> (cnt,delete num old)) clk undefined evts ret = case prev of- Nothing -> False -- error "Canceling an event that never existed."- Just (_,p) -> case lookup clk newMap of- Nothing -> False- Just (_,m) -> (size p /= size m)+ Nothing -> False -- error "Canceling an event that never existed."+ Just (_,p) -> case lookup clk newMap of+ Nothing -> False+ Just (_,m) -> (size p /= size m) when (eid /= noEvent) (writeTVar (esEvents sys) newMap) return (eid == noEvent || ret) @@ -202,12 +202,12 @@ trackAlarm sys = do tid <- atomically (do newAlm <- readTVar (esNewAlarm sys)- if newAlm then writeTVar (esNewAlarm sys) False else retry+ if newAlm then writeTVar (esNewAlarm sys) False else retry tid <- readTVar (esThread sys)- i <- case tid of- Just i -> return i- Nothing -> retry+ i <- case tid of+ Just i -> return i+ Nothing -> retry return i ) throwTo tid TimerReset
control-event.cabal view
@@ -1,5 +1,5 @@ name: control-event-version: 1.2.1.0+version: 1.2.1.1 synopsis: Event scheduling system. description: Allows scheduling and canceling of IO actions to be executed at a specified future time.@@ -16,8 +16,8 @@ Library build-Depends: base >= 4.0 && < 5,- time >= 1.1 && < 1.3,- containers >= 0.1 && < 0.5,- stm >= 2.1 && < 2.3+ time >= 1.1,+ containers >= 0.1,+ stm >= 2.1 extensions: DeriveDataTypeable exposed-modules: Control.Event, Control.Event.Timeout, Control.Event.Relative