-- |
-- Module      : Streamly.Internal.Data.Time.Clock
-- Copyright   : (c) 2021 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : pre-release
-- Portability : GHC

module Streamly.Internal.Data.Time.Clock
    (
    -- * System clock
      Clock(..)
    , getTime

    -- * Async clock
    , asyncClock
    , readClock
    )
where

import Control.Concurrent (threadDelay, ThreadId)
import Control.Monad (forever)
import Streamly.Internal.Data.Time.Clock.Type (Clock(..), getTime)
import Streamly.Internal.Data.Time.Units (MicroSecond64(..), fromAbsTime)
import Streamly.Internal.Control.Concurrent (forkManaged)

import qualified Streamly.Internal.Data.IORef.Prim as Prim


------------------------------------------------------------------------------
-- Async clock
------------------------------------------------------------------------------

{-# INLINE updateTimeVar #-}
updateTimeVar :: Clock -> Prim.IORef MicroSecond64 -> IO ()
updateTimeVar :: Clock -> IORef MicroSecond64 -> IO ()
updateTimeVar Clock
clock IORef MicroSecond64
timeVar = do
    MicroSecond64
t <- AbsTime -> MicroSecond64
forall a. TimeUnit a => AbsTime -> a
fromAbsTime (AbsTime -> MicroSecond64) -> IO AbsTime -> IO MicroSecond64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO AbsTime
getTime Clock
clock
    IORef MicroSecond64 -> (MicroSecond64 -> MicroSecond64) -> IO ()
forall a. Prim a => IORef a -> (a -> a) -> IO ()
Prim.modifyIORef' IORef MicroSecond64
timeVar (MicroSecond64 -> MicroSecond64 -> MicroSecond64
forall a b. a -> b -> a
const MicroSecond64
t)

{-# INLINE updateWithDelay #-}
updateWithDelay :: RealFrac a =>
    Clock -> a -> Prim.IORef MicroSecond64 -> IO ()
updateWithDelay :: Clock -> a -> IORef MicroSecond64 -> IO ()
updateWithDelay Clock
clock a
precision IORef MicroSecond64
timeVar = do
    Int -> IO ()
threadDelay (a -> Int
forall p a. (Bounded p, RealFrac a, Integral p) => a -> p
delayTime a
precision)
    Clock -> IORef MicroSecond64 -> IO ()
updateTimeVar Clock
clock IORef MicroSecond64
timeVar

    where

    -- Keep the minimum at least a millisecond to avoid high CPU usage
    {-# INLINE delayTime #-}
    delayTime :: a -> p
delayTime a
g
        | a
g' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int) = p
forall a. Bounded a => a
maxBound
        | a
g' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000 = p
1000
        | Bool
otherwise = a -> p
forall a b. (RealFrac a, Integral b) => a -> b
round a
g'

        where

        g' :: a
g' = a
g a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
6 :: Int)

-- | @asyncClock g@ starts a clock thread that updates an IORef with current
-- time as a 64-bit value in microseconds, every 'g' seconds. The IORef can be
-- read asynchronously.  The thread exits automatically when the reference to
-- the returned 'ThreadId' is lost.
--
-- Minimum granularity of clock update is 1 ms. Higher is better for
-- performance.
--
-- CAUTION! This is safe only on a 64-bit machine. On a 32-bit machine a 64-bit
-- 'Var' cannot be read consistently without a lock while another thread is
-- writing to it.
asyncClock :: Clock -> Double -> IO (ThreadId, Prim.IORef MicroSecond64)
asyncClock :: Clock -> Double -> IO (ThreadId, IORef MicroSecond64)
asyncClock Clock
clock Double
g = do
    IORef MicroSecond64
timeVar <- MicroSecond64 -> IO (IORef MicroSecond64)
forall a. Prim a => a -> IO (IORef a)
Prim.newIORef MicroSecond64
0
    Clock -> IORef MicroSecond64 -> IO ()
updateTimeVar Clock
clock IORef MicroSecond64
timeVar
    ThreadId
tid <- IO () -> IO ThreadId
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m) =>
m () -> m ThreadId
forkManaged (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Clock -> Double -> IORef MicroSecond64 -> IO ()
forall a. RealFrac a => Clock -> a -> IORef MicroSecond64 -> IO ()
updateWithDelay Clock
clock Double
g IORef MicroSecond64
timeVar)
    (ThreadId, IORef MicroSecond64)
-> IO (ThreadId, IORef MicroSecond64)
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId
tid, IORef MicroSecond64
timeVar)

{-# INLINE readClock #-}
readClock :: (ThreadId, Prim.IORef MicroSecond64) -> IO MicroSecond64
readClock :: (ThreadId, IORef MicroSecond64) -> IO MicroSecond64
readClock (ThreadId
_, IORef MicroSecond64
timeVar) = IORef MicroSecond64 -> IO MicroSecond64
forall a. Prim a => IORef a -> IO a
Prim.readIORef IORef MicroSecond64
timeVar