Timestamp.hs

{-# 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 (Eq, Ord, Show, Read)

instance Bounded PSTimestamp where
  minBound = PSTimestamp minBound 0
  maxBound = PSTimestamp maxBound 999999999

instance NFData PSTimestamp where rnf (PSTimestamp _ _) = ()

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

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

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

-- | Construct 'PSTimestamp' from total amount of nanoseconds passed since Unix epoch
mptsFromPosixNanoseconds :: Integer -> Maybe PSTimestamp
mptsFromPosixNanoseconds ns0
  | minI <= ns0, ns0 <= maxI  = Just $! PSTimestamp (fromInteger s) (fromInteger ns)
  | otherwise                 = Nothing
  where
    (s,ns) = divMod ns0 1000000000
    maxI = mptsToPosixNanoseconds maxBound
    minI = mptsToPosixNanoseconds minBound

-- | Deconstruct 'PSTimestamp' into total amount of nanoseconds passed since Unix epoch
mptsToPosixNanoseconds :: PSTimestamp -> Integer
mptsToPosixNanoseconds (PSTimestamp s ns) = (toInteger s * 1000000000) + toInteger 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 = picoseconds2utc . (*1000) . mptsToPosixNanoseconds

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

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

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

-- NB: exploits the RULE
-- "realToFrac/Pico->NominalDiffTime"       realToFrac = MkNominalDiffTime
picoseconds2utc :: Integer -> Time.UTCTime
picoseconds2utc ps = Time.posixSecondsToUTCTime (realToFrac (MkFixed 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 t
  | rest /= 0 = Nothing
  | otherwise = mptsFromPosixNanoseconds ns0
  where
    (ns0,rest) = divMod (utc2picoseconds t) 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 t
  | Just mpts <- mptsFromPosixNanoseconds ns0 = mpts
  | ns0 < 0 = minBound
  | otherwise = maxBound
  where
    ns0 = div  (utc2picoseconds t) 1000