{-# LANGUAGE CPP #-}
module Data.Avro.Internal.Time where

-- Utility functions to work with times

import Data.Fixed            (Fixed (..))
import Data.Maybe            (fromJust)
import Data.Time
import Data.Time.Clock
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
#if MIN_VERSION_time(1,9,0)
import Data.Time.Format.Internal
#else
import Data.Time.Format
#endif

epoch :: UTCTime
epoch :: UTCTime
epoch = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
{-# INLINE epoch #-}

epochDate :: Day
epochDate :: Day
epochDate = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall t. ParseTime t => TimeLocale -> [(Char, String)] -> Maybe t
buildTime TimeLocale
defaultTimeLocale []

daysSinceEpoch :: Day -> Integer
daysSinceEpoch :: Day -> Integer
daysSinceEpoch Day
d = Day -> Day -> Integer
diffDays Day
d Day
epochDate

fromDaysSinceEpoch :: Integer -> Day
fromDaysSinceEpoch :: Integer -> Day
fromDaysSinceEpoch Integer
n = Integer -> Day -> Day
addDays Integer
n Day
epochDate

diffTimeToMicros :: DiffTime -> Integer
diffTimeToMicros :: DiffTime -> Integer
diffTimeToMicros = (forall a. Integral a => a -> a -> a
`div` Integer
1000000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds

microsToDiffTime :: Integer -> DiffTime
microsToDiffTime :: Integer -> DiffTime
microsToDiffTime = Integer -> DiffTime
picosecondsToDiffTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Integer
1000000)

diffTimeToMillis :: DiffTime -> Integer
diffTimeToMillis :: DiffTime -> Integer
diffTimeToMillis = (forall a. Integral a => a -> a -> a
`div` Integer
1000000000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds

millisToDiffTime :: Integer -> DiffTime
millisToDiffTime :: Integer -> DiffTime
millisToDiffTime = Integer -> DiffTime
picosecondsToDiffTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Integer
1000000000)

utcTimeToMicros :: UTCTime -> Integer
utcTimeToMicros :: UTCTime -> Integer
utcTimeToMicros UTCTime
t = DiffTime -> Integer
diffTimeToPicoseconds (forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> POSIXTime
diffUTCTime UTCTime
t UTCTime
epoch)) forall a. Integral a => a -> a -> a
`div` Integer
1000000

utcTimeToMillis :: UTCTime -> Integer
utcTimeToMillis :: UTCTime -> Integer
utcTimeToMillis = (forall a. Integral a => a -> a -> a
`div` Integer
1000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Integer
utcTimeToMicros

microsToUTCTime :: Integer -> UTCTime
microsToUTCTime :: Integer -> UTCTime
microsToUTCTime Integer
x = POSIXTime -> UTCTime -> UTCTime
addUTCTime (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
picosecondsToDiffTime (Integer
x forall a. Num a => a -> a -> a
* Integer
1000000)) UTCTime
epoch

millisToUTCTime :: Integer -> UTCTime
millisToUTCTime :: Integer -> UTCTime
millisToUTCTime Integer
x = POSIXTime -> UTCTime -> UTCTime
addUTCTime (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
picosecondsToDiffTime (Integer
x forall a. Num a => a -> a -> a
* Integer
1000000000)) UTCTime
epoch

localTimeToMicros :: LocalTime -> Integer
localTimeToMicros :: LocalTime -> Integer
localTimeToMicros = UTCTime -> Integer
utcTimeToMicros forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc

localTimeToMillis :: LocalTime -> Integer
localTimeToMillis :: LocalTime -> Integer
localTimeToMillis = UTCTime -> Integer
utcTimeToMillis forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc

microsToLocalTime :: Integer -> LocalTime
microsToLocalTime :: Integer -> LocalTime
microsToLocalTime = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> UTCTime
microsToUTCTime

millisToLocalTime :: Integer -> LocalTime
millisToLocalTime :: Integer -> LocalTime
millisToLocalTime = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> UTCTime
millisToUTCTime