@@ -0,0 +1,64 @@
1+-- |
2+-- Module : Asyncly.Time
3+-- Copyright : (c) 2017 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : harendra.kumar@gmail.com
7+-- Stability : experimental
8+-- Portability : GHC
9+--
10+
11+module Asyncly.Time
12+ ( periodic
13+ , withClock
14+ )
15+where
16+
17+import Control.Monad (when)
18+import Control.Concurrent (threadDelay)
19+
20+-- | Run an action forever periodically at the given frequency specified in per
21+-- second (Hz).
22+periodic :: Int -> IO () -> IO ()
23+periodic freq action = do
24+ action
25+ threadDelay (1000000 `div` freq)
26+ periodic freq action
27+
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
37+ t <- clock
38+ go t period period t 0
39+
40+ where
41+
42+ period = 1000000 `div` freq
43+
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
48+ action localTime
49+ when (delay > 0) $ threadDelay delay
50+
51+ if (n == freq)
52+ then do
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)
56+
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
60+ baseTime <- clock
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)