module Nanotime
  ( TimeDelta (..)
  , timeDeltaFromFracSecs
  , timeDeltaFromNanos
  , timeDeltaToFracSecs
  , timeDeltaToNanos
  , diffTimeDelta
  , threadDelayDelta
  , TimeLike (..)
  , awaitDelta
  , PosixTime (..)
  , MonoTime (..)
  , monoTimeToFracSecs
  , monoTimeToNanos
  , monoTimeFromFracSecs
  , monoTimeFromNanos
  , NtpTime (..)
  , posixToNtp
  , ntpToPosix
  , assertingNonNegative
  )
where

import Control.Concurrent (threadDelay)
import Data.Bits (Bits (..))
import Data.Fixed (Fixed (..), Pico)
import Data.Semigroup (Sum (..))
import Data.Time.Clock (nominalDiffTimeToSeconds)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Word (Word32, Word64)
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)

assertingNonNegative :: (HasCallStack, Ord a, Num a, Show a) => a -> a
assertingNonNegative :: forall a. (HasCallStack, Ord a, Num a, Show a) => a -> a
assertingNonNegative a
a =
  if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
    then [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"Required non-negative value but got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
a)
    else a
a

-- | Non-negative time difference in nanoseconds since last event
-- Like a 'Nano' (`Fixed E9`) but a machine word.
newtype TimeDelta = TimeDelta {TimeDelta -> Word64
unTimeDelta :: Word64}
  deriving stock (TimeDelta -> TimeDelta -> Bool
(TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool) -> Eq TimeDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeDelta -> TimeDelta -> Bool
== :: TimeDelta -> TimeDelta -> Bool
$c/= :: TimeDelta -> TimeDelta -> Bool
/= :: TimeDelta -> TimeDelta -> Bool
Eq, Int -> TimeDelta -> [Char] -> [Char]
[TimeDelta] -> [Char] -> [Char]
TimeDelta -> [Char]
(Int -> TimeDelta -> [Char] -> [Char])
-> (TimeDelta -> [Char])
-> ([TimeDelta] -> [Char] -> [Char])
-> Show TimeDelta
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> TimeDelta -> [Char] -> [Char]
showsPrec :: Int -> TimeDelta -> [Char] -> [Char]
$cshow :: TimeDelta -> [Char]
show :: TimeDelta -> [Char]
$cshowList :: [TimeDelta] -> [Char] -> [Char]
showList :: [TimeDelta] -> [Char] -> [Char]
Show, Eq TimeDelta
Eq TimeDelta =>
(TimeDelta -> TimeDelta -> Ordering)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> Bool)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> Ord TimeDelta
TimeDelta -> TimeDelta -> Bool
TimeDelta -> TimeDelta -> Ordering
TimeDelta -> TimeDelta -> TimeDelta
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 :: TimeDelta -> TimeDelta -> Ordering
compare :: TimeDelta -> TimeDelta -> Ordering
$c< :: TimeDelta -> TimeDelta -> Bool
< :: TimeDelta -> TimeDelta -> Bool
$c<= :: TimeDelta -> TimeDelta -> Bool
<= :: TimeDelta -> TimeDelta -> Bool
$c> :: TimeDelta -> TimeDelta -> Bool
> :: TimeDelta -> TimeDelta -> Bool
$c>= :: TimeDelta -> TimeDelta -> Bool
>= :: TimeDelta -> TimeDelta -> Bool
$cmax :: TimeDelta -> TimeDelta -> TimeDelta
max :: TimeDelta -> TimeDelta -> TimeDelta
$cmin :: TimeDelta -> TimeDelta -> TimeDelta
min :: TimeDelta -> TimeDelta -> TimeDelta
Ord, (forall x. TimeDelta -> Rep TimeDelta x)
-> (forall x. Rep TimeDelta x -> TimeDelta) -> Generic TimeDelta
forall x. Rep TimeDelta x -> TimeDelta
forall x. TimeDelta -> Rep TimeDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeDelta -> Rep TimeDelta x
from :: forall x. TimeDelta -> Rep TimeDelta x
$cto :: forall x. Rep TimeDelta x -> TimeDelta
to :: forall x. Rep TimeDelta x -> TimeDelta
Generic, TimeDelta
TimeDelta -> TimeDelta -> Bounded TimeDelta
forall a. a -> a -> Bounded a
$cminBound :: TimeDelta
minBound :: TimeDelta
$cmaxBound :: TimeDelta
maxBound :: TimeDelta
Bounded)
  deriving newtype (Integer -> TimeDelta
TimeDelta -> TimeDelta
TimeDelta -> TimeDelta -> TimeDelta
(TimeDelta -> TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta)
-> (TimeDelta -> TimeDelta)
-> (Integer -> TimeDelta)
-> Num TimeDelta
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TimeDelta -> TimeDelta -> TimeDelta
+ :: TimeDelta -> TimeDelta -> TimeDelta
$c- :: TimeDelta -> TimeDelta -> TimeDelta
- :: TimeDelta -> TimeDelta -> TimeDelta
$c* :: TimeDelta -> TimeDelta -> TimeDelta
* :: TimeDelta -> TimeDelta -> TimeDelta
$cnegate :: TimeDelta -> TimeDelta
negate :: TimeDelta -> TimeDelta
$cabs :: TimeDelta -> TimeDelta
abs :: TimeDelta -> TimeDelta
$csignum :: TimeDelta -> TimeDelta
signum :: TimeDelta -> TimeDelta
$cfromInteger :: Integer -> TimeDelta
fromInteger :: Integer -> TimeDelta
Num)
  deriving (NonEmpty TimeDelta -> TimeDelta
TimeDelta -> TimeDelta -> TimeDelta
(TimeDelta -> TimeDelta -> TimeDelta)
-> (NonEmpty TimeDelta -> TimeDelta)
-> (forall b. Integral b => b -> TimeDelta -> TimeDelta)
-> Semigroup TimeDelta
forall b. Integral b => b -> TimeDelta -> TimeDelta
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TimeDelta -> TimeDelta -> TimeDelta
<> :: TimeDelta -> TimeDelta -> TimeDelta
$csconcat :: NonEmpty TimeDelta -> TimeDelta
sconcat :: NonEmpty TimeDelta -> TimeDelta
$cstimes :: forall b. Integral b => b -> TimeDelta -> TimeDelta
stimes :: forall b. Integral b => b -> TimeDelta -> TimeDelta
Semigroup, Semigroup TimeDelta
TimeDelta
Semigroup TimeDelta =>
TimeDelta
-> (TimeDelta -> TimeDelta -> TimeDelta)
-> ([TimeDelta] -> TimeDelta)
-> Monoid TimeDelta
[TimeDelta] -> TimeDelta
TimeDelta -> TimeDelta -> TimeDelta
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: TimeDelta
mempty :: TimeDelta
$cmappend :: TimeDelta -> TimeDelta -> TimeDelta
mappend :: TimeDelta -> TimeDelta -> TimeDelta
$cmconcat :: [TimeDelta] -> TimeDelta
mconcat :: [TimeDelta] -> TimeDelta
Monoid) via (Sum Word64)

