{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_HADDOCK prune #-}
module Core.Data.Clock (
Time,
getCurrentTimeNanoseconds,
Instant (fromTime, intoTime),
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,
)
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)
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
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
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
epochTime :: Time
epochTime :: Time
epochTime = Int64 -> Time
Time Int64
0