Timers (was Re: [Haskell-cafe] Optimizing a high-traffic network architecture)

[Joel Reymont]

After a chat with Einar on #haskell I realized that I would have,  
say, 4k expiring timers and maybe 12k timers that are started and  
then killed. That would make a 16k element map on which 3/4 of the  
operations are O(n=16k) (Einar).

I need a better abstraction I guess. I also need to be able to find  
timers by id instead of by name like now since each bot will use the  
same timer name for the same operation. I should have starTimer  
return X and then kill the timer using the same X.

I'm looking for suggestions. Here's the improved code:

---
{-# OPTIONS_GHC -fglasgow-exts -fno-cse #-}
module Timer
(
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 $ do mv <- newMVar M.empty
                               forkIO $ checkTimers
                               return mv

--- 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

--- Now runs unblocked
checkTimers :: IO ()
checkTimers =
     do t <- readMVar timers -- takes it and puts it back
        case M.size t of
          -- no timers
          0 -> threadDelay timeout
          -- some timers
          _ -> do let (key@(time, _), io) = M.findMin t
                  now <- getClockTime
                  if (time <= now)
                     then do modifyMVar_ timers $ \a ->
                                 return $! M.delete key a
                             try $ io -- don't think we care
                             return ()
                     else threadDelay timeout
        checkTimers



--
http://wagerlabs.com/