-- | Return a 'TimeDelta' corresponding the the given number of fractional seconds.
-- (For example, 1.5 represents one and a half seconds.)
timeDeltaFromFracSecs :: (Real a, Show a) => a -> TimeDelta
timeDeltaFromFracSecs :: forall a. (Real a, Show a) => a -> TimeDelta
timeDeltaFromFracSecs a
d = Word64 -> TimeDelta
TimeDelta (Rational -> Word64
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
1000000000 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* a -> Rational
forall a. Real a => a -> Rational
toRational (a -> a
forall a. (HasCallStack, Ord a, Num a, Show a) => a -> a
assertingNonNegative a
d)))

-- | Return a 'TimeDelta' corresponding the the given number of nanoseconds.
-- (For example, 1000000000 represends one second.)
timeDeltaFromNanos :: (Integral a, Show a) => a -> TimeDelta
timeDeltaFromNanos :: forall a. (Integral a, Show a) => a -> TimeDelta
timeDeltaFromNanos = Word64 -> TimeDelta
TimeDelta (Word64 -> TimeDelta) -> (a -> Word64) -> a -> TimeDelta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word64) -> (a -> a) -> a -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. (HasCallStack, Ord a, Num a, Show a) => a -> a
assertingNonNegative

timeDeltaToFracSecs :: (Fractional a) => TimeDelta -> a
timeDeltaToFracSecs :: forall a. Fractional a => TimeDelta -> a
timeDeltaToFracSecs (TimeDelta Word64
n) = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000000

