module TimerWheel.Internal.Timestamp
  ( Timestamp (..),
    epoch,
    intoEpoch,
    unsafeMinus,
    plus,
    now,
  )
where

import GHC.Clock (getMonotonicTimeNSec)
import TimerWheel.Internal.Nanoseconds (Nanoseconds (..))
import TimerWheel.Internal.Prelude
import qualified Prelude

-- Monotonic time, in nanoseconds
newtype Timestamp
  = Timestamp Nanoseconds
  deriving stock (Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
/= :: Timestamp -> Timestamp -> Bool
Eq, Eq Timestamp
Eq Timestamp =>
(Timestamp -> Timestamp -> Ordering)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Ord Timestamp
Timestamp -> Timestamp -> Bool
Timestamp -> Timestamp -> Ordering
Timestamp -> Timestamp -> Timestamp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Timestamp -> Timestamp -> Ordering
compare :: Timestamp -> Timestamp -> Ordering
$c< :: Timestamp -> Timestamp -> Bool
< :: Timestamp -> Timestamp -> Bool
$c<= :: Timestamp -> Timestamp -> Bool
<= :: Timestamp -> Timestamp -> Bool
$c> :: Timestamp -> Timestamp -> Bool
> :: Timestamp -> Timestamp -> Bool
$c>= :: Timestamp -> Timestamp -> Bool
>= :: Timestamp -> Timestamp -> Bool
$cmax :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
min :: Timestamp -> Timestamp -> Timestamp
Ord)

-- Which epoch does this correspond to, if they are measured in chunks of the given number of nanoseconds?
epoch :: Nanoseconds -> Timestamp -> Word64
epoch :: Nanoseconds -> Timestamp -> Word64
epoch Nanoseconds
x Timestamp
y =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @Word64 Timestamp
y Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Nanoseconds -> Word64
forall a b. Coercible a b => a -> b
coerce Nanoseconds
x

intoEpoch :: Timestamp -> Nanoseconds -> Nanoseconds
intoEpoch :: Timestamp -> Nanoseconds -> Nanoseconds
intoEpoch =
  (Word64 -> Word64 -> Word64)
-> Timestamp -> Nanoseconds -> Nanoseconds
forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> a -> a
Prelude.rem @Word64)

unsafeMinus :: Timestamp -> Timestamp -> Nanoseconds
unsafeMinus :: Timestamp -> Timestamp -> Nanoseconds
unsafeMinus =
  (Word64 -> Word64 -> Word64)
-> Timestamp -> Timestamp -> Nanoseconds
forall a b. Coercible a b => a -> b
coerce ((-) @Word64)

plus :: Timestamp -> Nanoseconds -> Timestamp
plus :: Timestamp -> Nanoseconds -> Timestamp
plus =
  (Word64 -> Word64 -> Word64)
-> Timestamp -> Nanoseconds -> Timestamp
forall a b. Coercible a b => a -> b
coerce (forall a. Num a => a -> a -> a
(+) @Word64)

now :: IO Timestamp
now :: IO Timestamp
now =
  IO Word64 -> IO Timestamp
forall a b. Coercible a b => a -> b
coerce IO Word64
getMonotonicTimeNSec