module PostgreSQL.Binary.Time where

import Data.Time.Calendar.Julian
import PostgreSQL.Binary.Prelude hiding (second)

{-# INLINEABLE dayToPostgresJulian #-}
dayToPostgresJulian :: Day -> Integer
dayToPostgresJulian :: Day -> Integer
dayToPostgresJulian =
  (forall a. Num a => a -> a -> a
+ (Integer
2400001 forall a. Num a => a -> a -> a
- Integer
2451545)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Day -> Integer
toModifiedJulianDay

{-# INLINEABLE postgresJulianToDay #-}
postgresJulianToDay :: Integral a => a -> Day
postgresJulianToDay :: forall a. Integral a => a -> Day
postgresJulianToDay =
  Integer -> Day
ModifiedJulianDay forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => a -> a -> a
subtract (a
2400001 forall a. Num a => a -> a -> a
- a
2451545)

{-# INLINEABLE microsToTimeOfDay #-}
microsToTimeOfDay :: Int64 -> TimeOfDay
microsToTimeOfDay :: Int64 -> TimeOfDay
microsToTimeOfDay =
  forall s a. State s a -> s -> a
evalState forall a b. (a -> b) -> a -> b
$ do
    Int64
h <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod forall a b. (a -> b) -> a -> b
$ Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
60
    Int64
m <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod forall a b. (a -> b) -> a -> b
$ Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
* Int64
60
    Int64
u <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Int -> Int -> Pico -> TimeOfDay
TimeOfDay (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) (Int64 -> Pico
microsToPico Int64
u)

{-# INLINEABLE microsToUTC #-}
microsToUTC :: Int64 -> UTCTime
microsToUTC :: Int64 -> UTCTime
microsToUTC =
  forall s a. State s a -> s -> a
evalState forall a b. (a -> b) -> a -> b
$ do
    Int64
d <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod forall a b. (a -> b) -> a -> b
$ Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
24
    Int64
u <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Day -> DiffTime -> UTCTime
UTCTime (forall a. Integral a => a -> Day
postgresJulianToDay Int64
d) (Int64 -> DiffTime
microsToDiffTime Int64
u)

{-# INLINEABLE microsToPico #-}
microsToPico :: Int64 -> Pico
microsToPico :: Int64 -> Pico
microsToPico =
  forall a b. a -> b
unsafeCoerce forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Num a => a -> a -> a
* (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Integer)

{-# INLINEABLE microsToDiffTime #-}
microsToDiffTime :: Int64 -> DiffTime
microsToDiffTime :: Int64 -> DiffTime
microsToDiffTime =
  forall a b. a -> b
unsafeCoerce Int64 -> Pico
microsToPico

{-# INLINEABLE microsToLocalTime #-}
microsToLocalTime :: Int64 -> LocalTime
microsToLocalTime :: Int64 -> LocalTime
microsToLocalTime =
  forall s a. State s a -> s -> a
evalState forall a b. (a -> b) -> a -> b
$ do
    Int64
d <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod forall a b. (a -> b) -> a -> b
$ Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
24
    Int64
u <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Day -> TimeOfDay -> LocalTime
LocalTime (forall a. Integral a => a -> Day
postgresJulianToDay Int64
d) (Int64 -> TimeOfDay
microsToTimeOfDay Int64
u)

{-# INLINEABLE secsToTimeOfDay #-}
secsToTimeOfDay :: Double -> TimeOfDay
secsToTimeOfDay :: Double -> TimeOfDay
secsToTimeOfDay =
  forall s a. State s a -> s -> a
evalState forall a b. (a -> b) -> a -> b
$ do
    Integer
h <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' forall a b. (a -> b) -> a -> b
$ Double
60 forall a. Num a => a -> a -> a
* Double
60
    Integer
m <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' forall a b. (a -> b) -> a -> b
$ Double
60
    Double
s <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Int -> Int -> Pico -> TimeOfDay
TimeOfDay (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) (Double -> Pico
secsToPico Double
s)

{-# INLINEABLE secsToUTC #-}
secsToUTC :: Double -> UTCTime
secsToUTC :: Double -> UTCTime
secsToUTC =
  forall s a. State s a -> s -> a
evalState forall a b. (a -> b) -> a -> b
$ do
    Integer
d <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' forall a b. (a -> b) -> a -> b
$ Double
60 forall a. Num a => a -> a -> a
* Double
60 forall a. Num a => a -> a -> a
* Double
24
    Double
s <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Day -> DiffTime -> UTCTime
UTCTime (forall a. Integral a => a -> Day
postgresJulianToDay Integer
d) (Double -> DiffTime
secsToDiffTime Double
s)

{-# INLINEABLE secsToLocalTime #-}
secsToLocalTime :: Double -> LocalTime
secsToLocalTime :: Double -> LocalTime
secsToLocalTime =
  forall s a. State s a -> s -> a
evalState forall a b. (a -> b) -> a -> b
$ do
    Integer
d <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' forall a b. (a -> b) -> a -> b
$ Double
60 forall a. Num a => a -> a -> a
* Double
60 forall a. Num a => a -> a -> a
* Double
24
    Double
s <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Day -> TimeOfDay -> LocalTime
LocalTime (forall a. Integral a => a -> Day
postgresJulianToDay Integer
d) (Double -> TimeOfDay
secsToTimeOfDay Double
s)

{-# INLINEABLE secsToPico #-}
secsToPico :: Double -> Pico
secsToPico :: Double -> Pico
secsToPico Double
s =
  forall a b. a -> b
unsafeCoerce (forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
s forall a. Num a => a -> a -> a
* Rational
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12 :: Integer)

{-# INLINEABLE secsToDiffTime #-}
secsToDiffTime :: Double -> DiffTime
secsToDiffTime :: Double -> DiffTime
secsToDiffTime =
  forall a b. a -> b
unsafeCoerce Double -> Pico
secsToPico

{-# INLINEABLE localTimeToMicros #-}
localTimeToMicros :: LocalTime -> Int64
localTimeToMicros :: LocalTime -> Int64
localTimeToMicros (LocalTime Day
dayX TimeOfDay
timeX) =
  let d :: Integer
d = Day -> Integer
dayToPostgresJulian Day
dayX
      p :: Integer
p = forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
timeX
   in Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
24 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Integral a => a -> a -> a
div Integer
p (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6))

{-# INLINEABLE localTimeToSecs #-}
localTimeToSecs :: LocalTime -> Double
localTimeToSecs :: LocalTime -> Double
localTimeToSecs (LocalTime Day
dayX TimeOfDay
timeX) =
  let d :: Integer
d = Day -> Integer
dayToPostgresJulian Day
dayX
      p :: Integer
p = forall a b. a -> b
unsafeCoerce forall a b. (a -> b) -> a -> b
$ TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
timeX
   in Double
60 forall a. Num a => a -> a -> a
* Double
60 forall a. Num a => a -> a -> a
* Double
24 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d forall a. Num a => a -> a -> a
+ forall a. Fractional a => Rational -> a
fromRational (Integer
p forall a. Integral a => a -> a -> Ratio a
% (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12))

{-# INLINEABLE utcToMicros #-}
utcToMicros :: UTCTime -> Int64
utcToMicros :: UTCTime -> Int64
utcToMicros (UTCTime Day
dayX DiffTime
diffTimeX) =
  let d :: Integer
d = Day -> Integer
dayToPostgresJulian Day
dayX
      p :: Integer
p = forall a b. a -> b
unsafeCoerce DiffTime
diffTimeX
   in Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* Int64
24 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Integral a => a -> a -> a
div Integer
p (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6))

{-# INLINEABLE utcToSecs #-}
utcToSecs :: UTCTime -> Double
utcToSecs :: UTCTime -> Double
utcToSecs (UTCTime Day
dayX DiffTime
diffTimeX) =
  let d :: Integer
d = Day -> Integer
dayToPostgresJulian Day
dayX
      p :: Integer
p = forall a b. a -> b
unsafeCoerce DiffTime
diffTimeX
   in Double
60 forall a. Num a => a -> a -> a
* Double
60 forall a. Num a => a -> a -> a
* Double
24 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d forall a. Num a => a -> a -> a
+ forall a. Fractional a => Rational -> a
fromRational (Integer
p forall a. Integral a => a -> a -> Ratio a
% (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12))

-- * Constants in microseconds according to Julian dates standard

-- According to
-- http://www.postgresql.org/docs/9.1/static/datatype-datetime.html
-- Postgres uses Julian dates internally

Int64
yearMicros :: Int64 = forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
365.2425 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
dayMicros :: Rational)

Int64
dayMicros :: Int64 = Int64
24 forall a. Num a => a -> a -> a
* Int64
hourMicros

Int64
hourMicros :: Int64 = Int64
60 forall a. Num a => a -> a -> a
* Int64
minuteMicros

Int64
minuteMicros :: Int64 = Int64
60 forall a. Num a => a -> a -> a
* Int64
secondMicros

Int64
secondMicros :: Int64 = Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6