timeDeltaToNanos :: TimeDelta -> Word64
timeDeltaToNanos :: TimeDelta -> Word64
timeDeltaToNanos = TimeDelta -> Word64
unTimeDelta

-- | Return the difference of two time deltas
diffTimeDelta
  :: TimeDelta
  -- ^ the "larger" delta
  -> TimeDelta
  -- ^ the "smaller" delta
  -> Maybe TimeDelta
  -- ^ difference between the two (Nothing if negative)
diffTimeDelta :: TimeDelta -> TimeDelta -> Maybe TimeDelta
diffTimeDelta (TimeDelta Word64
big) (TimeDelta Word64
small) =
  if Word64
big Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
small
    then Maybe TimeDelta
forall a. Maybe a
Nothing
    else TimeDelta -> Maybe TimeDelta
forall a. a -> Maybe a
Just (Word64 -> TimeDelta
TimeDelta (Word64
big Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
small))

threadDelayDelta :: TimeDelta -> IO ()
threadDelayDelta :: TimeDelta -> IO ()
threadDelayDelta (TimeDelta Word64
td) = Int -> IO ()
threadDelay (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
div Word64
td Word64
1000))

class (Ord t) => TimeLike t where
  diffTime :: t -> t -> Maybe TimeDelta
  addTime :: t -> TimeDelta -> t
  currentTime :: IO t

awaitDelta :: (TimeLike t) => t -> TimeDelta -> IO t
awaitDelta :: forall t. TimeLike t => t -> TimeDelta -> IO t
awaitDelta t
m TimeDelta
t = do
  let target :: t
target = t -> TimeDelta -> t
forall t. TimeLike t => t -> TimeDelta -> t
addTime t
m TimeDelta
t
  t
cur <- IO t
forall t. TimeLike t => IO t
currentTime
  case t -> t -> Maybe TimeDelta
forall t. TimeLike t => t -> t -> Maybe TimeDelta
diffTime t
target t
cur of
    Maybe TimeDelta
Nothing -> t -> IO t
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
cur
    Just TimeDelta
td -> t
target t -> IO () -> IO t
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TimeDelta -> IO ()
threadDelayDelta TimeDelta
td

