{-# OPTIONS_GHC -fno-cse #-}

-- | Helper functions for converting the timestamp format used in our `Span`
-- data to the time formats used by the various platforms we report to.
module Platform.Timer
  ( Timer (Timer),
    mkTimer,
    toUTC,
    toLocal,
    toPosix,
    toPosixMicroseconds,
    toISO8601,
    difference,
    durationInUs,
  )
where

import qualified Control.Concurrent.MVar as MVar
import qualified Data.Time.Clock as Clock
import qualified Data.Time.Clock.POSIX as Clock.POSIX
import qualified Data.Time.Format as Format
import qualified Data.Time.LocalTime as LocalTime
import qualified Data.Word as Word
import qualified GHC.Clock
import qualified Platform
import qualified System.IO.Unsafe
import qualified Prelude

-- | Our spans' timestamps are produced by the `GHC.Clock` module and consist of
-- the amount of time passed since some arbitrary (but constant) moment in the
-- past. This is the faster and more accurate way to measure precisely what the
-- running time of spans is. This type helpers convert these times into regular
-- dates.
data Timer = Timer
  { -- | The POSIX time in microseconds that corresponds with t=0 according
    -- to `GHC.Clock`. We can use this to calculate other `GHC.Clock`
    -- values.
    Timer -> Word64
tzero :: Word.Word64,
    -- | The timezone of the machine this code is running on. Useful for
    -- printing local times in development reporters.
    Timer -> TimeZone
timezone :: LocalTime.TimeZone
  }

-- | Create a timer, then cache it. When asked again return the previously
-- created timer.
--
-- Passing separate timers to multiple reporters could result in those reporters
-- disagreeing very subtly on the exact time when events happen. Having a single
-- timer prevents this from happening.
mkTimer :: Prelude.IO Timer
mkTimer :: IO Timer
mkTimer =
  MVar (Maybe Timer)
-> (Maybe Timer -> IO (Maybe Timer, Timer)) -> IO Timer
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MVar.modifyMVar
    MVar (Maybe Timer)
timerVar
    ( \Maybe Timer
maybeTimer ->
        case Maybe Timer
maybeTimer of
          Just Timer
timer -> (Maybe Timer, Timer) -> IO (Maybe Timer, Timer)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Timer -> Maybe Timer
forall a. a -> Maybe a
Just Timer
timer, Timer
timer)
          Maybe Timer
Nothing -> do
            -- 'Sync our clocks', to find our how monotonic time and actual time relate.
            POSIXTime
nowTime <- IO POSIXTime
Clock.POSIX.getPOSIXTime
            Word64
nowClock <- IO Word64
GHC.Clock.getMonotonicTimeNSec
            TimeZone
timezone <- IO TimeZone
LocalTime.getCurrentTimeZone
            let tzero :: Word64
tzero = POSIXTime -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
Prelude.floor (POSIXTime
1e6 POSIXTime -> POSIXTime -> POSIXTime
forall number. Num number => number -> number -> number
* POSIXTime
nowTime) Word64 -> Word64 -> Word64
forall number. Num number => number -> number -> number
- (Word64
nowClock Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`Prelude.div` Word64
1000)
            let timer :: Timer
timer = Timer :: Word64 -> TimeZone -> Timer
Timer {Word64
tzero :: Word64
tzero :: Word64
tzero, TimeZone
timezone :: TimeZone
timezone :: TimeZone
timezone}
            (Maybe Timer, Timer) -> IO (Maybe Timer, Timer)
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Timer -> Maybe Timer
forall a. a -> Maybe a
Just Timer
timer, Timer
timer)
    )

