Skip to content
Find file
55 lines (46 sloc) 1.59 KB
module Timer (
Timer
, startTimer
, stopTimer
, getPOSIXTime
) where
import Control.Concurrent
import Control.Monad (when)
import Data.Time.Clock.POSIX
newtype Timer = Timer (MVar Bool)
-- | Start a timer.
--
-- Call given action repeatedly with the passed time since the timer has been
-- started, adjusted by a given offset. The action is called every second;
-- whenever (passed + offset) is close to (truncate $ passed + offset).
startTimer :: POSIXTime -- ^ start time
-> Double -- ^ offset in seconds
-> (Double -> IO ())
-> IO Timer
startTimer t0 s0 action = do
m <- newMVar True
_ <- forkIO $ run t0 (realToFrac s0) (action . realToFrac) m
return (Timer m)
-- | Run until False is put into the MVar.
run :: POSIXTime -> POSIXTime -> (POSIXTime -> IO ()) -> MVar Bool -> IO ()
run t0 s0 action m = go
where
go = do
t1 <- getPOSIXTime
let s_current = s0 + (t1 - t0)
-- Increase s_next to the next full second.
s_next = fromIntegral (ceiling (s_current + 0.001) :: Int)
sleep (s_next - s_current)
isRunning <- takeMVar m
when (isRunning) $ do
-- add 0.001 as a tiebreaker to make sure that `truncate` will work as
-- expected
action (s_next + 0.001)
putMVar m isRunning
go
-- | Like `threadDelay`, but takes the delay in seconds.
sleep :: POSIXTime -> IO ()
sleep s = threadDelay $ round (s * 1000000)
-- | Stop timer; block until the timer is stopped.
stopTimer :: Timer -> IO ()
stopTimer (Timer m) = takeMVar m >> putMVar m False
Jump to Line
Something went wrong with that request. Please try again.