{-# LANGUAGE PatternSynonyms     #-}

-- | Internal module. Not part of the public API.
module Data.PackStream.Timestamp
    ( PSTimestamp

    , mptsFromPosixSeconds
    , mptsFromPosixSeconds2
    , mptsToPosixSeconds2

    , mptsFromPosixNanoseconds
    , mptsToPosixNanoseconds

    , mptsToUTCTime
    , mptsFromUTCTime
    , mptsFromUTCTimeLossy
    ) where

import           Compat.Prelude

import           Data.Fixed
import           Data.Kind               (Type)
import qualified Data.Time.Clock         as Time
import qualified Data.Time.Clock.POSIX   as Time

-- | A PackStream timestamp
--
-- The representable range is @[-292277022657-01-27 08:29:52 UTC .. 292277026596-12-04 15:30:07.999999999 UTC]@ with nanosecond precision.
type PSTimestamp :: Type
data PSTimestamp = PSTimestamp !Int64 !Word32
                 deriving stock (PSTimestamp -> PSTimestamp -> Bool
(PSTimestamp -> PSTimestamp -> Bool)
-> (PSTimestamp -> PSTimestamp -> Bool) -> Eq PSTimestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PSTimestamp -> PSTimestamp -> Bool
== :: PSTimestamp -> PSTimestamp -> Bool
$c/= :: PSTimestamp -> PSTimestamp -> Bool
/= :: PSTimestamp -> PSTimestamp -> Bool
Eq, Eq PSTimestamp
Eq PSTimestamp =>
(PSTimestamp -> PSTimestamp -> Ordering)
-> (PSTimestamp -> PSTimestamp -> Bool)
-> (PSTimestamp -> PSTimestamp -> Bool)
-> (PSTimestamp -> PSTimestamp -> Bool)
-> (PSTimestamp -> PSTimestamp -> Bool)
-> (PSTimestamp -> PSTimestamp -> PSTimestamp)
-> (PSTimestamp -> PSTimestamp -> PSTimestamp)
-> Ord PSTimestamp
PSTimestamp -> PSTimestamp -> Bool
PSTimestamp -> PSTimestamp -> Ordering
PSTimestamp -> PSTimestamp -> PSTimestamp
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 :: PSTimestamp -> PSTimestamp -> Ordering
compare :: PSTimestamp -> PSTimestamp -> Ordering
$c< :: PSTimestamp -> PSTimestamp -> Bool
< :: PSTimestamp -> PSTimestamp -> Bool
$c<= :: PSTimestamp -> PSTimestamp -> Bool
<= :: PSTimestamp -> PSTimestamp -> Bool
$c> :: PSTimestamp -> PSTimestamp -> Bool
> :: PSTimestamp -> PSTimestamp -> Bool
$c>= :: PSTimestamp -> PSTimestamp -> Bool
>= :: PSTimestamp -> PSTimestamp -> Bool
$cmax :: PSTimestamp -> PSTimestamp -> PSTimestamp
max :: PSTimestamp -> PSTimestamp -> PSTimestamp
$cmin :: PSTimestamp -> PSTimestamp -> PSTimestamp
min :: PSTimestamp -> PSTimestamp -> PSTimestamp
Ord, Int -> PSTimestamp -> ShowS
[PSTimestamp] -> ShowS
PSTimestamp -> String
(Int -> PSTimestamp -> ShowS)
-> (PSTimestamp -> String)
-> ([PSTimestamp] -> ShowS)
-> Show PSTimestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PSTimestamp -> ShowS
showsPrec :: Int -> PSTimestamp -> ShowS
$cshow :: PSTimestamp -> String
show :: PSTimestamp -> String
$cshowList :: [PSTimestamp] -> ShowS
showList :: [PSTimestamp] -> ShowS
Show, ReadPrec [PSTimestamp]
ReadPrec PSTimestamp
Int -> ReadS PSTimestamp
ReadS [PSTimestamp]
(Int -> ReadS PSTimestamp)
-> ReadS [PSTimestamp]
-> ReadPrec PSTimestamp
-> ReadPrec [PSTimestamp]
-> Read PSTimestamp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PSTimestamp
readsPrec :: Int -> ReadS PSTimestamp
$creadList :: ReadS [PSTimestamp]
readList :: ReadS [PSTimestamp]
$creadPrec :: ReadPrec PSTimestamp
readPrec :: ReadPrec PSTimestamp
$creadListPrec :: ReadPrec [PSTimestamp]
readListPrec :: ReadPrec [PSTimestamp]
Read)

instance Bounded PSTimestamp where
  minBound :: PSTimestamp
minBound = Int64 -> Word32 -> PSTimestamp
PSTimestamp Int64
forall a. Bounded a => a
minBound Word32
0
  maxBound :: PSTimestamp
maxBound = Int64 -> Word32 -> PSTimestamp
PSTimestamp Int64
forall a. Bounded a => a
maxBound Word32
999999999

instance NFData PSTimestamp where rnf :: PSTimestamp -> ()
rnf (PSTimestamp Int64
_ Word32
_) = ()

-- | Construct 'PSTimestamp' from amount of integral seconds since Unix epoch
mptsFromPosixSeconds :: Int64 -> PSTimestamp
mptsFromPosixSeconds :: Int64 -> PSTimestamp
mptsFromPosixSeconds Int64
s = Int64 -> Word32 -> PSTimestamp
PSTimestamp Int64
s Word32
0

-- | Construct 'PSTimestamp' from amount of seconds and nanoseconds (must be \( \leq 10^9 \) ) passed since Unix epoch
mptsFromPosixSeconds2 :: Int64 -> Word32 -> Maybe PSTimestamp
mptsFromPosixSeconds2 :: Int64 -> Word32 -> Maybe PSTimestamp
mptsFromPosixSeconds2 Int64
s Word32
ns
  | Word32
ns Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
999999999 = PSTimestamp -> Maybe PSTimestamp
forall a. a -> Maybe a
Just (PSTimestamp -> Maybe PSTimestamp)
-> PSTimestamp -> Maybe PSTimestamp
forall a b. (a -> b) -> a -> b
$! Int64 -> Word32 -> PSTimestamp
PSTimestamp Int64
s Word32
ns
  | Bool
otherwise       = Maybe PSTimestamp
forall a. Maybe a
Nothing

-- | Deconstruct 'PSTimestamp' into amount of seconds and nanoseconds passed since Unix epoch
mptsToPosixSeconds2 :: PSTimestamp -> (Int64, Word32)
mptsToPosixSeconds2 :: PSTimestamp -> (Int64, Word32)
mptsToPosixSeconds2 (PSTimestamp Int64
s Word32
ns) = (Int64
s, Word32
ns)

-- | Construct 'PSTimestamp' from total amount of nanoseconds passed since Unix epoch
mptsFromPosixNanoseconds :: Integer -> Maybe PSTimestamp
mptsFromPosixNanoseconds :: Integer -> Maybe PSTimestamp
mptsFromPosixNanoseconds Integer
ns0
  | Integer
minI Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
ns0, Integer
ns0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxI  = PSTimestamp -> Maybe PSTimestamp
forall a. a -> Maybe a
Just (PSTimestamp -> Maybe PSTimestamp)
-> PSTimestamp -> Maybe PSTimestamp
forall a b. (a -> b) -> a -> b
$! Int64 -> Word32 -> PSTimestamp
PSTimestamp (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
s) (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
ns)
  | Bool
otherwise                 = Maybe PSTimestamp
forall a. Maybe a
Nothing
  where
    (Integer
s,Integer
ns) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
ns0 Integer
1000000000
    maxI :: Integer
maxI = PSTimestamp -> Integer
mptsToPosixNanoseconds PSTimestamp
forall a. Bounded a => a
maxBound
    minI :: Integer
minI = PSTimestamp -> Integer
mptsToPosixNanoseconds PSTimestamp
forall a. Bounded a => a
minBound

-- | Deconstruct 'PSTimestamp' into total amount of nanoseconds passed since Unix epoch
mptsToPosixNanoseconds :: PSTimestamp -> Integer
mptsToPosixNanoseconds :: PSTimestamp -> Integer
mptsToPosixNanoseconds (PSTimestamp Int64
s Word32
ns) = (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000000) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
ns

-- >>> mptsToUTCTime minBound
-- -292277022657-01-27 08:29:52 UTC

-- >>> mptsToUTCTime maxBound
-- 292277026596-12-04 15:30:07.999999999 UTC

-- >>> mptsToUTCTime (PSTimestamp 0 0)
-- 1970-01-01 00:00:00 UTC

-- >>> mptsToUTCTime (PSTimestamp 0xffffffff 0)
-- 2106-02-07 06:28:15 UTC

-- >>> mptsToUTCTime (PSTimestamp 0x3ffffffff 999999999)
-- 2514-05-30 01:53:03.999999999 UTC

-- | Convert 'PSTimestamp' into 'Time.UTCTime'
mptsToUTCTime :: PSTimestamp -> Time.UTCTime
mptsToUTCTime :: PSTimestamp -> UTCTime
mptsToUTCTime = Integer -> UTCTime
picoseconds2utc (Integer -> UTCTime)
-> (PSTimestamp -> Integer) -> PSTimestamp -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
1000) (Integer -> Integer)
-> (PSTimestamp -> Integer) -> PSTimestamp -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSTimestamp -> Integer
mptsToPosixNanoseconds