newtype PosixTime = PosixTime {PosixTime -> Word64
unPosixTime :: Word64}
  deriving stock (PosixTime -> PosixTime -> Bool
(PosixTime -> PosixTime -> Bool)
-> (PosixTime -> PosixTime -> Bool) -> Eq PosixTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PosixTime -> PosixTime -> Bool
== :: PosixTime -> PosixTime -> Bool
$c/= :: PosixTime -> PosixTime -> Bool
/= :: PosixTime -> PosixTime -> Bool
Eq, Int -> PosixTime -> [Char] -> [Char]
[PosixTime] -> [Char] -> [Char]
PosixTime -> [Char]
(Int -> PosixTime -> [Char] -> [Char])
-> (PosixTime -> [Char])
-> ([PosixTime] -> [Char] -> [Char])
-> Show PosixTime
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> PosixTime -> [Char] -> [Char]
showsPrec :: Int -> PosixTime -> [Char] -> [Char]
$cshow :: PosixTime -> [Char]
show :: PosixTime -> [Char]
$cshowList :: [PosixTime] -> [Char] -> [Char]
showList :: [PosixTime] -> [Char] -> [Char]
Show, Eq PosixTime
Eq PosixTime =>
(PosixTime -> PosixTime -> Ordering)
-> (PosixTime -> PosixTime -> Bool)
-> (PosixTime -> PosixTime -> Bool)
-> (PosixTime -> PosixTime -> Bool)
-> (PosixTime -> PosixTime -> Bool)
-> (PosixTime -> PosixTime -> PosixTime)
-> (PosixTime -> PosixTime -> PosixTime)
-> Ord PosixTime
PosixTime -> PosixTime -> Bool
PosixTime -> PosixTime -> Ordering
PosixTime -> PosixTime -> PosixTime
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 :: PosixTime -> PosixTime -> Ordering
compare :: PosixTime -> PosixTime -> Ordering
$c< :: PosixTime -> PosixTime -> Bool
< :: PosixTime -> PosixTime -> Bool
$c<= :: PosixTime -> PosixTime -> Bool
<= :: PosixTime -> PosixTime -> Bool
$c> :: PosixTime -> PosixTime -> Bool
> :: PosixTime -> PosixTime -> Bool
$c>= :: PosixTime -> PosixTime -> Bool
>= :: PosixTime -> PosixTime -> Bool
$cmax :: PosixTime -> PosixTime -> PosixTime
max :: PosixTime -> PosixTime -> PosixTime
$cmin :: PosixTime -> PosixTime -> PosixTime
min :: PosixTime -> PosixTime -> PosixTime
Ord, (forall x. PosixTime -> Rep PosixTime x)
-> (forall x. Rep PosixTime x -> PosixTime) -> Generic PosixTime
forall x. Rep PosixTime x -> PosixTime
forall x. PosixTime -> Rep PosixTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PosixTime -> Rep PosixTime x
from :: forall x. PosixTime -> Rep PosixTime x
$cto :: forall x. Rep PosixTime x -> PosixTime
to :: forall x. Rep PosixTime x -> PosixTime
Generic, PosixTime
PosixTime -> PosixTime -> Bounded PosixTime
forall a. a -> a -> Bounded a
$cminBound :: PosixTime
minBound :: PosixTime
$cmaxBound :: PosixTime
maxBound :: PosixTime
Bounded)

e9W :: Word64
e9W :: Word64
e9W = Word64
1000000000

picoToNanoWord :: Pico -> Word64
picoToNanoWord :: Pico -> Word64
picoToNanoWord (MkFixed Integer
i) = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
i Integer
1000)

picoFromNanoWord :: Word64 -> Pico
picoFromNanoWord :: Word64 -> Pico
picoFromNanoWord Word64
j = Integer -> Pico
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
j)

instance TimeLike PosixTime where
  diffTime :: PosixTime -> PosixTime -> Maybe TimeDelta
diffTime (PosixTime Word64
t2) (PosixTime Word64
t1) =
    if Word64
t2 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
t1 then Maybe TimeDelta
forall a. Maybe a
Nothing else TimeDelta -> Maybe TimeDelta
forall a. a -> Maybe a
Just (Word64 -> TimeDelta
TimeDelta (Word64
t2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
t1))
  addTime :: PosixTime -> TimeDelta -> PosixTime
addTime (PosixTime Word64
t) (TimeDelta Word64
d) = Word64 -> PosixTime
PosixTime (Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
d)
  currentTime :: IO PosixTime
currentTime = (NominalDiffTime -> PosixTime)
-> IO NominalDiffTime -> IO PosixTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> PosixTime
PosixTime (Word64 -> PosixTime)
-> (NominalDiffTime -> Word64) -> NominalDiffTime -> PosixTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Word64
picoToNanoWord (Pico -> Word64)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Pico
nominalDiffTimeToSeconds) IO NominalDiffTime
getPOSIXTime

