{-# 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.Data.Format
import Core.Text.Rope
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.Calendar (Day)
import Data.Time.Clock (UTCTime (UTCTime, utctDay, utctDayTime))
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
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
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
Ord, Int -> Time
Time -> Int
Time -> [Time]
Time -> Time
Time -> Time -> [Time]
Time -> Time -> Time -> [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
forall a. a -> a -> Bounded a
maxBound :: Time
$cmaxBound :: Time
minBound :: Time
$cminBound :: Time
Bounded, 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 = 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 = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ (,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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DateTime -> Time
reduceDateTime 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 =
        forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_Precise
ISO8601_Precise String
x
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_Seconds
ISO8601_Seconds String
x
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_DateAndTime
H.ISO8601_DateAndTime String
x
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse ISO8601_Date
H.ISO8601_Date String
x
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse Posix_Precise
Posix_Precise String
x
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse Posix_Micro
Posix_Micro String
x
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall format.
TimeFormat format =>
format -> String -> Maybe DateTime
H.timeParse Posix_Milli
Posix_Milli String
x
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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.

The most important instance is probably the 'UTCTime' one, as many other
Haskell libraries use this type to represent time.

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

{- |
Number of nanoseconds since the epoch.
-}
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> POSIXTime
convertToPosix
    intoTime :: UTCTime -> Time
intoTime = POSIXTime -> Time
convertFromPosix 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 = forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Rational
1000000000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational
    in  Int64 -> Time
Time forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Int64
nano

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

{- |
Convert to the elapsed time with sub-second precision type from __hourglass__,
giving you ready access to that library's time formatting and calendar date
manipulation functions.
-}
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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
seconds :: Int64
        ns :: Int64
ns = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nanoseconds
    in  Int64 -> Time
Time forall a b. (a -> b) -> a -> b
$! (Int64
s forall a. Num a => a -> a -> a
* Int64
1000000000) 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) = 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))

{- |
This instance may be useful if you need to work with calendar dates with
functions from __time__. From here you would probably be interested in
'Data.Time.Calendar.toGregorian'. If you convert from a 'Day' it will be the
timestamp of midnight 00:00:00.0 on that date.

@since 0.3.5
-}
instance Instant Day where
    fromTime :: Time -> Day
fromTime = UTCTime -> Day
utctDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Instant a => Time -> a
fromTime
    intoTime :: Day -> Time
intoTime Day
x = forall a. Instant a => a -> Time
intoTime (UTCTime {utctDay :: Day
utctDay = Day
x, utctDayTime :: DiffTime
utctDayTime = DiffTime
0})

instance Aeson.ToJSON Time where
    toEncoding :: Time -> Encoding
toEncoding = forall a. String -> Encoding' a
Aeson.string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> String
H.timePrint ISO8601_Precise
ISO8601_Precise 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 = (forall α. Textual α => Rope -> α
fromRope (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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
t
                Maybe Time
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse input as a TimeStamp"
    parseJSON (Value
invalid) = 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
    forall (m :: * -> *) a. Monad m => a -> m a
return 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