Relative.hs

-- |This module uses Haskell concurrency libraries to build an extremely simple
-- event system that should perform better than the Control.Event module
-- but does not provide features such as STM action scheduling.
module Control.Event.Relative
	( EventId
	, addEvent
	, delEvent
	) where

import Prelude hiding (catch)
import Control.Concurrent
import Control.Exception
import Control.Monad (when)
import Control.Concurrent.MVar

type EventId = (ThreadId, MVar Bool)

-- |'addEvent delay action' will delay
-- for 'delay' microseconds then execute 'action'. An EventId
-- is returned, allowing the event to be canceled.
addEvent :: Int -> IO () -> IO EventId
addEvent delay event = do
	m <- newMVar False
	t <- forkIO (eventThread m)
	return (t,m)
  where
    eventThread m = do
        threadDelay delay
        forkIO $ runThread m
	return ()
    runThread m = do
        b <- swapMVar m True
        when (not b) event


-- |'delEvent eid' deletes the event and returns
-- 'True' if the event was deleted.  If 'False' is returned
-- then the time elapsed and the action was forked off.
delEvent :: EventId -> IO Bool
delEvent (t,m) = do
    b <- takeMVar m
    when (not b) (killThread t)
    putMVar m True
    return (not b)