{-# LANGUAGE Strict #-}

module Database.PostgreSQL.Replicant.PostgresUtils where

import Data.Fixed
import Data.Time
import GHC.Int

postgresEpoch :: IO Int64
postgresEpoch :: IO Int64
postgresEpoch = do
  let epoch :: UTCTime
epoch = (Integer, Int, Int) -> (Int, Int, Pico) -> UTCTime
mkUTCTime (Integer
2000, Int
1, Int
1) (Int
0, Int
0, Pico
0)
  UTCTime
now <- IO UTCTime
getCurrentTime
  Int64 -> IO Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ Pico -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Pico -> Int64)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
1000000) (Pico -> Pico)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Pico
nominalDiffTimeToSeconds (NominalDiffTime -> Int64) -> NominalDiffTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
epoch

-- From https://www.williamyaoh.com/posts/2019-09-16-time-cheatsheet.html
mkUTCTime :: (Integer, Int, Int)
          -> (Int, Int, Pico)
          -> UTCTime
mkUTCTime :: (Integer, Int, Int) -> (Int, Int, Pico) -> UTCTime
mkUTCTime (Integer
year, Int
mon, Int
day) (Int
hours, Int
mins, Pico
secs) =
  Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
mon Int
day)
          (TimeOfDay -> DiffTime
timeOfDayToTime (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
hours Int
mins Pico
secs))