git.iko.soy/streamly
on ffa84b1 help sign in
streamly/src/Asyncly/Time.hs
64 lines 2.2 kB history raw
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--
11module Asyncly.Time
12 ( periodic
13 , withClock
14 )
15where
17import Control.Monad (when)
18import Control.Concurrent (threadDelay)
20-- | Run an action forever periodically at the given frequency specified in per
21-- second (Hz).
22periodic :: Int -> IO () -> IO ()
23periodic freq action = do
24 action
25 threadDelay (1000000 `div` freq)
26 periodic freq action
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.
35withClock :: IO Int -> Int -> (Int -> IO ()) -> IO ()
36withClock clock freq action = do
37 t <- clock
38 go t period period t 0
40 where
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
48 action localTime
49 when (delay > 0) $ threadDelay delay
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)
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)