{-# NOINLINE timerVar #-}
timerVar :: MVar.MVar (Maybe Timer)
timerVar :: MVar (Maybe Timer)
timerVar = IO (MVar (Maybe Timer)) -> MVar (Maybe Timer)
forall a. IO a -> a
System.IO.Unsafe.unsafePerformIO (Maybe Timer -> IO (MVar (Maybe Timer))
forall a. a -> IO (MVar a)
MVar.newMVar Maybe Timer
forall a. Maybe a
Nothing)

toUTC :: Timer -> Platform.MonotonicTime -> Clock.UTCTime
toUTC :: Timer -> MonotonicTime -> UTCTime
toUTC Timer
timer MonotonicTime
clock =
  Timer -> MonotonicTime -> POSIXTime
toPosix Timer
timer MonotonicTime
clock
    POSIXTime -> (POSIXTime -> UTCTime) -> UTCTime
forall a b. a -> (a -> b) -> b
|> POSIXTime -> UTCTime
Clock.POSIX.posixSecondsToUTCTime

toLocal :: Timer -> Platform.MonotonicTime -> LocalTime.LocalTime
toLocal :: Timer -> MonotonicTime -> LocalTime
toLocal Timer
timer MonotonicTime
clock =
  Timer -> MonotonicTime -> UTCTime
toUTC Timer
timer MonotonicTime
clock
    UTCTime -> (UTCTime -> LocalTime) -> LocalTime
forall a b. a -> (a -> b) -> b
|> TimeZone -> UTCTime -> LocalTime
LocalTime.utcToLocalTime (Timer -> TimeZone
timezone Timer
timer)

toPosixMicroseconds :: Timer -> Platform.MonotonicTime -> Word.Word64
toPosixMicroseconds :: Timer -> MonotonicTime -> Word64
toPosixMicroseconds Timer
timer MonotonicTime
clock = Timer -> Word64
tzero Timer
timer Word64 -> Word64 -> Word64
forall number. Num number => number -> number -> number
+ MonotonicTime -> Word64
Platform.inMicroseconds MonotonicTime
clock

toPosix :: Timer -> Platform.MonotonicTime -> Clock.POSIX.POSIXTime
toPosix :: Timer -> MonotonicTime -> POSIXTime
toPosix Timer
timer MonotonicTime
clock =
  Timer -> MonotonicTime -> Word64
toPosixMicroseconds Timer
timer MonotonicTime
clock
    Word64 -> (Word64 -> POSIXTime) -> POSIXTime
forall a b. a -> (a -> b) -> b
|> Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
    POSIXTime -> (POSIXTime -> POSIXTime) -> POSIXTime
forall a b. a -> (a -> b) -> b
|> POSIXTime -> POSIXTime -> POSIXTime
forall number. Num number => number -> number -> number
(*) POSIXTime
1e-6

toISO8601 :: Timer -> Platform.MonotonicTime -> Text
toISO8601 :: Timer -> MonotonicTime -> Text
toISO8601 Timer
timer MonotonicTime
clock =
  Timer -> MonotonicTime -> UTCTime
toUTC Timer
timer MonotonicTime
clock
    UTCTime -> (UTCTime -> String) -> String
forall a b. a -> (a -> b) -> b
|> TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Format.formatTime TimeLocale
Format.defaultTimeLocale String
"%FT%T%QZ"
    String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> String -> Text
Text.fromList

-- | We have to be careful when calculating the difference between two times.
-- Because they are unsigned (don't allow negative numbers), subtracting times
-- in the wrong order is going to result in very large numbers:
--
--     ghci> import GHC.Word
--     ghci> 5 - 2 :: Word64
--     3
--     ghci> 2 - 5 :: Word64
--     18446744073709551613
--
-- The span data we get from Platform should ensure end times always come
-- before start times. If they're not though one of these extremely long span
-- durations can have a major effect on request duration statistics.
--
-- This function performs some defensive programming to prevent flukes from
-- doing major damage.
difference :: Platform.MonotonicTime -> Platform.MonotonicTime -> Platform.MonotonicTime
difference :: MonotonicTime -> MonotonicTime -> MonotonicTime
difference MonotonicTime
start MonotonicTime
end =
  if MonotonicTime
end MonotonicTime -> MonotonicTime -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
> MonotonicTime
start
    then MonotonicTime
end MonotonicTime -> MonotonicTime -> MonotonicTime
forall number. Num number => number -> number -> number
- MonotonicTime
start
    else MonotonicTime
0

-- | Get the time covered by a duration in microseconds.
durationInUs :: Platform.TracingSpan -> Word.Word64
durationInUs :: TracingSpan -> Word64
durationInUs TracingSpan
span =
  MonotonicTime -> MonotonicTime -> MonotonicTime
difference
    (TracingSpan -> MonotonicTime
Platform.started TracingSpan
span)
    (TracingSpan -> MonotonicTime
Platform.finished TracingSpan
span)
    MonotonicTime -> (MonotonicTime -> Word64) -> Word64
forall a b. a -> (a -> b) -> b
|> MonotonicTime -> Word64
Platform.inMicroseconds