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

-- |
-- 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
, scaleNominalDiffTime
, divNominalDiffTime

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

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

-- * Reexports
, AdditiveSemigroup(..)
, AdditiveMonoid(..)
, AdditiveGroup(..)
, (^-^)
, (^+^)
, (.+^)
, (^+.)
, (.-.)
, (.-^)
, (*^)
) where

import Control.DeepSeq

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

import Numeric.Additive
import Numeric.AffineSpace

-- -------------------------------------------------------------------------- --
-- 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 -> Int64
_microseconds :: Micros }
    deriving (NominalDiffTime -> NominalDiffTime -> Bool
(NominalDiffTime -> NominalDiffTime -> Bool)
-> (NominalDiffTime -> NominalDiffTime -> Bool)
-> Eq NominalDiffTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NominalDiffTime -> NominalDiffTime -> Bool
== :: NominalDiffTime -> NominalDiffTime -> Bool
$c/= :: NominalDiffTime -> NominalDiffTime -> Bool
/= :: 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
$ccompare :: NominalDiffTime -> NominalDiffTime -> Ordering
compare :: NominalDiffTime -> NominalDiffTime -> Ordering
$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
>= :: NominalDiffTime -> NominalDiffTime -> Bool
$cmax :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
max :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
$cmin :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
min :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
Ord)
    deriving newtype
        ( NominalDiffTime -> ()
(NominalDiffTime -> ()) -> NFData NominalDiffTime
forall a. (a -> ()) -> NFData a
$crnf :: NominalDiffTime -> ()
rnf :: NominalDiffTime -> ()
NFData
        , NominalDiffTime -> NominalDiffTime -> NominalDiffTime
(NominalDiffTime -> NominalDiffTime -> NominalDiffTime)
-> AdditiveSemigroup NominalDiffTime
forall g. (g -> g -> g) -> AdditiveSemigroup g
$cplus :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
plus :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
AdditiveSemigroup, AdditiveSemigroup NominalDiffTime
AdditiveSemigroup NominalDiffTime =>
AdditiveAbelianSemigroup NominalDiffTime
forall g. AdditiveSemigroup g => AdditiveAbelianSemigroup g
AdditiveAbelianSemigroup, AdditiveSemigroup NominalDiffTime
NominalDiffTime
AdditiveSemigroup NominalDiffTime =>
NominalDiffTime -> AdditiveMonoid NominalDiffTime
forall g. AdditiveSemigroup g => g -> AdditiveMonoid g
$czero :: NominalDiffTime
zero :: NominalDiffTime
AdditiveMonoid, AdditiveMonoid NominalDiffTime
AdditiveMonoid NominalDiffTime =>
(NominalDiffTime -> NominalDiffTime)
-> (NominalDiffTime -> NominalDiffTime -> NominalDiffTime)
-> AdditiveGroup NominalDiffTime
NominalDiffTime -> NominalDiffTime
NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall g.
AdditiveMonoid g =>
(g -> g) -> (g -> g -> g) -> AdditiveGroup g
$cinvert :: NominalDiffTime -> NominalDiffTime
invert :: NominalDiffTime -> NominalDiffTime
$cminus :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
minus :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime
AdditiveGroup
        , Day -> NominalDiffTime
NominalDiffTime -> Day
NominalDiffTime -> [NominalDiffTime]
NominalDiffTime -> NominalDiffTime
NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
NominalDiffTime
-> NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
(NominalDiffTime -> NominalDiffTime)
-> (NominalDiffTime -> NominalDiffTime)
-> (Day -> NominalDiffTime)
-> (NominalDiffTime -> Day)
-> (NominalDiffTime -> [NominalDiffTime])
-> (NominalDiffTime -> NominalDiffTime -> [NominalDiffTime])
-> (NominalDiffTime -> NominalDiffTime -> [NominalDiffTime])
-> (NominalDiffTime
    -> NominalDiffTime -> NominalDiffTime -> [NominalDiffTime])
-> Enum NominalDiffTime
forall a.
(a -> a)
-> (a -> a)
-> (Day -> a)
-> (a -> Day)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NominalDiffTime -> NominalDiffTime
succ :: NominalDiffTime -> NominalDiffTime
$cpred :: NominalDiffTime -> NominalDiffTime
pred :: NominalDiffTime -> NominalDiffTime
$ctoEnum :: Day -> NominalDiffTime
toEnum :: Day -> NominalDiffTime
$cfromEnum :: NominalDiffTime -> Day
fromEnum :: NominalDiffTime -> Day
$cenumFrom :: NominalDiffTime -> [NominalDiffTime]
enumFrom :: NominalDiffTime -> [NominalDiffTime]
$cenumFromThen :: NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
enumFromThen :: NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
$cenumFromTo :: NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
enumFromTo :: NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
$cenumFromThenTo :: NominalDiffTime
-> NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
enumFromThenTo :: NominalDiffTime
-> NominalDiffTime -> NominalDiffTime -> [NominalDiffTime]
Enum, NominalDiffTime
NominalDiffTime -> NominalDiffTime -> Bounded NominalDiffTime
forall a. a -> a -> Bounded a
$cminBound :: NominalDiffTime
minBound :: NominalDiffTime
$cmaxBound :: NominalDiffTime
maxBound :: NominalDiffTime
Bounded
        )

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

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

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