-- | Monotonic time in nanoseconds since some unspecified epoch (see 'getMonotonicTimeNs')
newtype MonoTime = MonoTime {MonoTime -> Word64
unMonoTime :: Word64}
  deriving stock (MonoTime -> MonoTime -> Bool
(MonoTime -> MonoTime -> Bool)
-> (MonoTime -> MonoTime -> Bool) -> Eq MonoTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonoTime -> MonoTime -> Bool
== :: MonoTime -> MonoTime -> Bool
$c/= :: MonoTime -> MonoTime -> Bool
/= :: MonoTime -> MonoTime -> Bool
Eq, Int -> MonoTime -> [Char] -> [Char]
[MonoTime] -> [Char] -> [Char]
MonoTime -> [Char]
(Int -> MonoTime -> [Char] -> [Char])
-> (MonoTime -> [Char])
-> ([MonoTime] -> [Char] -> [Char])
-> Show MonoTime
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> MonoTime -> [Char] -> [Char]
showsPrec :: Int -> MonoTime -> [Char] -> [Char]
$cshow :: MonoTime -> [Char]
show :: MonoTime -> [Char]
$cshowList :: [MonoTime] -> [Char] -> [Char]
showList :: [MonoTime] -> [Char] -> [Char]
Show, Eq MonoTime
Eq MonoTime =>
(MonoTime -> MonoTime -> Ordering)
-> (MonoTime -> MonoTime -> Bool)
-> (MonoTime -> MonoTime -> Bool)
-> (MonoTime -> MonoTime -> Bool)
-> (MonoTime -> MonoTime -> Bool)
-> (MonoTime -> MonoTime -> MonoTime)
-> (MonoTime -> MonoTime -> MonoTime)
-> Ord MonoTime
MonoTime -> MonoTime -> Bool
MonoTime -> MonoTime -> Ordering
MonoTime -> MonoTime -> MonoTime
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 :: MonoTime -> MonoTime -> Ordering
compare :: MonoTime -> MonoTime -> Ordering
$c< :: MonoTime -> MonoTime -> Bool
< :: MonoTime -> MonoTime -> Bool
$c<= :: MonoTime -> MonoTime -> Bool
<= :: MonoTime -> MonoTime -> Bool
$c> :: MonoTime -> MonoTime -> Bool
> :: MonoTime -> MonoTime -> Bool
$c>= :: MonoTime -> MonoTime -> Bool
>= :: MonoTime -> MonoTime -> Bool
$cmax :: MonoTime -> MonoTime -> MonoTime
max :: MonoTime -> MonoTime -> MonoTime
$cmin :: MonoTime -> MonoTime -> MonoTime
min :: MonoTime -> MonoTime -> MonoTime
Ord, (forall x. MonoTime -> Rep MonoTime x)
-> (forall x. Rep MonoTime x -> MonoTime) -> Generic MonoTime
forall x. Rep MonoTime x -> MonoTime
forall x. MonoTime -> Rep MonoTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonoTime -> Rep MonoTime x
from :: forall x. MonoTime -> Rep MonoTime x
$cto :: forall x. Rep MonoTime x -> MonoTime
to :: forall x. Rep MonoTime x -> MonoTime
Generic, MonoTime
MonoTime -> MonoTime -> Bounded MonoTime
forall a. a -> a -> Bounded a
$cminBound :: MonoTime
minBound :: MonoTime
$cmaxBound :: MonoTime
maxBound :: MonoTime
Bounded)

monoTimeFromFracSecs :: (Real a, Show a) => a -> MonoTime
monoTimeFromFracSecs :: forall a. (Real a, Show a) => a -> MonoTime
monoTimeFromFracSecs a
d = Word64 -> MonoTime
MonoTime (Rational -> Word64
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
1000000000 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* a -> Rational
forall a. Real a => a -> Rational
toRational (a -> a
forall a. (HasCallStack, Ord a, Num a, Show a) => a -> a
assertingNonNegative a
d)))

monoTimeFromNanos :: (Integral a, Show a) => a -> MonoTime
monoTimeFromNanos :: forall a. (Integral a, Show a) => a -> MonoTime
monoTimeFromNanos = Word64 -> MonoTime
MonoTime (Word64 -> MonoTime) -> (a -> Word64) -> a -> MonoTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word64) -> (a -> a) -> a -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. (HasCallStack, Ord a, Num a, Show a) => a -> a
assertingNonNegative

