{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_HADDOCK prune #-}

{- |
The standard package for working with dates and times in Haskell, __time__, is
/awkward/. That's a subjective judgment, but over the years there have been
few areas more frustrating than trying to do pragmatic things with calendars
and clocks. This module represents some opinionated approaches to working with
times and dates, and a place to collect some hard-won idioms for converting
between things.

Our original use was wanting to conveniently measure things happening on
distributed computer systems. Since machine clock cycles are in units of
nanoseconds, this has the nice property that, assuming the system clock is not
corrupted, two subsequent events from the same source process are likely to
have monotonically increasing timestamps. And even if the system clock goes to
hell, they're still decently likely to be unique per device. Make for good
keys.

So the timestamp type herein 'Time' is nanoseconds since the Unix epoch; which
in (signed) 64 bits means that you can represent times between early in the
morning of 21 September 1677 through just before midnight on 11 April 2262.
The primary use isn't doing calendaring, though; it's just working with
machine generated timestamps in distributed systems and for conveying start
and end times around in your program.

There are quite a few other time formats around the Haskell ecosystem. You can
use the 'fromTime' and 'intoTime' methods of the 'Instant' typeclass  to
convert from one to another if you need to.
-}
module Core.Data.Clock (
    -- * Time type
    Time,
    getCurrentTimeNanoseconds,

    -- * Conversions
    Instant (fromTime, intoTime),

    -- * Internals
    unTime,
    epochTime,
) where

import Control.Applicative ((<|>))
import Core.Text.Rope
import Core.Data.Format
import Data.Aeson qualified as Aeson (FromJSON (..), ToJSON (..), Value (..))
import Data.Aeson.Encoding qualified as Aeson (string)
import Data.Aeson.Types qualified as Aeson (typeMismatch)
import Data.Hourglass qualified as H (
    DateTime (..),
    Elapsed (..),
    ElapsedP (..),
    ISO8601_Date (..),
    ISO8601_DateAndTime (..),
    NanoSeconds (..),
    Seconds (..),
    Timeable (timeGetElapsedP),
    timeParse,
    timePrint,
 )
import Data.Int (Int64)
import Data.Maybe (maybeToList)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (
    POSIXTime,
    posixSecondsToUTCTime,
    utcTimeToPOSIXSeconds,
 )
import GHC.Generics
import Time.System qualified as H (
    timeCurrentP,
 )

{- |
Number of nanoseconds since the Unix epoch.

The 'Show' and 'Core.Encoding.External.Externalize' instances display the
'Time' as seconds with the nanosecond precision expressed as a decimal amount
after the interger, ie:

>>> t <- getCurrentTimeNanoseconds
>>> formatExternal t
"2014-07-31T23:09:35.274387031Z"

However this doesn't change the fact the underlying representation counts
nanoseconds since epoch:

>>> show $ unTime t
"1406848175274387031"

There is a 'Externalize' instance that is reasonably accommodating:

>>> parseExternal "2014-07-31T13:05:04.942089001Z" :: Maybe Time
Just 2014-07-31T13:05:04.942089001Z

>>> parseExternal "1406811904.942089001" :: Maybe Time
Just 2014-07-31T13:05:04.942089001Z

>>> parseExternal "1406811904" :: Maybe Time
Just 2014-07-31T13:05:04.000000000Z

In case you're wondering, the valid range of nanoseconds that fits into the
underlying 'Int64' is:

>>> formatExternal (minBound :: Time)
"1677-09-21T00:12:43.145224192Z"

>>> formatExternal (maxBound :: Time)
"2262-04-11T23:47:16.854775807Z"

so in a quarter millenium's time, yes, you'll have the Y2262 Problem.
Haskell code from today will, of course, still be running, so in the mid
Twenty-Third century you will need to replace this implementation with
something else.

@since 0.3.3
-}
newtype Time = Time Int64
    deriving (Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq, Eq Time
Eq Time
-> (Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
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 :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmax :: Time -> Time -> Time
>= :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c< :: Time -> Time -> Bool
compare :: Time -> Time -> Ordering
$ccompare :: Time -> Time -> Ordering
$cp1Ord :: Eq Time
Ord, Int -> Time
Time -> Int
Time -> [Time]
Time -> Time
Time -> Time -> [Time]
Time -> Time -> Time -> [Time]
(Time -> Time)
-> (Time -> Time)
-> (Int -> Time)
-> (Time -> Int)
-> (Time -> [Time])
-> (Time -> Time -> [Time])
-> (Time -> Time -> [Time])
-> (Time -> Time -> Time -> [Time])
-> Enum Time
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Time -> Time -> Time -> [Time]
$cenumFromThenTo :: Time -> Time -> Time -> [Time]
enumFromTo :: Time -> Time -> [Time]
$cenumFromTo :: Time -> Time -> [Time]
enumFromThen :: Time -> Time -> [Time]
$cenumFromThen :: Time -> Time -> [Time]
enumFrom :: Time -> [Time]
$cenumFrom :: Time -> [Time]
fromEnum :: Time -> Int
$cfromEnum :: Time -> Int
toEnum :: Int -> Time
$ctoEnum :: Int -> Time
pred :: Time -> Time
$cpred :: Time -> Time
succ :: Time -> Time
$csucc :: Time -> Time
Enum, Time
Time -> Time -> Bounded Time
forall a. a -> a -> Bounded a
maxBound :: Time
$cmaxBound :: Time
minBound :: Time
$cminBound :: Time
Bounded, (forall x. Time -> Rep Time x)
-> (forall x. Rep Time x -> Time) -> Generic Time
forall x. Rep Time x -> Time
forall x. Time -> Rep Time x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Time x -> Time
$cfrom :: forall x. Time -> Rep Time x
Generic)

{- |
If you need to manipulate the date or calculate elapsed time then you can
dig out the underlying 'Int64' here. We have /not/ provided instances of
'Num', 'Real', or 'Integral' for the timestamp type because adding two
timestamps doesn't really make sense. You can use 'intoTime' to reconstruct a
timestamp subsequently if necessary.

@since 0.3.3
-}
unTime :: Time -> Int64
unTime :: Time -> Int64
unTime (Time Int64
ticks) = Int64
ticks
{-# INLINE unTime #-}

instance Show Time where
    show :: Time -> String
show Time
t = ISO8601_Precise -> ElapsedP -> String
forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> String
H.timePrint ISO8601_Precise
ISO8601_Precise (Time -> ElapsedP
convertToElapsed Time
t)

instance Read Time where
    readsPrec :: Int -> ReadS Time
readsPrec Int
_ String
s = Maybe (Time, String) -> [(Time, String)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Time, String) -> [(Time, String)])
-> Maybe (Time, String) -> [(Time, String)]
forall a b. (a -> b) -> a -> b
$ (,String
"") (Time -> (Time, String)) -> Maybe Time -> Maybe (Time, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Time
parseInput String
s

parseInput :: String -> Maybe Time
parseInput :: String -> Maybe Time
parseInput = (DateTime -> Time) -> Maybe DateTime -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DateTime -> Time
reduceDateTime (Maybe DateTime -> Maybe Time)
-> (String -> Maybe DateTime) -> String -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe DateTime
parse
  where
    parse :: String -> Maybe H.DateTime
    parse :: String -> Maybe DateTime
parse String
x =
        ISO8601_Precise -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_Precise
ISO8601_Precise String
x
            Maybe DateTime -> Maybe DateTime -> Maybe DateTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ISO8601_Seconds -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_Seconds
ISO8601_Seconds String
x
            Maybe DateTime -> Maybe DateTime -> Maybe DateTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ISO8601_DateAndTime -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_DateAndTime
H.ISO8601_DateAndTime String
x
            Maybe DateTime -> Maybe DateTime -> Maybe DateTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ISO8601_Date -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_Date
H.ISO8601_Date String
x
            Maybe DateTime -> Maybe DateTime -> Maybe DateTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Posix_Precise -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse Posix_Precise
Posix_Precise String
x
            Maybe DateTime -> Maybe DateTime -> Maybe DateTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Posix_Micro -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse Posix_Micro
Posix_Micro String
x
            Maybe DateTime -> Maybe DateTime -> Maybe DateTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Posix_Milli -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse Posix_Milli
Posix_Milli String
x
            Maybe DateTime -> Maybe DateTime -> Maybe DateTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Posix_Seconds -> String -> Maybe DateTime
forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse Posix_Seconds
Posix_Seconds String
x

    reduceDateTime :: H.DateTime -> Time
    reduceDateTime :: DateTime -> Time
reduceDateTime = ElapsedP -> Time
convertFromElapsed (ElapsedP -> Time) -> (DateTime -> ElapsedP) -> DateTime -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateTime -> ElapsedP
forall t. Timeable t => t -> ElapsedP
H.timeGetElapsedP

{- |
Convert between different representations of time. Our 'Time' timestamp has
nanosecond precision so converting from a type with  lesser or greater
precision will require you to either pad with zeros or to round to the nearest
nanosecond (who the hell has picoseconds of anything anyway?) if writing an
instance of this type.

@since 0.3.3
-}
class Instant a where
    fromTime :: Time -> a
    intoTime :: a -> Time

instance Instant Int64 where
    fromTime :: Time -> Int64
fromTime = Time -> Int64
unTime
    intoTime :: Int64 -> Time
intoTime = Int64 -> Time
Time

instance Instant UTCTime where
    fromTime :: Time -> UTCTime
fromTime = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (Time -> POSIXTime) -> Time -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> POSIXTime
convertToPosix
    intoTime :: UTCTime -> Time
intoTime = POSIXTime -> Time
convertFromPosix (POSIXTime -> Time) -> (UTCTime -> POSIXTime) -> UTCTime -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds

instance Instant POSIXTime where
    fromTime :: Time -> POSIXTime
fromTime = Time -> POSIXTime
convertToPosix
    intoTime :: POSIXTime -> Time
intoTime = POSIXTime -> Time
convertFromPosix

convertFromPosix :: POSIXTime -> Time
convertFromPosix :: POSIXTime -> Time
convertFromPosix =
    let nano :: POSIXTime -> Int64
        nano :: POSIXTime -> Int64
nano = Rational -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Int64)
-> (POSIXTime -> Rational) -> POSIXTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000000) (Rational -> Rational)
-> (POSIXTime -> Rational) -> POSIXTime -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational
     in Int64 -> Time
Time (Int64 -> Time) -> (POSIXTime -> Int64) -> POSIXTime -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> (POSIXTime -> Int64) -> POSIXTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Int64
nano

convertToPosix :: Time -> POSIXTime
convertToPosix :: Time -> POSIXTime
convertToPosix = Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime) -> (Time -> Rational) -> Time -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1e9) (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Rational) -> (Time -> Int64) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Int64
unTime

