LocalTime.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

{-# OPTIONS -fno-warn-orphans #-}

module Data.Time.LocalTime.Internal.LocalTime where

import Control.DeepSeq
import Data.Data
import Data.Time.Calendar.Days
import Data.Time.Calendar.Gregorian
import Data.Time.Clock.Internal.NominalDiffTime
import Data.Time.Clock.Internal.UTCDiff
import Data.Time.Clock.Internal.UTCTime
import Data.Time.Clock.Internal.UniversalTime
import Data.Time.LocalTime.Internal.CalendarDiffTime
import Data.Time.LocalTime.Internal.TimeOfDay
import Data.Time.LocalTime.Internal.TimeZone
import GHC.Generics
#if __GLASGOW_HASKELL__ >= 914
import qualified Language.Haskell.TH.Lift as TH
#else
import qualified Language.Haskell.TH.Syntax as TH
#endif

-- | A simple day and time aggregate, where the day is of the specified parameter,
-- and the time is a TimeOfDay.
-- Conversion of this (as local civil time) to UTC depends on the time zone.
-- Conversion of this (as local mean time) to UT1 depends on the longitude.
data LocalTime = LocalTime
    { localDay :: Day
    , localTimeOfDay :: TimeOfDay
    }
    deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift)

instance NFData LocalTime where
    rnf (LocalTime d t) = rnf d `seq` rnf t `seq` ()

instance Show LocalTime where
    show (LocalTime d t) = (showGregorian d) ++ " " ++ (show t)

-- | addLocalTime a b = a + b
addLocalTime :: NominalDiffTime -> LocalTime -> LocalTime
addLocalTime x = utcToLocalTime utc . addUTCTime x . localTimeToUTC utc

-- | diffLocalTime a b = a - b
diffLocalTime :: LocalTime -> LocalTime -> NominalDiffTime
diffLocalTime a b = diffUTCTime (localTimeToUTC utc a) (localTimeToUTC utc b)

-- | Get the local time of a UTC time in a time zone.
utcToLocalTime :: TimeZone -> UTCTime -> LocalTime
utcToLocalTime tz (UTCTime day dt) = LocalTime (addDays i day) tod
  where
    (i, tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt)

-- | Get the UTC time of a local time in a time zone.
localTimeToUTC :: TimeZone -> LocalTime -> UTCTime
localTimeToUTC tz (LocalTime day tod) = UTCTime (addDays i day) (timeOfDayToTime todUTC)
  where
    (i, todUTC) = localToUTCTimeOfDay tz tod

-- | Get the local time of a UT1 time on a particular meridian (in degrees, positive is East).
ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime
ut1ToLocalTime long (ModJulianDate date) =
    LocalTime (ModifiedJulianDay localMJD) (dayFractionToTimeOfDay localToDOffset)
  where
    localTime = date + long / 360 :: Rational
    localMJD = floor localTime
    localToDOffset = localTime - (fromIntegral localMJD)

-- | Get the UT1 time of a local time on a particular meridian (in degrees, positive is East).
localTimeToUT1 :: Rational -> LocalTime -> UniversalTime
localTimeToUT1 long (LocalTime (ModifiedJulianDay localMJD) tod) =
    ModJulianDate ((fromIntegral localMJD) + (timeOfDayToDayFraction tod) - (long / 360))

-- orphan instance
instance Show UniversalTime where
    show t = show (ut1ToLocalTime 0 t)

addLocalDurationClip :: CalendarDiffTime -> LocalTime -> LocalTime
addLocalDurationClip (CalendarDiffTime m d) (LocalTime day t) =
    addLocalTime d $ LocalTime (addGregorianMonthsClip m day) t

addLocalDurationRollOver :: CalendarDiffTime -> LocalTime -> LocalTime
addLocalDurationRollOver (CalendarDiffTime m d) (LocalTime day t) =
    addLocalTime d $ LocalTime (addGregorianMonthsRollOver m day) t

diffLocalDurationClip :: LocalTime -> LocalTime -> CalendarDiffTime
diffLocalDurationClip (LocalTime day1 t1) (LocalTime day2 t2) =
    let
        CalendarDiffTime m t = calendarTimeDays $ diffGregorianDurationClip day1 day2
    in
        CalendarDiffTime m $ t + diffTimeOfDay t1 t2

diffLocalDurationRollOver :: LocalTime -> LocalTime -> CalendarDiffTime
diffLocalDurationRollOver (LocalTime day1 t1) (LocalTime day2 t2) =
    let
        CalendarDiffTime m t = calendarTimeDays $ diffGregorianDurationRollOver day1 day2
    in
        CalendarDiffTime m $ t + diffTimeOfDay t1 t2