{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module: Pact.Time.Internal
-- Copyright: Copyright © 2021 Kadena LLC.
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@kadena.io>
-- Stability: experimental
--
-- This is an internal module. No guarantee is provided regarding the stability
-- of the functions in this module. Use at your own risk.
--
module Pact.Time.Internal
(
  Micros
, Day

-- * NominalDiffTime
, NominalDiffTime(..)
, toMicroseconds
, fromMicroseconds
, toSeconds
, fromSeconds
, nominalDay

-- * UTCTime
, UTCTime(..)
, getCurrentTime
, day
, dayTime
, fromDayAndDayTime
, toPosixTimestampMicros
, fromPosixTimestampMicros
, mjdEpoch
, posixEpoch

-- * Julian Dates
, ModifiedJulianDay(..)
, ModifiedJulianDate(..)
, toModifiedJulianDate
, fromModifiedJulianDate

-- * Reexports
, AffineSpace(..)
, VectorSpace(..)
) where

import Control.DeepSeq

import Data.AdditiveGroup
import Data.AffineSpace
import Data.Decimal
import Data.Serialize
import Data.VectorSpace

import GHC.Generics hiding (from)
import GHC.Int (Int64)

import Lens.Micro

-- internal modules

import Pact.Time.System

-- -------------------------------------------------------------------------- --
-- Types for internal representations

type Micros = Int64
type Day = Int

-- -------------------------------------------------------------------------- --
-- Nominal Diff Time

-- | A time interval as measured by UTC, that does not take leap-seconds into
-- account.
--
newtype NominalDiffTime = NominalDiffTime { NominalDiffTime -> Micros
_microseconds :: Micros }
    deriving (NominalDiffTime -> NominalDiffTime -> Bool
(NominalDiffTime -> NominalDiffTime -> Bool)
-> (NominalDiffTime -> NominalDiffTime -> Bool)
-> Eq NominalDiffTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NominalDiffTime -> NominalDiffTime -> Bool
$c/= :: NominalDiffTime -> NominalDiffTime -> Bool
== :: NominalDiffTime -> NominalDiffTime -> Bool
$c== :: NominalDiffTime -> NominalDiffTime -> Bool
Eq, Eq NominalDiffTime
Eq NominalDiffTime
-> (NominalDiffTime -> NominalDiffTime -> Ordering)
-> (NominalDiffTime -> NominalDiffTime -> Bool)
-> (NominalDiffTime -> NominalDiffTime -> Bool)
-> (NominalDiffTime -> NominalDiffTime -> Bool)
-> (NominalDiffTime -> NominalDiffTime -> Bool)
-> (NominalDiffTime -> NominalDiffTime -> NominalDiffTime)
-> (NominalDiffTime -> NominalDiffTime -> NominalDiffTime)
-> Ord NominalDiffTime
NominalDiffTime -> NominalDiffTime -> Bool
NominalDiffTime -> NominalDiffTime -> Ordering
NominalDiffTime -> NominalDiffTime -> NominalDiffTime
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
min :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
$cmin :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
max :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
$cmax :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
>= :: NominalDiffTime -> NominalDiffTime -> Bool
$c>= :: NominalDiffTime -> NominalDiffTime -> Bool
> :: NominalDiffTime -> NominalDiffTime -> Bool
$c> :: NominalDiffTime -> NominalDiffTime -> Bool
<= :: NominalDiffTime -> NominalDiffTime -> Bool
$c<= :: NominalDiffTime -> NominalDiffTime -> Bool
< :: NominalDiffTime -> NominalDiffTime -> Bool
$c< :: NominalDiffTime -> NominalDiffTime -> Bool
compare :: NominalDiffTime -> NominalDiffTime -> Ordering
$ccompare :: NominalDiffTime -> NominalDiffTime -> Ordering
$cp1Ord :: Eq NominalDiffTime
Ord)
    deriving newtype (NominalDiffTime -> ()
(NominalDiffTime -> ()) -> NFData NominalDiffTime
forall a. (a -> ()) -> NFData a
rnf :: NominalDiffTime -> ()
$crnf :: NominalDiffTime -> ()
NFData)

-- | Convert from 'NominalDiffTime' to a 64-bit representation of microseconds.
--
toMicroseconds :: NominalDiffTime -> Micros
toMicroseconds :: NominalDiffTime -> Micros
toMicroseconds = NominalDiffTime -> Micros
_microseconds
{-# INLINE toMicroseconds #-}

-- | Convert from a 64-bit representation of microseconds to 'NominalDiffTime'.
--
fromMicroseconds :: Micros -> NominalDiffTime
fromMicroseconds :: Micros -> NominalDiffTime
fromMicroseconds = Micros -> NominalDiffTime
NominalDiffTime
{-# INLINE fromMicroseconds #-}

instance AdditiveGroup NominalDiffTime where
    zeroV :: NominalDiffTime
zeroV = Micros -> NominalDiffTime
NominalDiffTime Micros
0
    NominalDiffTime Micros
a ^+^ :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
^+^ NominalDiffTime Micros
b = Micros -> NominalDiffTime
NominalDiffTime (Micros
a Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
b)
    negateV :: NominalDiffTime -> NominalDiffTime
negateV (NominalDiffTime Micros
v) = Micros -> NominalDiffTime
NominalDiffTime (-Micros
v)
    NominalDiffTime Micros
a ^-^ :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
^-^ NominalDiffTime Micros
b = Micros -> NominalDiffTime
NominalDiffTime (Micros
a Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
- Micros
b)
    {-# INLINE zeroV #-}
    {-# INLINE (^+^) #-}
    {-# INLINE negateV #-}
    {-# INLINE (^-^) #-}

instance VectorSpace NominalDiffTime where
    type Scalar NominalDiffTime = Rational
    Scalar NominalDiffTime
s *^ :: Scalar NominalDiffTime -> NominalDiffTime -> NominalDiffTime
*^ (NominalDiffTime Micros
m) = Micros -> NominalDiffTime
NominalDiffTime (Micros -> NominalDiffTime) -> Micros -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Rational -> Micros
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
Scalar NominalDiffTime
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Micros -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Micros
m)
    {-# INLINE (*^) #-}

-- | Serializes 'NominalDiffTime' as 64-bit signed microseconds in little endian
-- encoding.
--
instance Serialize NominalDiffTime where
    put :: Putter NominalDiffTime
put (NominalDiffTime Micros
m) = Putter Micros
putInt64le Micros
m
    get :: Get NominalDiffTime
get = Micros -> NominalDiffTime
NominalDiffTime (Micros -> NominalDiffTime) -> Get Micros -> Get NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Micros
getInt64le
    {-# INLINE put #-}
    {-# INLINE get #-}

-- | Convert from 'NominalDiffTime' to a 'Decimal' representation of seconds.
--
toSeconds :: NominalDiffTime -> Decimal
toSeconds :: NominalDiffTime -> Decimal
toSeconds (NominalDiffTime Micros
m) = Micros -> Decimal
forall a b. (Real a, Fractional b) => a -> b
realToFrac Micros
m Decimal -> Decimal -> Decimal
forall a. Fractional a => a -> a -> a
/ Decimal
1000000
{-# INLINE toSeconds #-}

-- | Convert from 'Decimal' representation of seconds to 'NominalDiffTime'.
--
-- The result is rounded using banker's method, i.e. remainders of 0.5 a rounded
-- to the next even integer.
--
fromSeconds :: Decimal -> NominalDiffTime
fromSeconds :: Decimal -> NominalDiffTime
fromSeconds Decimal
d = Micros -> NominalDiffTime
NominalDiffTime (Micros -> NominalDiffTime) -> Micros -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Decimal -> Micros
forall a b. (RealFrac a, Integral b) => a -> b
round (Decimal -> Micros) -> Decimal -> Micros
forall a b. (a -> b) -> a -> b
$ Decimal
d Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
* Decimal
1000000
{-# INLINE fromSeconds #-}

-- | The nominal length of a day: precisely 86400 SI seconds.
--
nominalDay :: NominalDiffTime
nominalDay :: NominalDiffTime
nominalDay = Micros -> NominalDiffTime
NominalDiffTime (Micros -> NominalDiffTime) -> Micros -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Micros
86400 Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
* Micros
1000000
{-# INLINE nominalDay #-}

toPosixTimestampMicros :: UTCTime -> Micros
toPosixTimestampMicros :: UTCTime -> Micros
toPosixTimestampMicros = POSIXTime -> Micros
toTimestampMicros (POSIXTime -> Micros)
-> (UTCTime -> POSIXTime) -> UTCTime -> Micros
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
toPosix
{-# INLINE toPosixTimestampMicros #-}

fromPosixTimestampMicros :: Micros -> UTCTime
fromPosixTimestampMicros :: Micros -> UTCTime
fromPosixTimestampMicros = POSIXTime -> UTCTime
fromPosix (POSIXTime -> UTCTime)
-> (Micros -> POSIXTime) -> Micros -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> POSIXTime
fromTimestampMicros
{-# INLINE fromPosixTimestampMicros #-}

-- -------------------------------------------------------------------------- --
-- UTCTime

-- | UTCTime with microseconds precision. Internally it is represented as 64-bit
-- count nominal microseconds since MJD Epoch.
--
-- This implementation ignores leap seconds. Time differences are  measured as
-- nominal time, with a nominal day having exaxtly @24 * 60 * 60@ SI seconds. As
-- a consequence the difference between two dates as computed by this module is
-- generally equal or smaller than what is actually measured by a clock.
--
newtype UTCTime = UTCTime { UTCTime -> NominalDiffTime
_utcTime :: NominalDiffTime }
    deriving (UTCTime -> UTCTime -> Bool
(UTCTime -> UTCTime -> Bool)
-> (UTCTime -> UTCTime -> Bool) -> Eq UTCTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTCTime -> UTCTime -> Bool
$c/= :: UTCTime -> UTCTime -> Bool
== :: UTCTime -> UTCTime -> Bool
$c== :: UTCTime -> UTCTime -> Bool
Eq, Eq UTCTime
Eq UTCTime
-> (UTCTime -> UTCTime -> Ordering)
-> (UTCTime -> UTCTime -> Bool)
-> (UTCTime -> UTCTime -> Bool)
-> (UTCTime -> UTCTime -> Bool)
-> (UTCTime -> UTCTime -> Bool)
-> (UTCTime -> UTCTime -> UTCTime)
-> (UTCTime -> UTCTime -> UTCTime)
-> Ord UTCTime
UTCTime -> UTCTime -> Bool
UTCTime -> UTCTime -> Ordering
UTCTime -> UTCTime -> UTCTime
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
min :: UTCTime -> UTCTime -> UTCTime
$cmin :: UTCTime -> UTCTime -> UTCTime
max :: UTCTime -> UTCTime -> UTCTime
$cmax :: UTCTime -> UTCTime -> UTCTime
>= :: UTCTime -> UTCTime -> Bool
$c>= :: UTCTime -> UTCTime -> Bool
> :: UTCTime -> UTCTime -> Bool
$c> :: UTCTime -> UTCTime -> Bool
<= :: UTCTime -> UTCTime -> Bool
$c<= :: UTCTime -> UTCTime -> Bool
< :: UTCTime -> UTCTime -> Bool
$c< :: UTCTime -> UTCTime -> Bool
compare :: UTCTime -> UTCTime -> Ordering
$ccompare :: UTCTime -> UTCTime -> Ordering
$cp1Ord :: Eq UTCTime
Ord)
    deriving ((forall x. UTCTime -> Rep UTCTime x)
-> (forall x. Rep UTCTime x -> UTCTime) -> Generic UTCTime
forall x. Rep UTCTime x -> UTCTime
forall x. UTCTime -> Rep UTCTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UTCTime x -> UTCTime
$cfrom :: forall x. UTCTime -> Rep UTCTime x
Generic)
    deriving newtype (UTCTime -> ()
(UTCTime -> ()) -> NFData UTCTime
forall a. (a -> ()) -> NFData a
rnf :: UTCTime -> ()
$crnf :: UTCTime -> ()
NFData)
    deriving newtype (Get UTCTime
Putter UTCTime
Putter UTCTime -> Get UTCTime -> Serialize UTCTime
forall t. Putter t -> Get t -> Serialize t
get :: Get UTCTime
$cget :: Get UTCTime
put :: Putter UTCTime
$cput :: Putter UTCTime
Serialize)

instance AffineSpace UTCTime where
    type Diff UTCTime = NominalDiffTime
    UTCTime NominalDiffTime
a .-. :: UTCTime -> UTCTime -> Diff UTCTime
.-. UTCTime NominalDiffTime
b = NominalDiffTime
a NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^-^ NominalDiffTime
b
    UTCTime NominalDiffTime
a .+^ :: UTCTime -> Diff UTCTime -> UTCTime
.+^ Diff UTCTime
b = NominalDiffTime -> UTCTime
UTCTime (NominalDiffTime
a NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^+^ Diff UTCTime
NominalDiffTime
b)
    {-# INLINE (.-.) #-}
    {-# INLINE (.+^) #-}

getCurrentTime :: IO UTCTime
getCurrentTime :: IO UTCTime
getCurrentTime = NominalDiffTime -> UTCTime
UTCTime (NominalDiffTime -> UTCTime)
-> (POSIXTime -> NominalDiffTime) -> POSIXTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^+^ UTCTime -> NominalDiffTime
_utcTime UTCTime
posixEpoch) (NominalDiffTime -> NominalDiffTime)
-> (POSIXTime -> NominalDiffTime) -> POSIXTime -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> NominalDiffTime
_posixTime
    (POSIXTime -> UTCTime) -> IO POSIXTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime
{-# INLINE getCurrentTime #-}

-- | The date of a UTCTime value represented as modified Julian 'Day'.
--
day :: Lens' UTCTime ModifiedJulianDay
day :: (ModifiedJulianDay -> f ModifiedJulianDay) -> UTCTime -> f UTCTime
day = (UTCTime -> ModifiedJulianDay)
-> (UTCTime -> ModifiedJulianDay -> UTCTime)
-> Lens UTCTime UTCTime ModifiedJulianDay ModifiedJulianDay
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (ModifiedJulianDate -> ModifiedJulianDay
_mjdDay (ModifiedJulianDate -> ModifiedJulianDay)
-> (UTCTime -> ModifiedJulianDate) -> UTCTime -> ModifiedJulianDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> ModifiedJulianDate
toModifiedJulianDate)
    (\UTCTime
a ModifiedJulianDay
b -> ModifiedJulianDate -> UTCTime
fromModifiedJulianDate (ModifiedJulianDate -> UTCTime)
-> (ModifiedJulianDate -> ModifiedJulianDate)
-> ModifiedJulianDate
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  ModifiedJulianDate
  ModifiedJulianDate
  ModifiedJulianDay
  ModifiedJulianDay
-> ModifiedJulianDay -> ModifiedJulianDate -> ModifiedJulianDate
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ModifiedJulianDate
  ModifiedJulianDate
  ModifiedJulianDay
  ModifiedJulianDay
Lens' ModifiedJulianDate ModifiedJulianDay
mjdDay ModifiedJulianDay
b (ModifiedJulianDate -> UTCTime) -> ModifiedJulianDate -> UTCTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> ModifiedJulianDate
toModifiedJulianDate UTCTime
a)
{-# INLINE day #-}

-- | The day time of a 'UTCTime' value represented as 'NominalDiffTime' since
-- @00:00:00@ of that respective day.
--
dayTime :: Lens' UTCTime NominalDiffTime
dayTime :: (NominalDiffTime -> f NominalDiffTime) -> UTCTime -> f UTCTime
dayTime = (UTCTime -> NominalDiffTime)
-> (UTCTime -> NominalDiffTime -> UTCTime)
-> Lens UTCTime UTCTime NominalDiffTime NominalDiffTime
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (ModifiedJulianDate -> NominalDiffTime
_mjdTime (ModifiedJulianDate -> NominalDiffTime)
-> (UTCTime -> ModifiedJulianDate) -> UTCTime -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> ModifiedJulianDate
toModifiedJulianDate)
    (\UTCTime
a NominalDiffTime
b -> ModifiedJulianDate -> UTCTime
fromModifiedJulianDate (ModifiedJulianDate -> UTCTime)
-> (ModifiedJulianDate -> ModifiedJulianDate)
-> ModifiedJulianDate
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  ModifiedJulianDate
  ModifiedJulianDate
  NominalDiffTime
  NominalDiffTime
-> NominalDiffTime -> ModifiedJulianDate -> ModifiedJulianDate
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ModifiedJulianDate
  ModifiedJulianDate
  NominalDiffTime
  NominalDiffTime
Lens' ModifiedJulianDate NominalDiffTime
mjdTime NominalDiffTime
b (ModifiedJulianDate -> UTCTime) -> ModifiedJulianDate -> UTCTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> ModifiedJulianDate
toModifiedJulianDate UTCTime
a)
{-# INLINE dayTime #-}

-- | Create a 'UTCTime' from a date and a daytime. The date is represented
-- as modified Julian 'Day' and the day time is represented as
-- 'NominalDiffTime' since '00:00:00' of the respective day.
--
-- Note that this implementation does not support representation of leap
-- seconds.
--
fromDayAndDayTime :: ModifiedJulianDay -> NominalDiffTime -> UTCTime
fromDayAndDayTime :: ModifiedJulianDay -> NominalDiffTime -> UTCTime
fromDayAndDayTime ModifiedJulianDay
d NominalDiffTime
t = ModifiedJulianDate -> UTCTime
fromModifiedJulianDate (ModifiedJulianDate -> UTCTime) -> ModifiedJulianDate -> UTCTime
forall a b. (a -> b) -> a -> b
$ ModifiedJulianDay -> NominalDiffTime -> ModifiedJulianDate
ModifiedJulianDate ModifiedJulianDay
d NominalDiffTime
t
{-# INLINE fromDayAndDayTime #-}

-- | The POSIX Epoch represented as UTCTime.
--
posixEpoch :: UTCTime
posixEpoch :: UTCTime
posixEpoch = NominalDiffTime -> UTCTime
UTCTime (Day -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Day
d Scalar NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. VectorSpace v => Scalar v -> v -> v
*^ NominalDiffTime
nominalDay)
  where
    ModifiedJulianDay Day
d = ModifiedJulianDay
posixEpochDay
{-# INLINE posixEpoch #-}

-- | The Epoch of the modified Julian day represented as 'UTCTime'.
--
mjdEpoch :: UTCTime
mjdEpoch :: UTCTime
mjdEpoch = NominalDiffTime -> UTCTime
UTCTime NominalDiffTime
forall v. AdditiveGroup v => v
zeroV
{-# INLINE mjdEpoch #-}

-- -------------------------------------------------------------------------- --
-- POSIX Timestamps

-- | POSIX time is the nominal time since 1970-01-01 00:00 UTC. It is
-- represented as 64-bit count of microseconds.
--
-- Users who only need POSIX timestamps can ignore this type and just use
-- 'UTCTime' with 'toPosxiTimestampMicros' and 'fromPosixTimestampMicros'.
--
newtype POSIXTime = POSIXTime { POSIXTime -> NominalDiffTime
_posixTime :: NominalDiffTime }
    deriving (POSIXTime -> POSIXTime -> Bool
(POSIXTime -> POSIXTime -> Bool)
-> (POSIXTime -> POSIXTime -> Bool) -> Eq POSIXTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: POSIXTime -> POSIXTime -> Bool
$c/= :: POSIXTime -> POSIXTime -> Bool
== :: POSIXTime -> POSIXTime -> Bool
$c== :: 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
min :: POSIXTime -> POSIXTime -> POSIXTime
$cmin :: POSIXTime -> POSIXTime -> POSIXTime
max :: POSIXTime -> POSIXTime -> POSIXTime
$cmax :: POSIXTime -> POSIXTime -> POSIXTime
>= :: POSIXTime -> POSIXTime -> Bool
$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
compare :: POSIXTime -> POSIXTime -> Ordering
$ccompare :: POSIXTime -> POSIXTime -> Ordering
$cp1Ord :: Eq POSIXTime
Ord)
    deriving newtype (POSIXTime -> ()
(POSIXTime -> ()) -> NFData POSIXTime
forall a. (a -> ()) -> NFData a
rnf :: POSIXTime -> ()
$crnf :: POSIXTime -> ()
NFData)

-- | Represent POSIXTime as 64-bit value of microseconds since 'posixEpoch'.
--
toTimestampMicros :: POSIXTime -> Micros
toTimestampMicros :: POSIXTime -> Micros
toTimestampMicros = NominalDiffTime -> Micros
_microseconds (NominalDiffTime -> Micros)
-> (POSIXTime -> NominalDiffTime) -> POSIXTime -> Micros
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> NominalDiffTime
_posixTime
{-# INLINE toTimestampMicros #-}

-- | Create POSIXTime from 64-bit value of microseconds since 'posixEpoch'.
--
fromTimestampMicros :: Micros -> POSIXTime
fromTimestampMicros :: Micros -> POSIXTime
fromTimestampMicros = NominalDiffTime -> POSIXTime
POSIXTime (NominalDiffTime -> POSIXTime)
-> (Micros -> NominalDiffTime) -> Micros -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> NominalDiffTime
fromMicroseconds
{-# INLINE fromTimestampMicros #-}

-- | The day of the epoch of 'SystemTime', 1970-01-01
--
posixEpochDay :: ModifiedJulianDay
posixEpochDay :: ModifiedJulianDay
posixEpochDay = Day -> ModifiedJulianDay
ModifiedJulianDay Day
40587
{-# INLINE posixEpochDay #-}

-- | Get current POSIX time
--
getPOSIXTime :: IO POSIXTime
getPOSIXTime :: IO POSIXTime
getPOSIXTime = NominalDiffTime -> POSIXTime
POSIXTime (NominalDiffTime -> POSIXTime)
-> (Micros -> NominalDiffTime) -> Micros -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> NominalDiffTime
NominalDiffTime (Micros -> NominalDiffTime)
-> (Micros -> Micros) -> Micros -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micros -> Micros
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Micros -> POSIXTime) -> IO Micros -> IO POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Micros
getSystemTimeMicros
{-# INLINE getPOSIXTime #-}

-- The following conversions between POSIXTime and UTCTime are efficient because
-- all constants are inlined.

-- | Convert from UTCTime to POSIXTime
--
toPosix :: UTCTime -> POSIXTime
toPosix :: UTCTime -> POSIXTime
toPosix UTCTime
t = NominalDiffTime -> POSIXTime
POSIXTime (NominalDiffTime -> POSIXTime) -> NominalDiffTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
_utcTime UTCTime
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^-^ UTCTime -> NominalDiffTime
_utcTime UTCTime
posixEpoch
{-# INLINE toPosix #-}

-- | Convert from POSIXTime to UTCTime
--
fromPosix :: POSIXTime -> UTCTime
fromPosix :: POSIXTime -> UTCTime
fromPosix POSIXTime
p = NominalDiffTime -> UTCTime
UTCTime (NominalDiffTime -> UTCTime) -> NominalDiffTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> NominalDiffTime
_posixTime POSIXTime
p NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^+^ UTCTime -> NominalDiffTime
_utcTime UTCTime
posixEpoch
{-# INLINE fromPosix #-}

-- -------------------------------------------------------------------------- --
-- Modified Julian Day Representation of UTC

newtype ModifiedJulianDay = ModifiedJulianDay Day
    deriving newtype (ModifiedJulianDay -> ModifiedJulianDay -> Bool
(ModifiedJulianDay -> ModifiedJulianDay -> Bool)
-> (ModifiedJulianDay -> ModifiedJulianDay -> Bool)
-> Eq ModifiedJulianDay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$c/= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
== :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$c== :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
Eq, Eq ModifiedJulianDay
Eq ModifiedJulianDay
-> (ModifiedJulianDay -> ModifiedJulianDay -> Ordering)
-> (ModifiedJulianDay -> ModifiedJulianDay -> Bool)
-> (ModifiedJulianDay -> ModifiedJulianDay -> Bool)
-> (ModifiedJulianDay -> ModifiedJulianDay -> Bool)
-> (ModifiedJulianDay -> ModifiedJulianDay -> Bool)
-> (ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay)
-> (ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay)
-> Ord ModifiedJulianDay
ModifiedJulianDay -> ModifiedJulianDay -> Bool
ModifiedJulianDay -> ModifiedJulianDay -> Ordering
ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
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
min :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
$cmin :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
max :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
$cmax :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
>= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$c>= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
> :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$c> :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
<= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$c<= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
< :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$c< :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
compare :: ModifiedJulianDay -> ModifiedJulianDay -> Ordering
$ccompare :: ModifiedJulianDay -> ModifiedJulianDay -> Ordering
$cp1Ord :: Eq ModifiedJulianDay
Ord, ModifiedJulianDay -> ()
(ModifiedJulianDay -> ()) -> NFData ModifiedJulianDay
forall a. (a -> ()) -> NFData a
rnf :: ModifiedJulianDay -> ()
$crnf :: ModifiedJulianDay -> ()
NFData)

-- | Modified Julian Day Representation of UTC
--
data ModifiedJulianDate = ModifiedJulianDate
    { ModifiedJulianDate -> ModifiedJulianDay
_mjdDay :: !ModifiedJulianDay
    , ModifiedJulianDate -> NominalDiffTime
_mjdTime :: !NominalDiffTime
    }
    deriving (ModifiedJulianDate -> ModifiedJulianDate -> Bool
(ModifiedJulianDate -> ModifiedJulianDate -> Bool)
-> (ModifiedJulianDate -> ModifiedJulianDate -> Bool)
-> Eq ModifiedJulianDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$c/= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
== :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$c== :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
Eq, Eq ModifiedJulianDate
Eq ModifiedJulianDate
-> (ModifiedJulianDate -> ModifiedJulianDate -> Ordering)
-> (ModifiedJulianDate -> ModifiedJulianDate -> Bool)
-> (ModifiedJulianDate -> ModifiedJulianDate -> Bool)
-> (ModifiedJulianDate -> ModifiedJulianDate -> Bool)
-> (ModifiedJulianDate -> ModifiedJulianDate -> Bool)
-> (ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate)
-> (ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate)
-> Ord ModifiedJulianDate
ModifiedJulianDate -> ModifiedJulianDate -> Bool
ModifiedJulianDate -> ModifiedJulianDate -> Ordering
ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
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
min :: ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
$cmin :: ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
max :: ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
$cmax :: ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
>= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$c>= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
> :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$c> :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
<= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$c<= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
< :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$c< :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
compare :: ModifiedJulianDate -> ModifiedJulianDate -> Ordering
$ccompare :: ModifiedJulianDate -> ModifiedJulianDate -> Ordering
$cp1Ord :: Eq ModifiedJulianDate
Ord, (forall x. ModifiedJulianDate -> Rep ModifiedJulianDate x)
-> (forall x. Rep ModifiedJulianDate x -> ModifiedJulianDate)
-> Generic ModifiedJulianDate
forall x. Rep ModifiedJulianDate x -> ModifiedJulianDate
forall x. ModifiedJulianDate -> Rep ModifiedJulianDate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifiedJulianDate x -> ModifiedJulianDate
$cfrom :: forall x. ModifiedJulianDate -> Rep ModifiedJulianDate x
Generic)
    deriving anyclass (ModifiedJulianDate -> ()
(ModifiedJulianDate -> ()) -> NFData ModifiedJulianDate
forall a. (a -> ()) -> NFData a
rnf :: ModifiedJulianDate -> ()
$crnf :: ModifiedJulianDate -> ()
NFData)

mjdDay :: Lens' ModifiedJulianDate ModifiedJulianDay
mjdDay :: (ModifiedJulianDay -> f ModifiedJulianDay)
-> ModifiedJulianDate -> f ModifiedJulianDate
mjdDay = (ModifiedJulianDate -> ModifiedJulianDay)
-> (ModifiedJulianDate -> ModifiedJulianDay -> ModifiedJulianDate)
-> Lens' ModifiedJulianDate ModifiedJulianDay
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ModifiedJulianDate -> ModifiedJulianDay
_mjdDay ((ModifiedJulianDate -> ModifiedJulianDay -> ModifiedJulianDate)
 -> Lens' ModifiedJulianDate ModifiedJulianDay)
-> (ModifiedJulianDate -> ModifiedJulianDay -> ModifiedJulianDate)
-> Lens' ModifiedJulianDate ModifiedJulianDay
forall a b. (a -> b) -> a -> b
$ \ModifiedJulianDate
a ModifiedJulianDay
b -> ModifiedJulianDate
a { _mjdDay :: ModifiedJulianDay
_mjdDay = ModifiedJulianDay
b }
{-# INLINE mjdDay #-}

mjdTime :: Lens' ModifiedJulianDate NominalDiffTime
mjdTime :: (NominalDiffTime -> f NominalDiffTime)
-> ModifiedJulianDate -> f ModifiedJulianDate
mjdTime = (ModifiedJulianDate -> NominalDiffTime)
-> (ModifiedJulianDate -> NominalDiffTime -> ModifiedJulianDate)
-> Lens' ModifiedJulianDate NominalDiffTime
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ModifiedJulianDate -> NominalDiffTime
_mjdTime ((ModifiedJulianDate -> NominalDiffTime -> ModifiedJulianDate)
 -> Lens' ModifiedJulianDate NominalDiffTime)
-> (ModifiedJulianDate -> NominalDiffTime -> ModifiedJulianDate)
-> Lens' ModifiedJulianDate NominalDiffTime
forall a b. (a -> b) -> a -> b
$ \ModifiedJulianDate
a NominalDiffTime
b -> ModifiedJulianDate
a { _mjdTime :: NominalDiffTime
_mjdTime = NominalDiffTime
b }
{-# INLINE mjdTime #-}

-- | Convert from 'UTCTime' to modified 'Julian' Day time.
--
toModifiedJulianDate :: UTCTime -> ModifiedJulianDate
toModifiedJulianDate :: UTCTime -> ModifiedJulianDate
toModifiedJulianDate (UTCTime (NominalDiffTime Micros
m)) = ModifiedJulianDay -> NominalDiffTime -> ModifiedJulianDate
ModifiedJulianDate
    (Day -> ModifiedJulianDay
ModifiedJulianDay (Micros -> Day
forall a b. (Integral a, Num b) => a -> b
fromIntegral Micros
d))
    (Micros -> NominalDiffTime
NominalDiffTime Micros
t)
  where
    (Micros
d, Micros
t) = Micros -> Micros -> (Micros, Micros)
forall a. Integral a => a -> a -> (a, a)
divMod Micros
m Micros
n
    NominalDiffTime Micros
n = NominalDiffTime
nominalDay
{-# INLINE toModifiedJulianDate #-}

-- | Convert from modified 'Julian' Day time to 'UTCTime'.
--
fromModifiedJulianDate :: ModifiedJulianDate -> UTCTime
fromModifiedJulianDate :: ModifiedJulianDate -> UTCTime
fromModifiedJulianDate (ModifiedJulianDate (ModifiedJulianDay Day
d) NominalDiffTime
t)
    = NominalDiffTime -> UTCTime
UTCTime (NominalDiffTime -> UTCTime) -> NominalDiffTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ (Day -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Day
d Scalar NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. VectorSpace v => Scalar v -> v -> v
*^ NominalDiffTime
nominalDay) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^+^ NominalDiffTime
t
{-# INLINE fromModifiedJulianDate #-}