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/
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