-- >>> mptsFromUTCTime (mptsToUTCTime minBound) == Just minBound
-- True

-- >>> mptsFromUTCTime (mptsToUTCTime maxBound) == Just maxBound
-- True

utc2picoseconds :: Time.UTCTime -> Integer
utc2picoseconds :: UTCTime -> Integer
utc2picoseconds UTCTime
utc = Integer
ps
  where -- NB: this exploits the RULE from time:
    -- "realToFrac/NominalDiffTime->Pico"       realToFrac = \(MkNominalDiffTime ps) -> ps
    MkFixed Integer
ps = POSIXTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> POSIXTime
Time.utcTimeToPOSIXSeconds UTCTime
utc) :: Pico

-- NB: exploits the RULE
-- "realToFrac/Pico->NominalDiffTime"       realToFrac = MkNominalDiffTime
picoseconds2utc :: Integer -> Time.UTCTime
picoseconds2utc :: Integer -> UTCTime
picoseconds2utc Integer
ps = POSIXTime -> UTCTime
Time.posixSecondsToUTCTime (Pico -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Integer -> Pico
forall k (a :: k). Integer -> Fixed a
MkFixed Integer
ps :: Pico))

-- | Convert 'Time.UTCTime' into 'PSTimestamp'
--
-- This conversion can fail (i.e. result in 'Nothing') if either the conversion cannot be performed lossless, either because the range of 'PSTimestamp' was exceeded or because of sub-nanosecond fractions.
--
-- See also 'mptsFromUTCTimeLossy'
mptsFromUTCTime :: Time.UTCTime -> Maybe PSTimestamp
mptsFromUTCTime :: UTCTime -> Maybe PSTimestamp
mptsFromUTCTime UTCTime
t
  | Integer
