On Dec 14, 2005, at 7:48 PM, Tomasz Zielonka wrote:
You don't have to check "every few seconds". You can determine exactly how much you have to sleep - just check the timeout/event with the lowest ClockTime.
Something like this? Comments are welcome! It would be cool to not have to export and call initTimers somehow. --- {-# OPTIONS_GHC -fglasgow-exts -fno-cse #-} module Timer ( initTimers, startTimer, stopTimer ) where import qualified Data.Map as M import System.Time import System.IO.Unsafe import Control.Exception import Control.Concurrent --- Map timer name and kick-off time to action type Timers = M.Map (ClockTime, String) (IO ()) timeout :: Int timeout = 5000000 -- 1 second {-# NOINLINE timers #-} timers :: MVar Timers timers = unsafePerformIO $ newMVar M.empty --- Call this first initTimers :: IO () initTimers = do forkIO $ block checkTimers return () --- Not sure if this is the most efficient way to do it startTimer :: String -> Int -> (IO ()) -> IO () startTimer name delay io = do stopTimer name now <- getClockTime let plus = TimeDiff 0 0 0 0 0 delay 0 future = addToClockTime plus now block $ do t <- takeMVar timers putMVar timers $ M.insert (future, name) io t --- The filter expression is kind of long... stopTimer :: String -> IO () stopTimer name = block $ do t <- takeMVar timers putMVar timers $ M.filterWithKey (\(_, k) _ -> k /= name) t --- Tried to take care of exceptions here --- but the code looks kind of ugly checkTimers :: IO () checkTimers = do t <- takeMVar timers case M.size t of -- no timers 0 -> do putMVar timers t unblock $ threadDelay timeout -- some timers n -> do let (key@(time, name), io) = M.findMin t now <- getClockTime if (time <= now) then do putMVar timers $ M.delete key t unblock io else do putMVar timers t unblock $ threadDelay timeout checkTimers -- http://wagerlabs.com/