wrap-that-timer.hs

{-# LANGUAGE RankNTypes #-}

import qualified GHC.Event

data TimerManager2 = TimerManager2
  { registerTimeout   :: Int -> GHC.Event.TimeoutCallback -> IO GHC.Event.TimeoutKey
  , updateTimeout     :: GHC.Event.TimeoutKey -> Int -> IO ()
  , unregisterTimeout :: GHC.Event.TimeoutKey -> IO ()
  }

newTimeoutManager2 :: IO TimerManager2
newTimeoutManager2 = do
  tm <- GHC.Event.getSystemTimerManager
  return $! TimerManager2 (GHC.Event.registerTimeout tm) (GHC.Event.updateTimeout tm) (GHC.Event.unregisterTimeout tm)

test :: IO ()
test = do
  tm2 <- newTimeoutManager2
  timeoutKey <- registerTimeout tm2 1000 (error "timeout callback")
  unregisterTimeout tm2 timeoutKey