rest Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 = Maybe PSTimestamp
forall a. Maybe a
Nothing
  | Bool
otherwise = Integer -> Maybe PSTimestamp
mptsFromPosixNanoseconds Integer
ns0
  where
    (Integer
ns0,Integer
rest) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod (UTCTime -> Integer
utc2picoseconds UTCTime
t) Integer
1000

-- | Version of 'mptsFromUTCTime' which performs a lossy conversion into 'PSTimestamp'
--
-- * sub-nanosecond precision is silently truncated (in the sense of 'floor') to nanosecond precision
--
-- * time values exceeding the range of 'PSTimestamp' are clamped to 'minBound' and 'maxBound' respectively
--
mptsFromUTCTimeLossy :: Time.UTCTime -> PSTimestamp
mptsFromUTCTimeLossy :: UTCTime -> PSTimestamp
mptsFromUTCTimeLossy UTCTime
t
  | Just PSTimestamp
mpts <- Integer -> Maybe PSTimestamp
mptsFromPosixNanoseconds Integer
ns0 = PSTimestamp
mpts
  | Integer
ns0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = PSTimestamp
forall a. Bounded a => a
minBound
  | Bool
otherwise = PSTimestamp
forall a. Bounded a => a
maxBound
  where
    ns0 :: Integer
ns0 = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div  (UTCTime -> Integer
utc2picoseconds UTCTime
t) Integer
1000