-- | Convert from 'NominalDiffTime' to a 'Decimal' representation of seconds.
--
toSeconds :: NominalDiffTime -> Decimal
toSeconds :: NominalDiffTime -> Decimal
toSeconds (NominalDiffTime Int64
m) = Int64 -> Decimal
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int64
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 = Int64 -> NominalDiffTime
NominalDiffTime (Int64 -> NominalDiffTime) -> Int64 -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Decimal -> Int64
forall b. Integral b => Decimal -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Decimal -> Int64) -> Decimal -> Int64
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 = Int64 -> NominalDiffTime
NominalDiffTime (Int64 -> NominalDiffTime) -> Int64 -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int64
86400 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000
{-# INLINE nominalDay #-}

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

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

scaleNominalDiffTime :: Integral a => a -> NominalDiffTime -> NominalDiffTime
scaleNominalDiffTime :: forall a. Integral a => a -> NominalDiffTime -> NominalDiffTime
scaleNominalDiffTime a
scalar (NominalDiffTime Int64
t) = Int64 -> NominalDiffTime
NominalDiffTime (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
scalar Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
t)
{-# INLINE scaleNominalDiffTime #-}

(*^) :: Integral a => a -> NominalDiffTime -> NominalDiffTime
*^ :: forall a. Integral a => a -> NominalDiffTime -> NominalDiffTime
(*^) = a -> NominalDiffTime -> NominalDiffTime
forall a. Integral a => a -> NominalDiffTime -> NominalDiffTime
scaleNominalDiffTime
{-# INLINE (*^) #-}

divNominalDiffTime :: Integral a => NominalDiffTime -> a -> NominalDiffTime
divNominalDiffTime :: forall a. Integral a => NominalDiffTime -> a -> NominalDiffTime
divNominalDiffTime (NominalDiffTime Int64
a) a
s = Int64 -> NominalDiffTime
NominalDiffTime (Int64 -> NominalDiffTime) -> Int64 -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int64
a Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
s)
{-# INLINE divNominalDiffTime #-}

-- -------------------------------------------------------------------------- --
-- 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
$c== :: UTCTime -> UTCTime -> Bool
== :: UTCTime -> UTCTime -> Bool
$c/= :: UTCTime -> UTCTime -> Bool
/= :: 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
$ccompare :: UTCTime -> UTCTime -> Ordering
compare :: UTCTime -> UTCTime -> Ordering
$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
>= :: UTCTime -> UTCTime -> Bool
$cmax :: UTCTime -> UTCTime -> UTCTime
max :: UTCTime -> UTCTime -> UTCTime
$cmin :: UTCTime -> UTCTime -> UTCTime
min :: UTCTime -> UTCTime -> 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
$cfrom :: forall x. UTCTime -> Rep UTCTime x
from :: forall x. UTCTime -> Rep UTCTime x
$cto :: forall x. Rep UTCTime x -> UTCTime
to :: forall x. Rep UTCTime x -> UTCTime
Generic)
    deriving newtype (UTCTime -> ()
(UTCTime -> ()) -> NFData UTCTime
forall a. (a -> ()) -> NFData a
$crnf :: UTCTime -> ()
rnf :: UTCTime -> ()
NFData)
    deriving newtype (Get UTCTime
Putter UTCTime
Putter UTCTime -> Get UTCTime -> Serialize UTCTime
forall t. Putter t -> Get t -> Serialize t
$cput :: Putter UTCTime
put :: Putter UTCTime
$cget :: Get UTCTime
get :: Get UTCTime
Serialize)

instance LeftTorsor UTCTime where
    type Diff UTCTime = NominalDiffTime
    add :: Diff UTCTime -> UTCTime -> UTCTime
add Diff UTCTime
s (UTCTime NominalDiffTime
t) = NominalDiffTime -> UTCTime
UTCTime (Diff UTCTime
NominalDiffTime
s NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall g. AdditiveSemigroup g => g -> g -> g
`plus` NominalDiffTime
t)
    diff :: UTCTime -> UTCTime -> Diff UTCTime
diff (UTCTime NominalDiffTime
t₁) (UTCTime NominalDiffTime
t₂) = NominalDiffTime
t₁ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall g. AdditiveGroup g => g -> g -> g
`minus` NominalDiffTime
t₂
    {-# INLINE add #-}
    {-# INLINE diff #-}

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 g. AdditiveAbelianSemigroup g => g -> g -> g
^+^ 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 :: Lens' UTCTime ModifiedJulianDay
day = (UTCTime -> ModifiedJulianDay)
-> (UTCTime -> ModifiedJulianDay -> UTCTime)
-> Lens' UTCTime 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 :: Lens' UTCTime NominalDiffTime
dayTime = (UTCTime -> NominalDiffTime)
-> (UTCTime -> NominalDiffTime -> UTCTime)
-> Lens' UTCTime 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
d Day -> NominalDiffTime -> NominalDiffTime
forall a. Integral a => a -> NominalDiffTime -> NominalDiffTime
*^ 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 g. AdditiveMonoid g => g
zero
{-# 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
$c== :: POSIXTime -> POSIXTime -> Bool
== :: POSIXTime -> POSIXTime -> Bool
$c/= :: POSIXTime -> POSIXTime -> Bool
/= :: 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
$ccompare :: POSIXTime -> POSIXTime -> Ordering
compare :: POSIXTime -> POSIXTime -> Ordering
$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
>= :: POSIXTime -> POSIXTime -> Bool
$cmax :: POSIXTime -> POSIXTime -> POSIXTime
max :: POSIXTime -> POSIXTime -> POSIXTime
$cmin :: POSIXTime -> POSIXTime -> POSIXTime
min :: POSIXTime -> POSIXTime -> POSIXTime
Ord)
    deriving newtype (POSIXTime -> ()
(POSIXTime -> ()) -> NFData POSIXTime
forall a. (a -> ()) -> NFData a
$crnf :: POSIXTime -> ()
rnf :: POSIXTime -> ()
NFData)

-- | Represent POSIXTime as 64-bit value of microseconds since 'posixEpoch'.
--
toTimestampMicros :: POSIXTime -> Micros
toTimestampMicros :: POSIXTime -> Int64
toTimestampMicros = NominalDiffTime -> Int64
_microseconds (NominalDiffTime -> Int64)
-> (POSIXTime -> NominalDiffTime) -> POSIXTime -> Int64
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 :: Int64 -> POSIXTime
fromTimestampMicros = NominalDiffTime -> POSIXTime
POSIXTime (NominalDiffTime -> POSIXTime)
-> (Int64 -> NominalDiffTime) -> Int64 -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> 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)
-> (Int64 -> NominalDiffTime) -> Int64 -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> NominalDiffTime
NominalDiffTime (Int64 -> NominalDiffTime)
-> (Int64 -> Int64) -> Int64 -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> POSIXTime) -> IO Int64 -> IO POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int64
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 g. AdditiveAbelianGroup g => g -> g -> g
^-^ 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 g. AdditiveAbelianSemigroup g => g -> g -> g
^+^ 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
$c== :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
== :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$c/= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
/= :: 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
$ccompare :: ModifiedJulianDay -> ModifiedJulianDay -> Ordering
compare :: ModifiedJulianDay -> ModifiedJulianDay -> Ordering
$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
>= :: ModifiedJulianDay -> ModifiedJulianDay -> Bool
$cmax :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
max :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
$cmin :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
min :: ModifiedJulianDay -> ModifiedJulianDay -> ModifiedJulianDay
Ord, ModifiedJulianDay -> ()
(ModifiedJulianDay -> ()) -> NFData ModifiedJulianDay
forall a. (a -> ()) -> NFData a
$crnf :: ModifiedJulianDay -> ()
rnf :: 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
$c== :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
== :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$c/= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
/= :: 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
$ccompare :: ModifiedJulianDate -> ModifiedJulianDate -> Ordering
compare :: ModifiedJulianDate -> ModifiedJulianDate -> Ordering
$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
>= :: ModifiedJulianDate -> ModifiedJulianDate -> Bool
$cmax :: ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
max :: ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
$cmin :: ModifiedJulianDate -> ModifiedJulianDate -> ModifiedJulianDate
min :: ModifiedJulianDate -> ModifiedJulianDate -> 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
$cfrom :: forall x. ModifiedJulianDate -> Rep ModifiedJulianDate x
from :: forall x. ModifiedJulianDate -> Rep ModifiedJulianDate x
$cto :: forall x. Rep ModifiedJulianDate x -> ModifiedJulianDate
to :: forall x. Rep ModifiedJulianDate x -> ModifiedJulianDate
Generic)
    deriving anyclass (ModifiedJulianDate -> ()
(ModifiedJulianDate -> ()) -> NFData ModifiedJulianDate
forall a. (a -> ()) -> NFData a
$crnf :: ModifiedJulianDate -> ()
rnf :: ModifiedJulianDate -> ()
NFData)

mjdDay :: Lens' ModifiedJulianDate ModifiedJulianDay
mjdDay :: Lens' ModifiedJulianDate ModifiedJulianDay
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 = b }
{-# INLINE mjdDay #-}

mjdTime :: Lens' ModifiedJulianDate NominalDiffTime
mjdTime :: Lens' ModifiedJulianDate NominalDiffTime
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 = b }
{-# INLINE mjdTime #-}

-- | Convert from 'UTCTime' to modified 'Julian' Day time.
--
toModifiedJulianDate :: UTCTime -> ModifiedJulianDate
toModifiedJulianDate :: UTCTime -> ModifiedJulianDate
toModifiedJulianDate (UTCTime (NominalDiffTime Int64
m)) = ModifiedJulianDay -> NominalDiffTime -> ModifiedJulianDate
ModifiedJulianDate
    (Day -> ModifiedJulianDay
ModifiedJulianDay (Int64 -> Day
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d))
    (Int64 -> NominalDiffTime
NominalDiffTime Int64
t)
  where
    (Int64
d, Int64
t) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
divMod Int64
m Int64
n
    NominalDiffTime Int64
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
d Day -> NominalDiffTime -> NominalDiffTime
forall a. Integral a => a -> NominalDiffTime -> NominalDiffTime
*^ NominalDiffTime
nominalDay) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall g. AdditiveAbelianSemigroup g => g -> g -> g
^+^ NominalDiffTime
t
{-# INLINE fromModifiedJulianDate #-}