module Nanotime
( Sign (..)
, TimeDelta (..)
, timeDeltaFromFracSecs
, timeDeltaFromNanos
, timeDeltaToFracSecs
, timeDeltaToNanos
, threadDelayDelta
, showTimeDelta
, TimeLike (..)
, awaitDelta
, PosixTime (..)
, showPosixTime
, MonoTime (..)
, monoTimeToFracSecs
, monoTimeToNanos
, monoTimeFromFracSecs
, monoTimeFromNanos
, NtpTime (..)
, posixToNtp
, ntpToPosix
)
where
import Control.Concurrent (threadDelay)
import Data.Bits (Bits (..))
import Data.Fixed (Fixed (..), Pico)
import Data.Ratio ((%))
import Data.Time.Clock (nominalDiffTimeToSeconds)
import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Word (Word32, Word64)
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Stack (HasCallStack)
import Numeric (showFFloat)
data Sign = SignNeg | SignPos
deriving stock (Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
/= :: Sign -> Sign -> Bool
Eq, Eq Sign
Eq Sign =>
(Sign -> Sign -> Ordering)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Bool)
-> (Sign -> Sign -> Sign)
-> (Sign -> Sign -> Sign)
-> Ord Sign
Sign -> Sign -> Bool
Sign -> Sign -> Ordering
Sign -> Sign -> Sign
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 :: Sign -> Sign -> Ordering
compare :: Sign -> Sign -> Ordering
$c< :: Sign -> Sign -> Bool
< :: Sign -> Sign -> Bool
$c<= :: Sign -> Sign -> Bool
<= :: Sign -> Sign -> Bool
$c> :: Sign -> Sign -> Bool
> :: Sign -> Sign -> Bool
$c>= :: Sign -> Sign -> Bool
>= :: Sign -> Sign -> Bool
$cmax :: Sign -> Sign -> Sign
max :: Sign -> Sign -> Sign
$cmin :: Sign -> Sign -> Sign
min :: Sign -> Sign -> Sign
Ord, Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sign -> ShowS
showsPrec :: Int -> Sign -> ShowS
$cshow :: Sign -> String
show :: Sign -> String
$cshowList :: [Sign] -> ShowS
showList :: [Sign] -> ShowS
Show, Int -> Sign
Sign -> Int
Sign -> [Sign]
Sign -> Sign
Sign -> Sign -> [Sign]
Sign -> Sign -> Sign -> [Sign]
(Sign -> Sign)
-> (Sign -> Sign)
-> (Int -> Sign)
-> (Sign -> Int)
-> (Sign -> [Sign])
-> (Sign -> Sign -> [Sign])
-> (Sign -> Sign -> [Sign])
-> (Sign -> Sign -> Sign -> [Sign])
-> Enum Sign
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Sign -> Sign
succ :: Sign -> Sign
$cpred :: Sign -> Sign
pred :: Sign -> Sign
$ctoEnum :: Int -> Sign
toEnum :: Int -> Sign
$cfromEnum :: Sign -> Int
fromEnum :: Sign -> Int
$cenumFrom :: Sign -> [Sign]
enumFrom :: Sign -> [Sign]
$cenumFromThen :: Sign -> Sign -> [Sign]
enumFromThen :: Sign -> Sign -> [Sign]
$cenumFromTo :: Sign -> Sign -> [Sign]
enumFromTo :: Sign -> Sign -> [Sign]
$cenumFromThenTo :: Sign -> Sign -> Sign -> [Sign]
enumFromThenTo :: Sign -> Sign -> Sign -> [Sign]
Enum, Sign
Sign -> Sign -> Bounded Sign
forall a. a -> a -> Bounded a
$cminBound :: Sign
minBound :: Sign
$cmaxBound :: Sign
maxBound :: Sign
Bounded)
data TimeDelta = TimeDelta
{ TimeDelta -> Sign
tdSign :: !Sign
, TimeDelta -> Word64
tdMag :: !Word64
}
deriving stock (Int -> TimeDelta -> ShowS
[TimeDelta] -> ShowS
TimeDelta -> String
(Int -> TimeDelta -> ShowS)
-> (TimeDelta -> String)
-> ([TimeDelta] -> ShowS)
-> Show TimeDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeDelta -> ShowS
showsPrec :: Int -> TimeDelta -> ShowS
$cshow :: TimeDelta -> String
show :: TimeDelta -> String
$cshowList :: [TimeDelta] -> ShowS
showList :: [TimeDelta] -> ShowS
Show)
instance Eq TimeDelta where
TimeDelta Sign
s1 Word64
m1 == :: TimeDelta -> TimeDelta -> Bool
== TimeDelta Sign
s2 Word64
m2 =
(Word64
m1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&& Word64
m2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) Bool -> Bool -> Bool
|| (Sign
s1 Sign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
== Sign
s2 Bool -> Bool -> Bool
&& Word64
m1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
m2)
instance Ord TimeDelta where
compare :: TimeDelta -> TimeDelta -> Ordering
compare (TimeDelta Sign
s1 Word64
m1) (TimeDelta Sign
s2 Word64
m2) =
if Word64
m1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&& Word64
m2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
then Ordering
EQ
else case Sign
s1 of
Sign
SignPos ->
case Sign
s2 of
Sign
SignPos -> Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
m1 Word64
m2
Sign
SignNeg -> Ordering
GT
Sign
SignNeg ->
case Sign
s2 of
Sign
SignPos -> Ordering
LT
Sign
SignNeg -> Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
m2 Word64
m1
instance Bounded TimeDelta where
minBound :: TimeDelta
minBound = Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignNeg Word64
forall a. Bounded a => a
maxBound
maxBound :: TimeDelta
maxBound = Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos Word64
forall a. Bounded a => a
maxBound
instance Semigroup TimeDelta where
td1 :: TimeDelta
td1@(TimeDelta Sign
s1 Word64
m1) <> :: TimeDelta -> TimeDelta -> TimeDelta
<> td2 :: TimeDelta
td2@(TimeDelta Sign
s2 Word64
m2) =
if
| Word64
m1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 -> TimeDelta
td2
| Word64
m2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 -> TimeDelta
td1
| Sign
s1 Sign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
== Sign
s2 -> Sign -> Word64 -> TimeDelta
mkTimeDelta Sign
s1 (Word64
m1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
m2)
| Bool
otherwise ->
if Word64
m1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
m2
then Sign -> Word64 -> TimeDelta
mkTimeDelta Sign
s1 (Word64
m1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
m2)
else Sign -> Word64 -> TimeDelta
mkTimeDelta Sign
s2 (Word64
m2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
m1)
instance Monoid TimeDelta where
mempty :: TimeDelta
mempty = Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos Word64
0
instance Num TimeDelta where
+ :: TimeDelta -> TimeDelta -> TimeDelta
(+) = TimeDelta -> TimeDelta -> TimeDelta
forall a. Semigroup a => a -> a -> a
(<>)
* :: TimeDelta -> TimeDelta -> TimeDelta
(*) = String -> TimeDelta -> TimeDelta -> TimeDelta
forall a. HasCallStack => String -> a
error String
"TimeDelta multiplication has no meaning"
abs :: TimeDelta -> TimeDelta
abs (TimeDelta Sign
_ Word64
m) = Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos Word64
m
signum :: TimeDelta -> TimeDelta
signum (TimeDelta Sign
s Word64
m) =
if Word64
m Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
then TimeDelta
0
else case Sign
s of
Sign
SignPos -> TimeDelta
1
Sign
SignNeg -> -TimeDelta
1
fromInteger :: Integer -> TimeDelta
fromInteger Integer
i =
if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
then Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i)
else Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignNeg (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i))
negate :: TimeDelta -> TimeDelta
negate td :: TimeDelta
td@(TimeDelta Sign
s Word64
m) =
if Word64
m Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&& Sign
s Sign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
== Sign
SignPos
then TimeDelta
td
else case Sign
s of
Sign
SignPos -> Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignNeg Word64
m
Sign
SignNeg -> Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos Word64
m
mkTimeDelta :: Sign -> Word64 -> TimeDelta
mkTimeDelta :: Sign -> Word64 -> TimeDelta
mkTimeDelta Sign
s Word64
m =
if Word64
m Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
then Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos Word64
m
else Sign -> Word64 -> TimeDelta
TimeDelta Sign
s Word64
m
timeDeltaFromFracSecs :: (Real a) => a -> TimeDelta
timeDeltaFromFracSecs :: forall a. Real a => a -> TimeDelta
timeDeltaFromFracSecs a
d =
if a
d a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
then Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos (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
d))
else Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignNeg (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. Num a => a -> a
negate a
d)))
timeDeltaFromNanos :: (Integral a) => a -> TimeDelta
timeDeltaFromNanos :: forall a. Integral a => a -> TimeDelta
timeDeltaFromNanos = a -> TimeDelta
forall a b. (Integral a, Num b) => a -> b
fromIntegral
timeDeltaFromDiff :: Word64 -> Word64 -> TimeDelta
timeDeltaFromDiff :: Word64 -> Word64 -> TimeDelta
timeDeltaFromDiff Word64
end Word64
start =
if Word64
end Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
start
then Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignPos (Word64
end Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
start)
else Sign -> Word64 -> TimeDelta
TimeDelta Sign
SignNeg (Word64
start Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
end)
timeDeltaAdd :: Word64 -> TimeDelta -> Word64
timeDeltaAdd :: Word64 -> TimeDelta -> Word64
timeDeltaAdd Word64
t (TimeDelta Sign
s Word64
m) =
case Sign
s of
Sign
SignPos -> Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
m
Sign
SignNeg -> Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
m
timeDeltaToFracSecs :: (Fractional a) => TimeDelta -> a
timeDeltaToFracSecs :: forall a. Fractional a => TimeDelta -> a
timeDeltaToFracSecs (TimeDelta Sign
s Word64
m) =
let a :: a
a = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000000
in case Sign
s of
Sign
SignPos -> a
a
Sign
SignNeg -> a -> a
forall a. Num a => a -> a
negate a
a
timeDeltaToNanos :: TimeDelta -> (Sign, Word64)
timeDeltaToNanos :: TimeDelta -> (Sign, Word64)
timeDeltaToNanos (TimeDelta Sign
s Word64
m) = (Sign
s, Word64
m)
threadDelayDelta :: TimeDelta -> IO ()
threadDelayDelta :: TimeDelta -> IO ()
threadDelayDelta (TimeDelta Sign
s Word64
m) =
case Sign
s of
Sign
SignPos | Word64
m Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0 -> 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
m Word64
1000))
Sign
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
showTimeDelta :: Int -> TimeDelta -> String
showTimeDelta :: Int -> TimeDelta -> String
showTimeDelta Int
places TimeDelta
td = forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat @Double (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
places) (TimeDelta -> Double
forall a. Fractional a => TimeDelta -> a
timeDeltaToFracSecs TimeDelta
td) String
""
class (Ord t) => TimeLike t where
diffTime :: t -> t -> 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
let td :: TimeDelta
td = t -> t -> TimeDelta
forall t. TimeLike t => t -> t -> TimeDelta
diffTime t
target t
cur
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 (Int -> PosixTime -> ShowS
[PosixTime] -> ShowS
PosixTime -> String
(Int -> PosixTime -> ShowS)
-> (PosixTime -> String)
-> ([PosixTime] -> ShowS)
-> Show PosixTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PosixTime -> ShowS
showsPrec :: Int -> PosixTime -> ShowS
$cshow :: PosixTime -> String
show :: PosixTime -> String
$cshowList :: [PosixTime] -> ShowS
showList :: [PosixTime] -> ShowS
Show)
deriving newtype (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, 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, PosixTime
PosixTime -> PosixTime -> Bounded PosixTime
forall a. a -> a -> Bounded a
$cminBound :: PosixTime
minBound :: PosixTime
$cmaxBound :: PosixTime
maxBound :: PosixTime
Bounded, Integer -> PosixTime
PosixTime -> PosixTime
PosixTime -> PosixTime -> PosixTime
(PosixTime -> PosixTime -> PosixTime)
-> (PosixTime -> PosixTime -> PosixTime)
-> (PosixTime -> PosixTime -> PosixTime)
-> (PosixTime -> PosixTime)
-> (PosixTime -> PosixTime)
-> (PosixTime -> PosixTime)
-> (Integer -> PosixTime)
-> Num PosixTime
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PosixTime -> PosixTime -> PosixTime
+ :: PosixTime -> PosixTime -> PosixTime
$c- :: PosixTime -> PosixTime -> PosixTime
- :: PosixTime -> PosixTime -> PosixTime
$c* :: PosixTime -> PosixTime -> PosixTime
* :: PosixTime -> PosixTime -> PosixTime
$cnegate :: PosixTime -> PosixTime
negate :: PosixTime -> PosixTime
$cabs :: PosixTime -> PosixTime
abs :: PosixTime -> PosixTime
$csignum :: PosixTime -> PosixTime
signum :: PosixTime -> PosixTime
$cfromInteger :: Integer -> PosixTime
fromInteger :: Integer -> PosixTime
Num)
showPosixTime :: PosixTime -> String
showPosixTime :: PosixTime -> String
showPosixTime (PosixTime Word64
ns) =
UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show (POSIXTime -> UTCTime
posixSecondsToUTCTime (Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ns Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000000)))
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)
instance TimeLike PosixTime where
diffTime :: PosixTime -> PosixTime -> TimeDelta
diffTime (PosixTime Word64
t2) (PosixTime Word64
t1) = Word64 -> Word64 -> TimeDelta
timeDeltaFromDiff Word64
t2 Word64
t1
addTime :: PosixTime -> TimeDelta -> PosixTime
addTime (PosixTime Word64
t) TimeDelta
td = Word64 -> PosixTime
PosixTime (Word64 -> TimeDelta -> Word64
timeDeltaAdd Word64
t TimeDelta
td)
currentTime :: IO PosixTime
currentTime = (POSIXTime -> PosixTime) -> IO POSIXTime -> 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)
-> (POSIXTime -> Word64) -> POSIXTime -> PosixTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Word64
picoToNanoWord (Pico -> Word64) -> (POSIXTime -> Pico) -> POSIXTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Pico
nominalDiffTimeToSeconds) IO POSIXTime
getPOSIXTime
newtype MonoTime = MonoTime {MonoTime -> Word64
unMonoTime :: Word64}
deriving stock (Int -> MonoTime -> ShowS
[MonoTime] -> ShowS
MonoTime -> String
(Int -> MonoTime -> ShowS)
-> (MonoTime -> String) -> ([MonoTime] -> ShowS) -> Show MonoTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonoTime -> ShowS
showsPrec :: Int -> MonoTime -> ShowS
$cshow :: MonoTime -> String
show :: MonoTime -> String
$cshowList :: [MonoTime] -> ShowS
showList :: [MonoTime] -> ShowS
Show)
deriving newtype (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, 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, MonoTime
MonoTime -> MonoTime -> Bounded MonoTime
forall a. a -> a -> Bounded a
$cminBound :: MonoTime
minBound :: MonoTime
$cmaxBound :: MonoTime
maxBound :: MonoTime
Bounded, Integer -> MonoTime
MonoTime -> MonoTime
MonoTime -> MonoTime -> MonoTime
(MonoTime -> MonoTime -> MonoTime)
-> (MonoTime -> MonoTime -> MonoTime)
-> (MonoTime -> MonoTime -> MonoTime)
-> (MonoTime -> MonoTime)
-> (MonoTime -> MonoTime)
-> (MonoTime -> MonoTime)
-> (Integer -> MonoTime)
-> Num MonoTime
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MonoTime -> MonoTime -> MonoTime
+ :: MonoTime -> MonoTime -> MonoTime
$c- :: MonoTime -> MonoTime -> MonoTime
- :: MonoTime -> MonoTime -> MonoTime
$c* :: MonoTime -> MonoTime -> MonoTime
* :: MonoTime -> MonoTime -> MonoTime
$cnegate :: MonoTime -> MonoTime
negate :: MonoTime -> MonoTime
$cabs :: MonoTime -> MonoTime
abs :: MonoTime -> MonoTime
$csignum :: MonoTime -> MonoTime
signum :: MonoTime -> MonoTime
$cfromInteger :: Integer -> MonoTime
fromInteger :: Integer -> MonoTime
Num)
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 -> TimeDelta
diffTime (MonoTime Word64
t2) (MonoTime Word64
t1) = Word64 -> Word64 -> TimeDelta
timeDeltaFromDiff Word64
t2 Word64
t1
addTime :: MonoTime -> TimeDelta -> MonoTime
addTime (MonoTime Word64
t) TimeDelta
td = Word64 -> MonoTime
MonoTime (Word64 -> TimeDelta -> Word64
timeDeltaAdd Word64
t TimeDelta
td)
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 (Int -> NtpTime -> ShowS
[NtpTime] -> ShowS
NtpTime -> String
(Int -> NtpTime -> ShowS)
-> (NtpTime -> String) -> ([NtpTime] -> ShowS) -> Show NtpTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NtpTime -> ShowS
showsPrec :: Int -> NtpTime -> ShowS
$cshow :: NtpTime -> String
show :: NtpTime -> String
$cshowList :: [NtpTime] -> ShowS
showList :: [NtpTime] -> ShowS
Show)
deriving newtype (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, 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, NtpTime
NtpTime -> NtpTime -> Bounded NtpTime
forall a. a -> a -> Bounded a
$cminBound :: NtpTime
minBound :: NtpTime
$cmaxBound :: NtpTime
maxBound :: NtpTime
Bounded, Integer -> NtpTime
NtpTime -> NtpTime
NtpTime -> NtpTime -> NtpTime
(NtpTime -> NtpTime -> NtpTime)
-> (NtpTime -> NtpTime -> NtpTime)
-> (NtpTime -> NtpTime -> NtpTime)
-> (NtpTime -> NtpTime)
-> (NtpTime -> NtpTime)
-> (NtpTime -> NtpTime)
-> (Integer -> NtpTime)
-> Num NtpTime
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: NtpTime -> NtpTime -> NtpTime
+ :: NtpTime -> NtpTime -> NtpTime
$c- :: NtpTime -> NtpTime -> NtpTime
- :: NtpTime -> NtpTime -> NtpTime
$c* :: NtpTime -> NtpTime -> NtpTime
* :: NtpTime -> NtpTime -> NtpTime
$cnegate :: NtpTime -> NtpTime
negate :: NtpTime -> NtpTime
$cabs :: NtpTime -> NtpTime
abs :: NtpTime -> NtpTime
$csignum :: NtpTime -> NtpTime
signum :: NtpTime -> NtpTime
$cfromInteger :: Integer -> NtpTime
fromInteger :: Integer -> NtpTime
Num)
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)
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)
instance TimeLike NtpTime where
diffTime :: NtpTime -> NtpTime -> TimeDelta
diffTime NtpTime
n2 NtpTime
n1 = PosixTime -> PosixTime -> TimeDelta
forall t. TimeLike t => t -> t -> 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
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 String -> a
forall a. HasCallStack => String -> a
error (String
"Required non-negative value but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a)
else a
a