monoTimeToFracSecs :: (Fractional a) => MonoTime -> a
monoTimeToFracSecs :: forall a. Fractional a => MonoTime -> a
monoTimeToFracSecs (MonoTime Word64
n) = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000000

monoTimeToNanos :: MonoTime -> Word64
monoTimeToNanos :: MonoTime -> Word64
monoTimeToNanos = MonoTime -> Word64
unMonoTime

instance TimeLike MonoTime where
  diffTime :: MonoTime -> MonoTime -> Maybe TimeDelta
diffTime (MonoTime Word64
t2) (MonoTime Word64
t1) =
    if Word64
t2 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
t1 then Maybe TimeDelta
forall a. Maybe a
Nothing else TimeDelta -> Maybe TimeDelta
forall a. a -> Maybe a
Just (Word64 -> TimeDelta
TimeDelta (Word64
t2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
t1))
  addTime :: MonoTime -> TimeDelta -> MonoTime
addTime (MonoTime Word64
t) (TimeDelta Word64
d) = Word64 -> MonoTime
MonoTime (Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
d)
  currentTime :: IO MonoTime
currentTime = (Word64 -> MonoTime) -> IO Word64 -> IO MonoTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> MonoTime
MonoTime IO Word64
getMonotonicTimeNSec

newtype NtpTime = NtpTime {NtpTime -> Word64
unNtpTime :: Word64}
  deriving stock (NtpTime -> NtpTime -> Bool
(NtpTime -> NtpTime -> Bool)
-> (NtpTime -> NtpTime -> Bool) -> Eq NtpTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NtpTime -> NtpTime -> Bool
== :: NtpTime -> NtpTime -> Bool
$c/= :: NtpTime -> NtpTime -> Bool
/= :: NtpTime -> NtpTime -> Bool
Eq, Int -> NtpTime -> [Char] -> [Char]
[NtpTime] -> [Char] -> [Char]
NtpTime -> [Char]
(Int -> NtpTime -> [Char] -> [Char])
-> (NtpTime -> [Char])
-> ([NtpTime] -> [Char] -> [Char])
-> Show NtpTime
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> NtpTime -> [Char] -> [Char]
showsPrec :: Int -> NtpTime -> [Char] -> [Char]
$cshow :: NtpTime -> [Char]
show :: NtpTime -> [Char]
$cshowList :: [NtpTime] -> [Char] -> [Char]
showList :: [NtpTime] -> [Char] -> [Char]
Show, Eq NtpTime
Eq NtpTime =>
(NtpTime -> NtpTime -> Ordering)
-> (NtpTime -> NtpTime -> Bool)
-> (NtpTime -> NtpTime -> Bool)
-> (NtpTime -> NtpTime -> Bool)
-> (NtpTime -> NtpTime -> Bool)
-> (NtpTime -> NtpTime -> NtpTime)
-> (NtpTime -> NtpTime -> NtpTime)
-> Ord NtpTime
NtpTime -> NtpTime -> Bool
NtpTime -> NtpTime -> Ordering
NtpTime -> NtpTime -> NtpTime
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 :: NtpTime -> NtpTime -> Ordering
compare :: NtpTime -> NtpTime -> Ordering
$c< :: NtpTime -> NtpTime -> Bool
< :: NtpTime -> NtpTime -> Bool
$c<= :: NtpTime -> NtpTime -> Bool
<= :: NtpTime -> NtpTime -> Bool
$c> :: NtpTime -> NtpTime -> Bool
> :: NtpTime -> NtpTime -> Bool
$c>= :: NtpTime -> NtpTime -> Bool
>= :: NtpTime -> NtpTime -> Bool
$cmax :: NtpTime -> NtpTime -> NtpTime
max :: NtpTime -> NtpTime -> NtpTime
$cmin :: NtpTime -> NtpTime -> NtpTime
min :: NtpTime -> NtpTime -> NtpTime
Ord, (forall x. NtpTime -> Rep NtpTime x)
-> (forall x. Rep NtpTime x -> NtpTime) -> Generic NtpTime
forall x. Rep NtpTime x -> NtpTime
forall x. NtpTime -> Rep NtpTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NtpTime -> Rep NtpTime x
from :: forall x. NtpTime -> Rep NtpTime x
$cto :: forall x. Rep NtpTime x -> NtpTime
to :: forall x. Rep NtpTime x -> NtpTime
Generic, NtpTime
NtpTime -> NtpTime -> Bounded NtpTime
forall a. a -> a -> Bounded a
$cminBound :: NtpTime
minBound :: NtpTime
$cmaxBound :: NtpTime
maxBound :: NtpTime
Bounded)

