{-# 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 -> Int64
_microseconds :: Micros }
    deriving (NominalDiffTime -> NominalDiffTime -> Bool
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
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
Ord)
    deriving newtype (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 -> 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 #-}

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

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

-- | 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 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) = forall a b. (Real a, Fractional b) => a -> b
realToFrac Int64
m 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 forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Decimal
d 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 forall a b. (a -> b) -> a -> b
$ Int64
86400 forall a. Num a => a -> a -> a
* Int64
1000000
{-# INLINE nominalDay #-}

toPosixTimestampMicros :: UTCTime -> Micros
toPosixTimestampMicros :: UTCTime -> Int64
toPosixTimestampMicros = POSIXTime -> Int64
toTimestampMicros 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> 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
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
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
Ord)
    deriving (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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: UTCTime -> ()
$crnf :: UTCTime -> ()
NFData)
    deriving newtype (Get UTCTime
Putter 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 forall v. AdditiveGroup v => v -> v -> v
^-^ NominalDiffTime
b
    UTCTime NominalDiffTime
a .+^ :: UTCTime -> Diff UTCTime -> UTCTime
.+^ Diff UTCTime
b = NominalDiffTime -> UTCTime
UTCTime (NominalDiffTime
a forall v. AdditiveGroup v => v -> v -> v
^+^ Diff UTCTime
b)
    {-# INLINE (.-.) #-}
    {-# INLINE (.+^) #-}

getCurrentTime :: IO UTCTime
getCurrentTime :: IO UTCTime
getCurrentTime = NominalDiffTime -> UTCTime
UTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall v. AdditiveGroup v => v -> v -> v
^+^ UTCTime -> NominalDiffTime
_utcTime UTCTime
posixEpoch) forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> NominalDiffTime
_posixTime
    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 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (ModifiedJulianDate -> ModifiedJulianDay
_mjdDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> ModifiedJulianDate
toModifiedJulianDate)
    (\UTCTime
a ModifiedJulianDay
b -> ModifiedJulianDate -> UTCTime
fromModifiedJulianDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ModifiedJulianDate ModifiedJulianDay
mjdDay ModifiedJulianDay
b 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 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (ModifiedJulianDate -> NominalDiffTime
_mjdTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> ModifiedJulianDate
toModifiedJulianDate)
    (\UTCTime
a NominalDiffTime
b -> ModifiedJulianDate -> UTCTime
fromModifiedJulianDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ModifiedJulianDate NominalDiffTime
mjdTime NominalDiffTime
b 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 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Day
d 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 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
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
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
Ord)
    deriving newtype (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 -> Int64
toTimestampMicros = NominalDiffTime -> Int64
_microseconds 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> NominalDiffTime
NominalDiffTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
_utcTime UTCTime
t 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 forall a b. (a -> b) -> a -> b
$ POSIXTime -> NominalDiffTime
_posixTime POSIXTime
p 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
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
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
Ord, 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
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
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
Ord, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: ModifiedJulianDate -> ()
$crnf :: ModifiedJulianDate -> ()
NFData)

mjdDay :: Lens' ModifiedJulianDate ModifiedJulianDay
mjdDay :: Lens' ModifiedJulianDate ModifiedJulianDay
mjdDay = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ModifiedJulianDate -> ModifiedJulianDay
_mjdDay 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 :: Lens' ModifiedJulianDate NominalDiffTime
mjdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ModifiedJulianDate -> NominalDiffTime
_mjdTime 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 Int64
m)) = ModifiedJulianDay -> NominalDiffTime -> ModifiedJulianDate
ModifiedJulianDate
    (Day -> ModifiedJulianDay
ModifiedJulianDay (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d))
    (Int64 -> NominalDiffTime
NominalDiffTime Int64
t)
  where
    (Int64
d, Int64
t) = 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 forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Day
d forall v. VectorSpace v => Scalar v -> v -> v
*^ NominalDiffTime
nominalDay) forall v. AdditiveGroup v => v -> v -> v
^+^ NominalDiffTime
t
{-# INLINE fromModifiedJulianDate #-}