Proposal: Add newTimeoutKey and insertTimeout to System.Event

[Bas van Dijk]

Hello,

I would like to propose adding and exporting the following functions
from System.Event.Manager and also export them from System.Event:

-- | Returns a unique 'TimeoutKey' that can be used by 'insertTimeout'.
newTimeoutKey :: EventManager -> IO TimeoutKey
newTimeoutKey = fmap TK . newUnique . emUniqueSource

-- | Like 'registerTimeout' but registers the timeout in the given number of
-- microseconds /at the specified key/ in the event manager. If the key was
-- already present the associated timeout is replaced with the given timeout.
-- Unique keys can be created using 'newTimeoutKey'.
insertTimeout :: EventManager -> TimeoutKey -> Int -> TimeoutCallback -> IO ()
insertTimeout mgr (TK key) us cb = do
  expTime <- fromNow us
  -- We intentionally do not evaluate the modified map to WHNF here.
  -- Instead, we leave a thunk inside the IORef and defer its
  -- evaluation until mkTimeout in the event loop.  This is a
  -- workaround for a nasty IORef contention problem that causes the
  -- thread-delay benchmark to take 20 seconds instead of 0.2.
  atomicModifyIORef (emTimeouts mgr) $ \f ->
      let f' = (Q.insert key expTime cb) . f in (f', ())
  wakeManager mgr

'fromNow' is an internal utility function defined as:

-- | @fromNow us@ returns the time in seconds @us@ microseconds from now.
fromNow :: Int -> IO Double
fromNow us = do
  now <- getCurrentTime
  return $ fromIntegral us / 1000000.0 + now

The existing registerTimeout can be rewritten in terms of these:

registerTimeout :: EventManager -> Int -> TimeoutCallback -> IO TimeoutKey
registerTimeout mgr us cb = do
  !tk <- newTimeoutKey mgr
  if us <= 0
    then cb
    else insertTimeout mgr tk us cb
  return tk

The reason I would like to have these is that with them I can write
more efficient resettable timeouts. A resettable timeout API looks
something like this:

data Key
register :: EventManager -> Int -> TimeoutCallback -> IO Key
pause :: Key -> IO ()
reset :: Key -> IO ()
cancel :: Key -> IO ()

'register mgr us cb' registers a callback 'cb' with the event manager
'mgr' to fire after 'us' microseconds. It returns a key which can be
used to control the timeout. When 'pause' is called on a key,
belonging to a timeout which hasn't fired yet, the timeout is
suspended indefinitely until it is reset or canceled. When 'reset' is
called on a key, belonging to a timeout which hasn't fired yet, the
timeout period will be extended with at least the original period.
'cancel' removes the timeout from the event manager.

The Warp web-server contains one implementation of resettable timeouts:

https://github.com/snoyberg/warp/blob/master/Timeout.hs

Note that their API is a bit more restricted but the idea is the same.
The implementation uses one thread which runs a loop which delays for
the timeout period then processes all the registered timeouts.
Registered timeouts are put in a list and stored in an IORef.

With the proposed additional functions for System.Event I can write a
simpler (and hopefully slightly more efficient) implementation of
resettable timeouts which don't need to forkIO and don't need to store
timeouts in a list:

https://github.com/basvandijk/resettable-timeouts/blob/master/System/Timeout/Resettable/ADT.hs

I also wrote a CPS-like version:

https://github.com/basvandijk/resettable-timeouts/blob/master/System/Timeout/Resettable/CPS.hs

Discussion deadline: 2 weeks.

A patch for base is attached.

Regards,

Bas
-------------- next part --------------
A non-text attachment was scrubbed...
Name: timeouts.dpatch
Type: application/octet-stream
Size: 72993 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/libraries/attachments/20110316/d551123f/attachment-0001.obj>