{- |
Module      : Time.Compat
License     : BSD-style
Copyright   : (c) 2015 Nicolas DI PRIMA <nicolas@di-prima.fr>

Basic time conversion compatibility.

This module aims to help conversion between types from @time@ package and types
from the @time-hourglass@ package.

An example of use (taken from file examples/Example/Time/Compat.hs):

> import Data.Hourglass as H
> import Time.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
>   T.ZonedTime (T.LocalTime day tod) (T.TimeZone tzmin _ _) = oldTime
>
>   newDate :: H.Date
>   newDate = C.dateFromMJDEpoch $ T.toModifiedJulianDay day
>
>   timeofday :: H.TimeOfDay
>   timeofday = C.diffTimeToTimeOfDay $ toRational $ T.timeOfDayToTime tod
>
>   offsetTime = H.TimezoneOffset $ fromIntegral tzmin
-}

module Time.Compat
  ( dateFromUnixEpoch
  , dateFromMJDEpoch
  , diffTimeToTimeOfDay
    -- * Deprecated

  , dateFromPOSIXEpoch
  , dateFromTAIEpoch
  ) where

import           Time.Time ( timeConvert )
import           Time.Types ( Date, Elapsed (..), TimeOfDay (..) )

-- | Given an integer which represents the number of days since the start of the

-- Unix epoch (1970-01-01 00:00:00 UTC), yield the corresponding date in the

-- proleptic Gregorian calendar.

dateFromUnixEpoch ::
     Integer
     -- ^ Number of days since the start of the Unix epoch

     -- (1970-01-01 00:00:00 UTC).

  -> Date
dateFromUnixEpoch :: Integer -> Date
dateFromUnixEpoch 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

-- | Same as 'dateFromUnixEpoch'.

dateFromPOSIXEpoch ::
     Integer
     -- ^ Number of days since the start of the Unix epoch

     -- (1970-01-01 00:00:00 UTC).

  -> Date
dateFromPOSIXEpoch :: Integer -> Date
dateFromPOSIXEpoch = Integer -> Date
dateFromUnixEpoch
{-# DEPRECATED dateFromPOSIXEpoch "Will be removed from future versions of this package. Use dateFromUnixEpoch" #-}

-- | The number of days between the start of the Modified Julian Date (MJD)

-- epoch (1858-11-17 00:00:00 UTC) and the start of the Unix epoch

-- (1970-01-01 00:00:00 UTC).

daysMJDtoUnix :: Integer
daysMJDtoUnix :: Integer
daysMJDtoUnix = Integer
40587

-- | Given an integer which represents the number of days since the start of the

-- Modified Julian Date (MJD) epoch (1858-11-17 00:00:00 UTC), yields the

-- corresponding date in the proleptic Gregorian calendar.

--

-- This function allows a user to convert a t'Data.Time.Calendar.Day'

-- into t'Date'.

--

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

-- >

-- > timeDay :: T.Day

-- >

-- > dateFromMJDEpoch $ T.toModifiedJulianDay timeDay

dateFromMJDEpoch ::
     Integer
     -- ^ Number of days since 1858-11-17 00:00:00 UTC.

  -> Date
dateFromMJDEpoch :: Integer -> Date
dateFromMJDEpoch Integer
dtai =
  Integer -> Date
dateFromUnixEpoch (Integer
dtai Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
daysMJDtoUnix)

-- | Same as 'dateFromMJDEpoch'.

--

-- The name of this function is a misnomer, as the International Atomic Time

-- (TAI) epoch starts on 1958-01-01 00:00:00 UTC.

dateFromTAIEpoch ::
     Integer
     -- ^ Number of days since 1858-11-17 00:00:00 UTC.

  -> Date
dateFromTAIEpoch :: Integer -> Date
dateFromTAIEpoch = Integer -> Date
dateFromMJDEpoch
{-# DEPRECATED dateFromTAIEpoch "Will be removed from future versions of this package. Use dateFromMJDEpoch" #-}

-- | Given a real number representing the number of seconds since the start of

-- the day, yield a t'TimeOfDay' value.

--

-- Example with t'Data.Time.Clock.DiffTime' type from package @time@:

--

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

-- >

-- > difftime :: T.DiffTime

-- >

-- > diffTimeToTimeOfDay difftime

--

-- Example with the 'Data.Time.LocalTime.TimeOfDay' type from package @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)