fb-util-0.1.0.1: Util/Time.hs

{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

{-# LANGUAGE NamedFieldPuns #-}
module Util.Time
  ( -- * absolute time
    EpochClock(..)
  , getEpochTime, toEpochSeconds, toEpochNanos
  , epochClockToUTCTime, showUTC, readUTC
  , showEpochTime
    -- * time point differences
  , TimePoint(..), DiffTimePoints(..), getTimePoint
  , addToTimePoint
  , diffTimePoints, addDiffTimePoints
  , getElapsedTime, elapsedTime
  , toDiffMillis, toDiffMicros, toDiffNanos, toDiffSeconds
    -- * utils
  , delay, nanoseconds, seconds, minutes, hours
  ) where

import Control.Concurrent
import Data.Ratio
import qualified Data.Text as T
import qualified Data.Time.Clock as TC ( UTCTime )
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime, POSIXTime )
import Data.Time.Format ( defaultTimeLocale, formatTime, parseTimeM )
import qualified System.Clock as SC

import Compat.Prettyprinter as P

newtype EpochClock = EpochClock SC.TimeSpec deriving (Eq, Ord, Show)

-- | Use 'Clock' of 'Realtime'
getEpochTime :: IO EpochClock
getEpochTime = EpochClock <$> SC.getTime SC.Realtime

-- | Using this with 'getEpochTime' and 'showEpochTime' agrees with running
--
-- > /usr/local/bin/date +'%s'
toEpochSeconds :: EpochClock -> Double
toEpochSeconds (EpochClock SC.TimeSpec{sec, nsec}) = fromRational $
  fromIntegral sec + (fromIntegral nsec % 1000000000)

toEpochNanos :: EpochClock -> Integer
toEpochNanos (EpochClock timeSpec) = SC.toNanoSecs timeSpec

-- | Using this with 'getEpochTime' and 'showEpochTime' agrees with running
--
-- > /usr/local/bin/date --rfc-3339=ns
epochClockToUTCTime :: EpochClock -> TC.UTCTime
epochClockToUTCTime (EpochClock SC.TimeSpec{sec, nsec}) =
  let posixSeconds :: POSIXTime
      posixSeconds = fromRational $
        fromIntegral sec + (fromIntegral nsec % 1000000000)
  in posixSecondsToUTCTime posixSeconds

-- | For seconds, this has variable number of digits after decimal point.
-- We want to log RFC 3339 format
showUTC :: TC.UTCTime -> T.Text
showUTC = T.pack . formatTime defaultTimeLocale "%FT%X%QZ"

readUTC :: T.Text -> Maybe TC.UTCTime
readUTC = parseTimeM True defaultTimeLocale "%FT%X%QZ" . T.unpack

-- | We want to log RFC 3339 format
showEpochTime :: EpochClock -> T.Text
showEpochTime = showUTC . epochClockToUTCTime

-- -----------------------------------------------------------------------------

newtype TimePoint = TimePoint SC.TimeSpec deriving (Eq, Ord, Show)

instance P.Pretty TimePoint where
  pretty (TimePoint SC.TimeSpec{..}) = P.pretty $ "TimePoint "
    <> T.pack (show sec) <> "." <> T.justifyRight 9 '0' (T.pack (show nsec))

-- | Use 'Clock' of 'MonotonicRaw'
getTimePoint :: IO TimePoint
getTimePoint = TimePoint <$> SC.getTime SC.MonotonicRaw

newtype DiffTimePoints = DiffTimePoints SC.TimeSpec
  deriving (Eq, Ord, Show, Num)

instance P.Pretty DiffTimePoints where
  pretty (DiffTimePoints SC.TimeSpec{..}) = P.pretty $ "DiffTimePoints "
    <> T.pack (show sec) <> "." <> T.justifyRight 9 '0' (T.pack (show nsec))

addDiffTimePoints :: DiffTimePoints -> DiffTimePoints -> DiffTimePoints
addDiffTimePoints (DiffTimePoints a) (DiffTimePoints b) = DiffTimePoints (a+b)

-- | This takes the earlier (smaller) then the later (larger) 'TimePoint'
diffTimePoints :: TimePoint -> TimePoint -> DiffTimePoints
diffTimePoints (TimePoint small) (TimePoint big) =
  DiffTimePoints (big - small)

addToTimePoint :: TimePoint -> DiffTimePoints -> TimePoint
addToTimePoint (TimePoint time) (DiffTimePoints diff) =
  TimePoint (time + diff)

getElapsedTime :: TimePoint -> IO DiffTimePoints
getElapsedTime small = do
  big <- getTimePoint
  return (diffTimePoints small big)

-- | Measure the elapsed time of an IO action
elapsedTime :: IO a -> IO (DiffTimePoints, a)
elapsedTime io = do
  t0 <- getTimePoint
  a <- io
  delta <- getElapsedTime t0
  return (delta, a)

-- | We want to log milliseconds, use 'round'
toDiffMillis :: DiffTimePoints -> Int
toDiffMillis (DiffTimePoints SC.TimeSpec{sec,nsec}) =
  1000 * fromIntegral sec +
    (round :: Rational -> Int) (fromIntegral nsec % 1000000)

toDiffMicros :: DiffTimePoints -> Int
toDiffMicros (DiffTimePoints SC.TimeSpec{sec,nsec}) =
  1000000 * fromIntegral sec +
    (round :: Rational -> Int) (fromIntegral nsec % 1000)

toDiffNanos :: DiffTimePoints -> Int
toDiffNanos (DiffTimePoints SC.TimeSpec{sec,nsec}) =
  1000000000 * fromIntegral sec + fromIntegral nsec

toDiffSeconds :: DiffTimePoints -> Double
toDiffSeconds (DiffTimePoints SC.TimeSpec{sec,nsec}) =
  fromIntegral sec + 1e-9 * fromIntegral nsec

delay :: DiffTimePoints -> IO ()
delay = threadDelay . toDiffMicros

nanoseconds :: Int -> DiffTimePoints
nanoseconds n = DiffTimePoints (SC.fromNanoSecs (fromIntegral n))

seconds :: Int -> DiffTimePoints
seconds s = DiffTimePoints (SC.TimeSpec (fromIntegral s) 0)

minutes :: Int -> DiffTimePoints
minutes m = seconds (m * 60)

hours :: Int -> DiffTimePoints
hours h = minutes (h * 60)