instance Instant H.ElapsedP where
    fromTime :: Time -> ElapsedP
fromTime = Time -> ElapsedP
convertToElapsed
    intoTime :: ElapsedP -> Time
intoTime = ElapsedP -> Time
convertFromElapsed

convertFromElapsed :: H.ElapsedP -> Time
convertFromElapsed :: ElapsedP -> Time
convertFromElapsed (H.ElapsedP (H.Elapsed (H.Seconds Int64
seconds)) (H.NanoSeconds Int64
nanoseconds)) =
    let s :: Int64
s = Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
seconds :: Int64
        ns :: Int64
ns = Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nanoseconds
     in Int64 -> Time
Time (Int64 -> Time) -> Int64 -> Time
forall a b. (a -> b) -> a -> b
$! (Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
ns

convertToElapsed :: Time -> H.ElapsedP
convertToElapsed :: Time -> ElapsedP
convertToElapsed (Time Int64
ticks) =
    let (Int64
s, Int64
ns) = Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
divMod Int64
ticks Int64
1000000000
     in Elapsed -> NanoSeconds -> ElapsedP
H.ElapsedP (Seconds -> Elapsed
H.Elapsed (Int64 -> Seconds
H.Seconds (Int64
s))) (Int64 -> NanoSeconds
H.NanoSeconds (Int64
ns))

instance Aeson.ToJSON Time where
    toEncoding :: Time -> Encoding
toEncoding = String -> Encoding
forall a. String -> Encoding' a
Aeson.string (String -> Encoding) -> (Time -> String) -> Time -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO8601_Precise -> ElapsedP -> String
forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> String
H.timePrint ISO8601_Precise
ISO8601_Precise (ElapsedP -> String) -> (Time -> ElapsedP) -> Time -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> ElapsedP
convertToElapsed

instance Aeson.FromJSON Time where
    parseJSON :: Value -> Parser Time
parseJSON (Aeson.String Text
value) =
        let str :: String
str = (Rope -> String
forall α. Textual α => Rope -> α
fromRope (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
value))
            result :: Maybe Time
result = String -> Maybe Time
parseInput String
str
         in case Maybe Time
result of
                Just Time
t -> Time -> Parser Time
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
t
                Maybe Time
Nothing -> String -> Parser Time
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse input as a TimeStamp"
    parseJSON (Value
invalid) = String -> Value -> Parser Time
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"TimeStamp" Value
invalid

{- |
Get the current system time, expressed as a 'Time' (which is to
say, number of nanoseconds since the Unix epoch).

@since 0.3.3
-}
getCurrentTimeNanoseconds :: IO Time
getCurrentTimeNanoseconds :: IO Time
getCurrentTimeNanoseconds = do
    ElapsedP
p <- IO ElapsedP
H.timeCurrentP
    Time -> IO Time
forall (m :: * -> *) a. Monad m => a -> m a
return (Time -> IO Time) -> Time -> IO Time
forall a b. (a -> b) -> a -> b
$! ElapsedP -> Time
convertFromElapsed ElapsedP
p

{- |
The occasion of the Unix epoch, 1970-01-01T00:00:00.0Z.

@since 0.3.3
-}
epochTime :: Time
epochTime :: Time
epochTime = Int64 -> Time
Time Int64
0