git.iko.soy/streamly
on e95e149 help sign in
streamly/src/Streamly/Internal/Data/Time/Clock.hs
80 lines 2.6 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Time.Clock
3-- Copyright : (c) 2021 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9module Streamly.Internal.Data.Time.Clock
10 (
11 -- * System clock
12 Clock(..)
13 , getTime
15 -- * Async clock
16 , asyncClock
17 , readClock
18 )
19where
21import Control.Concurrent (threadDelay, ThreadId)
22import Control.Monad (forever)
23import Streamly.Internal.Data.Time.Clock.Type (Clock(..), getTime)
24import Streamly.Internal.Data.Time.Units (MicroSecond64(..), fromAbsTime)
25import Streamly.Internal.Control.Concurrent (forkManaged)
27import qualified Streamly.Internal.Data.IORef.Prim as Prim
30------------------------------------------------------------------------------
31-- Async clock
32------------------------------------------------------------------------------
34{-# INLINE updateTimeVar #-}
35updateTimeVar :: Clock -> Prim.IORef MicroSecond64 -> IO ()
36updateTimeVar clock timeVar = do
37 t <- fromAbsTime <$> getTime clock
38 Prim.modifyIORef' timeVar (const t)
40{-# INLINE updateWithDelay #-}
41updateWithDelay :: RealFrac a =>
42 Clock -> a -> Prim.IORef MicroSecond64 -> IO ()
43updateWithDelay clock precision timeVar = do
44 threadDelay (delayTime precision)
45 updateTimeVar clock timeVar
47 where
49 -- Keep the minimum at least a millisecond to avoid high CPU usage
50 {-# INLINE delayTime #-}
51 delayTime g
52 | g' >= fromIntegral (maxBound :: Int) = maxBound
53 | g' < 1000 = 1000
54 | otherwise = round g'
56 where
58 g' = g * 10 ^ (6 :: Int)
60-- | @asyncClock g@ starts a clock thread that updates an IORef with current
61-- time as a 64-bit value in microseconds, every 'g' seconds. The IORef can be
62-- read asynchronously. The thread exits automatically when the reference to
63-- the returned 'ThreadId' is lost.
64--
65-- Minimum granularity of clock update is 1 ms. Higher is better for
66-- performance.
67--
68-- CAUTION! This is safe only on a 64-bit machine. On a 32-bit machine a 64-bit
69-- 'Var' cannot be read consistently without a lock while another thread is
70-- writing to it.
71asyncClock :: Clock -> Double -> IO (ThreadId, Prim.IORef MicroSecond64)
72asyncClock clock g = do
73 timeVar <- Prim.newIORef 0
74 updateTimeVar clock timeVar
75 tid <- forkManaged $ forever (updateWithDelay clock g timeVar)
76 return (tid, timeVar)
78{-# INLINE readClock #-}
79readClock :: (ThreadId, Prim.IORef MicroSecond64) -> IO MicroSecond64
80readClock (_, timeVar) = Prim.readIORef timeVar