{- |
Module      : Data.Time.Zones.Internal
Copyright   : (C) 2014 Mihaly Barasz
License     : Apache-2.0, see LICENSE
Maintainer  : Janus Troelsen <ysangkok@gmail.com>
Stability   : experimental
-}

{-# LANGUAGE CPP #-}
#ifdef TZ_TH
{-# LANGUAGE TemplateHaskell #-}
#endif

module Data.Time.Zones.Internal (
  -- * Time conversion to/from @Int64@
  utcTimeToInt64,
  utcTimeToInt64Pair,
  localTimeToInt64Pair,
  int64PairToUTCTime,
  int64PairToLocalTime,
  -- * Low-level \"coercions\"
  picoToInteger,
  integerToPico,
  diffTimeToPico,
  picoToDiffTime,
  diffTimeToInteger,
  integerToDiffTime,
  ) where

import Data.Fixed
import Data.Int
import Data.Time
#ifdef TZ_TH
import Data.Time.Zones.Internal.CoerceTH
#else
import Unsafe.Coerce
#endif

utcTimeToInt64Pair :: UTCTime -> (Int64, Int64)
utcTimeToInt64Pair :: UTCTime -> (Int64, Int64)
utcTimeToInt64Pair (UTCTime (ModifiedJulianDay Integer
d) DiffTime
t)
  = (Int64
86400 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
unixEpochDay) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
s, Int64
ps)
  where
    (Int64
s, Int64
ps) = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DiffTime -> Integer
diffTimeToInteger DiffTime
t) Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
1000000000000
    unixEpochDay :: Int64
unixEpochDay = Int64
40587
{-# INLINE utcTimeToInt64Pair #-}

int64PairToLocalTime :: Int64 -> Int64 -> LocalTime
int64PairToLocalTime :: Int64 -> Int64 -> LocalTime
int64PairToLocalTime Int64
t Int64
ps = Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Day
ModifiedJulianDay Integer
day) (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s)
  where
    (Int64
day64, Int64
tid64) = Int64
t Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
86400
    day :: Integer
day = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ Int64
day64 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
40587
    (Int
h, Int
ms) = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
tid64 Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
3600
    (Int
m, Int
s0) = Int
ms Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60
    s :: Pico
s = Integer -> Pico
integerToPico (Integer -> Pico) -> Integer -> Pico
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ Int64
ps Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1000000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s0
{-# INLINE int64PairToLocalTime #-}

localTimeToInt64Pair :: LocalTime -> (Int64, Int64)
localTimeToInt64Pair :: LocalTime -> (Int64, Int64)
localTimeToInt64Pair (LocalTime (ModifiedJulianDay Integer
day) (TimeOfDay Int
h Int
m Pico
s))
  = (Int64
86400 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
day Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
unixEpochDay) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tid, Int64
ps)
  where
    (Int64
s64, Int64
ps) = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pico -> Integer
picoToInteger Pico
s) Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
1000000000000
    tid :: Int64
tid = Int64
s64 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60)
    unixEpochDay :: Int64
unixEpochDay = Int64
40587
{-# INLINE localTimeToInt64Pair #-}

int64PairToUTCTime :: Int64 -> Int64 -> UTCTime
int64PairToUTCTime :: Int64 -> Int64 -> UTCTime
int64PairToUTCTime Int64
t Int64
ps = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
day) DiffTime
tid
  where
    (Int64
day64, Int64
tid64) = Int64
t Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
86400
    day :: Integer
day = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ Int64
day64 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
40587
    tid :: DiffTime
tid = Integer -> DiffTime
integerToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ Int64
ps Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tid64 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000000
{-# INLINE int64PairToUTCTime #-}

utcTimeToInt64 :: UTCTime -> Int64
utcTimeToInt64 :: UTCTime -> Int64
utcTimeToInt64 (UTCTime (ModifiedJulianDay Integer
d) DiffTime
t)
  = Int64
86400 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
unixEpochDay)
    Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DiffTime -> Integer
diffTimeToInteger DiffTime
t) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000000000000
  where
    unixEpochDay :: Int64
unixEpochDay = Int64
40587
{-# INLINE utcTimeToInt64 #-}

--------------------------------------------------------------------------------
-- Low-level zero-overhead conversions.
-- Basically we could have used 'coerce' if the constructors were exported.

-- TODO(klao): Is it better to inline them saturated or unsaturated?

#ifdef TZ_TH

picoToInteger :: Pico -> Integer
picoToInteger :: Pico -> Integer
picoToInteger Pico
p = $(destructNewType ''Fixed) Pico
p
{-# INLINE picoToInteger #-}

integerToPico :: Integer -> Pico
integerToPico :: Integer -> Pico
integerToPico Integer
i = $(constructNewType ''Fixed) Integer
i
{-# INLINE integerToPico #-}

diffTimeToPico :: DiffTime -> Pico
diffTimeToPico :: DiffTime -> Pico
diffTimeToPico DiffTime
dt = $(destructNewType ''DiffTime) DiffTime
dt
{-# INLINE diffTimeToPico #-}

picoToDiffTime :: Pico -> DiffTime
picoToDiffTime :: Pico -> DiffTime
picoToDiffTime Pico
p = $(constructNewType ''DiffTime) Pico
p
{-# INLINE picoToDiffTime #-}

diffTimeToInteger :: DiffTime -> Integer
diffTimeToInteger :: DiffTime -> Integer
diffTimeToInteger DiffTime
dt = Pico -> Integer
picoToInteger (DiffTime -> Pico
diffTimeToPico DiffTime
dt)
{-# INLINE diffTimeToInteger #-}

integerToDiffTime :: Integer -> DiffTime
integerToDiffTime :: Integer -> DiffTime
integerToDiffTime Integer
i = Pico -> DiffTime
picoToDiffTime (Integer -> Pico
integerToPico Integer
i)
{-# INLINE integerToDiffTime #-}

#else

picoToInteger :: Pico -> Integer
picoToInteger = unsafeCoerce
{-# INLINE picoToInteger #-}

integerToPico :: Integer -> Pico
integerToPico = unsafeCoerce
{-# INLINE integerToPico #-}

diffTimeToPico :: DiffTime -> Pico
diffTimeToPico = unsafeCoerce
{-# INLINE diffTimeToPico #-}

picoToDiffTime :: Pico -> DiffTime
picoToDiffTime = unsafeCoerce
{-# INLINE picoToDiffTime #-}

diffTimeToInteger :: DiffTime -> Integer
diffTimeToInteger = unsafeCoerce
{-# INLINE diffTimeToInteger #-}

integerToDiffTime :: Integer -> DiffTime
integerToDiffTime = unsafeCoerce
{-# INLINE integerToDiffTime #-}

#endif