-- |

-- Module      : Time.Compat

-- License     : BSD-style

-- Maintainer  : Nicolas DI PRIMA <nicolas@di-prima.fr>

--

-- Basic Time conversion compatibility.

--

-- This module aims to help conversion between the types from the package

-- time to the package hourglass.

--

-- Example of use (extracted from file Example/Time/Compat.hs):

--

-- > import Data.Hourglass        as H

-- > import Data.Hourglass.Compat as C

-- > import Data.Time             as T

-- >

-- > transpose :: T.ZonedTime

-- >           -> H.LocalTime H.DateTime

-- > transpose oldTime =

-- >     H.localTime

-- >         offsetTime

-- >         (H.DateTime newDate timeofday)

-- >   where

-- >     newDate :: H.Date

-- >     newDate = C.dateFromTAIEpoch $ T.toModifiedJulianDay $ T.localDay $ T.zonedTimeToLocalTime oldTime

-- >

-- >     timeofday :: H.TimeOfDay

-- >     timeofday = C.diffTimeToTimeOfDay $ T.timeOfDayToTime $ T.localTimeOfDay $ T.zonedTimeToLocalTime oldTime

-- >

-- >     offsetTime = H.TimezoneOffset $ fromIntegral $ T.timeZoneMinutes $ T.zonedTimeZone oldTime

--

module Time.Compat
    ( dateFromPOSIXEpoch
    , dateFromTAIEpoch
    , diffTimeToTimeOfDay
    ) where

import Data.Hourglass

-- | Convert an integer which represent the Number of days (To/From) POSIX Epoch

-- to a Date (POSIX Epoch is 1970-01-01).

dateFromPOSIXEpoch :: Integer -- ^ number of days since POSIX Epoch

                   -> Date
dateFromPOSIXEpoch :: Integer -> Date
dateFromPOSIXEpoch Integer
day = do
    let sec :: Elapsed
sec = Seconds -> Elapsed
Elapsed (Seconds -> Elapsed) -> Seconds -> Elapsed
forall a b. (a -> b) -> a -> b
$ Integer -> Seconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Seconds) -> Integer -> Seconds
forall a b. (a -> b) -> a -> b
$ Integer
day Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
86400
    Elapsed -> Date
forall t1 t2. (Timeable t1, Time t2) => t1 -> t2
timeConvert Elapsed
sec

-- | Number of days between POSIX Epoch and TAI Epoch

-- (between 1858-11-17 and 1970-01-01)

daysTAItoPOSIX :: Integer
daysTAItoPOSIX :: Integer
daysTAItoPOSIX = Integer
40587

-- | Convert an integer which represents the Number of days (To/From) TAI Epoch

-- This function allows use of the package time to easily convert the Day into

-- the Hourglass Date representation (TAI Epoch is 1858-11-17).

-- 

-- This function allows user to easily convert a Data.Time.Calendar.Day into Date

--

-- > import qualified Data.Time.Calendar as T

-- >

-- > timeDay :: T.Day

-- >

-- > dateFromTAIEpoch $ T.toModifiedJulianDay timeDay

dateFromTAIEpoch :: Integer -- ^ number of days since TAI Epoch

                 -> Date
dateFromTAIEpoch :: Integer -> Date
dateFromTAIEpoch Integer
dtai =
    Integer -> Date
dateFromPOSIXEpoch (Integer
dtai Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
daysTAItoPOSIX)

-- | Convert of differential of time of a day.

-- (it convers a Data.Time.Clock.DiffTime into a TimeOfDay)

--

-- Example with DiffTime type from time:

--

-- > import qualified Data.Time.Clock as T

-- >

-- > difftime :: T.DiffTime

-- >

-- > diffTimeToTimeOfDay difftime

--

-- Example with the TimeOfDay type from time:

--

-- > import qualified Data.Time.Clock as T

-- >

-- > timeofday :: T.TimeOfDay

-- >

-- > diffTimeToTimeOfDay $ T.timeOfDayToTime timeofday

diffTimeToTimeOfDay :: Real t
                    => t         -- ^ number of seconds of the time of the day

                    -> TimeOfDay
diffTimeToTimeOfDay :: forall t. Real t => t -> TimeOfDay
diffTimeToTimeOfDay t
dt = do
    TimeOfDay
        { todHour :: Hours
todHour = Integer -> Hours
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
hours
        , todMin :: Minutes
todMin  = Integer -> Minutes
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
minutes
        , todSec :: Seconds
todSec  = Integer -> Seconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
seconds
        , todNSec :: NanoSeconds
todNSec = Integer -> NanoSeconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nsecs
        }
  where
    r :: Rational
    r :: Rational
r = t -> Rational
forall a. Real a => a -> Rational
toRational t
dt
    (Integer
secs, Rational
nR) = Rational -> (Integer, Rational)
forall b. Integral b => Rational -> (b, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Rational
r :: (Integer, Rational)
    nsecs :: Integer
    nsecs :: Integer
nsecs = Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
nR Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000000)
    (Integer
minsofday, Integer
seconds) = Integer
secs Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
60 :: (Integer, Integer)
    (Integer
hours, Integer
minutes) = Integer
minsofday Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
60 :: (Integer, Integer)