@@ -0,0 +1,64 @@
2+-- Module : Asyncly.Time
3+-- Copyright : (c) 2017 Harendra Kumar
6+-- Maintainer : harendra.kumar@gmail.com
7+-- Stability : experimental
17+import Control.Monad (when)
18+import Control.Concurrent (threadDelay)
20+-- | Run an action forever periodically at the given frequency specified in per
22+periodic :: Int -> IO () -> IO ()
23+periodic freq action = do
25+ threadDelay (1000000 `div` freq)
28+-- | Run a computation on every clock tick, the clock runs at the specified
29+-- frequency. It allows running a computation at high frequency efficiently by
30+-- maintaining a local clock and adjusting it with the provided base clock at
31+-- longer intervals. The first argument is a base clock returning some notion
32+-- of time in microseconds. The second argument is the frequency in per second
33+-- (Hz). The third argument is the action to run, the action is provided the
34+-- local time as an argument.
35+withClock :: IO Int -> Int -> (Int -> IO ()) -> IO ()
36+withClock clock freq action = do
38+ go t period period t 0
42+ period = 1000000 `div` freq
44+ -- Note that localTime is roughly but not exactly equal to (lastAdj + tick
45+ -- * n). That is because we do not abruptly adjust the clock skew instead
46+ -- we adjust the tick size.
47+ go lastAdj delay tick localTime n = do
49+ when (delay > 0) $ threadDelay delay
53+ (t, newTick, newDelay) <- adjustClock lastAdj localTime delay
54+ go t newDelay newTick (localTime + newTick) 0
55+ else go lastAdj delay tick (localTime + tick) (n + 1)
57+ -- Adjust the tick size rather than the clock to avoid abrupt changes
58+ -- resulting in jittery behavior at the end of every interval.
59+ adjustClock lastAdj localTime delay = do
61+ let newTick = period + (baseTime - localTime) `div` freq
62+ lastPeriod = (baseTime - lastAdj) `div` freq
63+ newDelay = max 0 (delay + period - lastPeriod)
64+ return (baseTime, newTick, newDelay)