nanoWordToSplit :: Word64 -> (Word32, Word32)
nanoWordToSplit :: Word64 -> (Word32, Word32)
nanoWordToSplit Word64
j =
  let whole :: Word64
whole = Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
div Word64
j Word64
e9W
      part :: Word64
part = Word64
j Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
e9W Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
whole
  in  (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
whole, Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
part)

nanoWordFromSplit :: Word32 -> Word32 -> Word64
nanoWordFromSplit :: Word32 -> Word32 -> Word64
nanoWordFromSplit Word32
whole Word32
part = Word64
e9W Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
whole Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
part

ntpFromSplit :: Word32 -> Word32 -> NtpTime
ntpFromSplit :: Word32 -> Word32 -> NtpTime
ntpFromSplit Word32
whole Word32
part = Word64 -> NtpTime
NtpTime (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
whole) Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
part)

ntpToSplit :: NtpTime -> (Word32, Word32)
ntpToSplit :: NtpTime -> (Word32, Word32)
ntpToSplit (NtpTime Word64
k) = (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
k Int
32), Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
k)

-- Difference in nano seconds between 1/1/1900 and 1/1/1970
-- 1900 is the NTP epoch, 1970 is the unix epoch
ntpEpochDiffSeconds :: Word32
ntpEpochDiffSeconds :: Word32
ntpEpochDiffSeconds = Word32
2208988800

posixToNtp :: PosixTime -> NtpTime
posixToNtp :: PosixTime -> NtpTime
posixToNtp (PosixTime Word64
j) =
  let (Word32
whole, Word32
part) = Word64 -> (Word32, Word32)
nanoWordToSplit Word64
j
      whole' :: Word32
whole' = Word32
whole Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
ntpEpochDiffSeconds
  in  Word32 -> Word32 -> NtpTime
ntpFromSplit Word32
whole' Word32
part

ntpToPosix :: NtpTime -> PosixTime
ntpToPosix :: NtpTime -> PosixTime
ntpToPosix NtpTime
k =
  let (Word32
whole, Word32
part) = NtpTime -> (Word32, Word32)
ntpToSplit NtpTime
k
      whole' :: Word32
whole' = Word32
whole Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
ntpEpochDiffSeconds
  in  Word64 -> PosixTime
PosixTime (Word32 -> Word32 -> Word64
nanoWordFromSplit Word32
whole' Word32
part)

-- Probably best to do time arithmetic directly on PosixTime
instance TimeLike NtpTime where
  diffTime :: NtpTime -> NtpTime -> Maybe TimeDelta
diffTime NtpTime
n2 NtpTime
n1 = PosixTime -> PosixTime -> Maybe TimeDelta
forall t. TimeLike t => t -> t -> Maybe TimeDelta
diffTime (NtpTime -> PosixTime
ntpToPosix NtpTime
n2) (NtpTime -> PosixTime
ntpToPosix NtpTime
n1)
  addTime :: NtpTime -> TimeDelta -> NtpTime
addTime NtpTime
n TimeDelta
d = PosixTime -> NtpTime
posixToNtp (PosixTime -> TimeDelta -> PosixTime
forall t. TimeLike t => t -> TimeDelta -> t
addTime (NtpTime -> PosixTime
ntpToPosix NtpTime
n) TimeDelta
d)
  currentTime :: IO NtpTime
currentTime = (PosixTime -> NtpTime) -> IO PosixTime -> IO NtpTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PosixTime -> NtpTime
posixToNtp IO PosixTime
forall t. TimeLike t => IO t
currentTime