-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
--
-- SPDX-License-Identifier: MPL-2.0

module Data.Time.TZTime
  (
  -- * TZTime
    Internal.TZTime
  , Internal.tzTimeLocalTime
  , Internal.tzTimeTZInfo
  , Internal.tzTimeOffset
  -- * Constructors
  , getCurrentTZTime
  , Internal.fromUTC
  , Internal.fromPOSIXTime
  , Internal.fromZonedTime
  -- ** From @LocalTime@
  , Internal.fromLocalTime
  , Internal.fromLocalTimeStrict
  , Internal.fromLocalTimeThrow
  , Internal.unsafeFromLocalTime
  , Internal.TZError(..)
  -- * Conversions
  , Internal.toUTC
  , Internal.toPOSIXTime
  , Internal.toZonedTime
  , Internal.inTZ
  -- * Modifying a TZTime
  , atEarliestOffset
  , atLatestOffset
  , atStartOfDay
  -- * Universal time-line
  -- ** Adding seconds\/minutes\/hours
  , addTime
  , hours
  , minutes
  , seconds
  -- * Local time-line
  , modifyLocal
  , modifyLocalStrict
  , modifyLocalThrow
  -- ** Adding days\/weeks\/months\/years.
  -- | Use these with one of the @modifyLocal*@ functions.
  , addCalendarClip
  , addCalendarRollOver
  , calendarDays
  , calendarWeeks
  , calendarMonths
  , calendarYears
  -- ** Setting date\/time components.
  -- | Use these with one of the @modifyLocal*@ functions.
  , atYear
  , atMonthOfYear
  , atDayOfMonth
  , atDay
  , atHour
  , atMinute
  , atSecond
  , atTimeOfDay
  , atMidnight
  , atFirstDayOfWeekOnAfter
  -- * Other
  , diffTZTime
  ) where

import Control.Exception.Safe (MonadThrow, throwM)
import Control.Monad.Except (MonadError)
import Data.Fixed (Pico)
import Data.Time
  (CalendarDiffDays(..), Day, DayOfWeek(..), LocalTime(..), NominalDiffTime, TimeOfDay(..),
  addUTCTime, diffUTCTime, getCurrentTime, midnight, secondsToNominalDiffTime)
import Data.Time qualified as Time
import Data.Time.Calendar.Compat
  (DayOfMonth, MonthOfYear, Year, firstDayOfWeekOnAfter, pattern YearMonthDay)
import Data.Time.TZInfo
import Data.Time.TZTime.Internal as Internal

-- $setup
-- >>> import Data.Function ((&))
-- >>> import Data.Time.TZTime.QQ (tz)
-- >>> import Data.Time

----------------------------------------------------------------------------
-- Constructors
----------------------------------------------------------------------------

-- | Returns the current time with the local time zone information
-- based on the @TZ@ and @TZDIR@ environment variables.
--
-- See @tzset(3)@ for details, but basically:
--
-- * If @TZ@ environment variable is unset, we use @\/etc\/localtime@.
-- * If @TZ@ is set, but empty, we use `utc`.
-- * If @TZ@ is set and not empty, we use `loadFromSystem` to read that file.
getCurrentTZTime :: IO TZTime
getCurrentTZTime :: IO TZTime
getCurrentTZTime = do
  TZInfo
tzi <- IO TZInfo
getCurrentTZInfo
  UTCTime
utcNow <- IO UTCTime
getCurrentTime
  pure $ TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi UTCTime
utcNow

----------------------------------------------------------------------------
-- Modifying a TZTime
----------------------------------------------------------------------------

-- | If this local time happens to be on an overlap,
-- switch to the earliest of the two offsets.
--
-- >>> atEarliestOffset [tz|2022-11-06 01:30:00 -06:00 [America/Winnipeg]|]
-- 2022-11-06 01:30:00 -05:00 [America/Winnipeg]
atEarliestOffset :: TZTime -> TZTime
atEarliestOffset :: TZTime -> TZTime
atEarliestOffset TZTime
tzt =
  case forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict (TZTime -> TZInfo
tzTimeTZInfo TZTime
tzt) (TZTime -> LocalTime
tzTimeLocalTime TZTime
tzt) of
    Left (TZOverlap LocalTime
_ TZTime
earliest TZTime
_) -> TZTime
earliest
    Either TZError TZTime
_ -> TZTime
tzt

-- | If this local time happens to be on an overlap,
-- switch to the latest of the two offsets.
--
-- >>> atLatestOffset [tz|2022-11-06 01:30:00 -05:00 [America/Winnipeg]|]
-- 2022-11-06 01:30:00 -06:00 [America/Winnipeg]
atLatestOffset :: TZTime -> TZTime
atLatestOffset :: TZTime -> TZTime
atLatestOffset TZTime
tzt =
  case forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict (TZTime -> TZInfo
tzTimeTZInfo TZTime
tzt) (TZTime -> LocalTime
tzTimeLocalTime TZTime
tzt) of
    Left (TZOverlap LocalTime
_ TZTime
_ TZTime
latest) -> TZTime
latest
    Either TZError TZTime
_ -> TZTime
tzt

-- | Changes the time to the earliest time possible on that day.
--
-- This is usually 00:00, but, if, on that day:
--
-- * the clocks are turned, for example, from 23:59 to 01:00 and midnight is skipped,
--   this will return 01:00.
-- * the clocks are turned, for example, from 01:00 to 00:00 and midnight happens twice,
--   this will return the first occurrence (i.e. midnight at the earliest offset).
atStartOfDay :: TZTime -> TZTime
atStartOfDay :: TZTime -> TZTime
atStartOfDay TZTime
tzt =
  case forall (m :: * -> *).
MonadError TZError m =>
(LocalTime -> LocalTime) -> TZTime -> m TZTime
Internal.modifyLocalTimeLine LocalTime -> LocalTime
atMidnight TZTime
tzt of
    Right TZTime
result -> TZTime
result
    Left (TZGap LocalTime
_ TZTime
_ TZTime
after) -> TZTime
after
    Left (TZOverlap LocalTime
_ TZTime
atEarliestOffset TZTime
_) -> TZTime
atEarliestOffset

----------------------------------------------------------------------------
-- Adding seconds/minutes/hours.
----------------------------------------------------------------------------

{- | Adds the given amount of seconds

>>> [tz|2022-03-04 10:15:00 [Europe/Rome]|] & addTime (hours 2 + minutes 20)
2022-03-04 12:35:00 +01:00 [Europe/Rome]
-}
addTime :: NominalDiffTime -> TZTime -> TZTime
addTime :: NominalDiffTime -> TZTime -> TZTime
addTime = (UTCTime -> UTCTime) -> TZTime -> TZTime
Internal.modifyUniversalTimeLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UTCTime -> UTCTime
addUTCTime

-- | A standard hour of 3600 seconds.
hours :: Pico -> NominalDiffTime
hours :: Pico -> NominalDiffTime
hours Pico
h = Pico -> NominalDiffTime
minutes (Pico
h forall a. Num a => a -> a -> a
* Pico
60)

-- | A standard minute of 60 seconds.
minutes :: Pico -> NominalDiffTime
minutes :: Pico -> NominalDiffTime
minutes Pico
m = Pico -> NominalDiffTime
seconds (Pico
m forall a. Num a => a -> a -> a
* Pico
60)

seconds :: Pico -> NominalDiffTime
seconds :: Pico -> NominalDiffTime
seconds = Pico -> NominalDiffTime
secondsToNominalDiffTime

----------------------------------------------------------------------------
-- Local time-line.
----------------------------------------------------------------------------

{- |
Modifies the date/time on the local time-line.

The result may:

* Land on a "gap", e.g. when the clocks are set forward in spring and a local time is skipped.
  When this happens, we shift the time forward by the duration of the gap.

    For example, on the 13th, the clocks skip one hour,
    from 01:59 (at the -06:00 offset) straight to 03:00 (at the -05:00 offset):

    >>> [tz|2022-03-12 02:15:00 -06:00 [America/Winnipeg]|] & modifyLocal (addCalendarClip (calendarDays 1))
    2022-03-13 03:15:00 -05:00 [America/Winnipeg]

* Land on an "overlap", e.g. when the clocks are set back in autumn and a local time happens twice.
  When this happens, we attempt to preserve the offset of the original `TZTime`.
  This ensures that @modifyLocal id == id@.
  If this is not possible, use the earliest of the two offsets.

    For example, on the 6th, the clocks are set back one hour,
    from 01:59 (at the -05:00 offset) back to 01:00 (at the -06:00 offset).
    This means the time 01:15 happens twice, first at -05:00 and then again at -06:00.

    >>> [tz|2022-11-05 01:15:00 -05:00 [America/Winnipeg]|] & modifyLocal (addCalendarClip (calendarDays 1))
    2022-11-06 01:15:00 -05:00 [America/Winnipeg]

    >>> [tz|2022-11-07 01:15:00 -06:00 [America/Winnipeg]|] & modifyLocal (addCalendarClip (calendarDays -1))
    2022-11-06 01:15:00 -06:00 [America/Winnipeg]

This behaviour should be suitable for most use cases.

Note: @modifyLocal (g . f)@ may not always be equivalent to
@modifyLocal g . modifyLocal f@.

If @modifyLocal f@ lands on a gap or an overlap, the time will be corrected as described above;
but there's a chance @modifyLocal (g . f)@ would skip right over
the gap/overlap and no correction is needed.
As a rule of thumb, apply all modifications to the local time-line in one go.

>>> import Control.Arrow ((>>>))
>>> :{
[tz|2022-03-04 10:15:00 +01:00 [Europe/Rome]|]
  & modifyLocal (
      addCalendarClip (calendarMonths 2 <> calendarDays 3) >>>
      atFirstDayOfWeekOnAfter Wednesday >>>
      atMidnight
    )
:}
2022-05-11 00:00:00 +02:00 [Europe/Rome]

-}
modifyLocal :: (LocalTime -> LocalTime) -> TZTime -> TZTime
modifyLocal :: (LocalTime -> LocalTime) -> TZTime -> TZTime
modifyLocal LocalTime -> LocalTime
f TZTime
tzt =
  case forall (m :: * -> *).
MonadError TZError m =>
(LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalStrict LocalTime -> LocalTime
f TZTime
tzt of
    Right TZTime
result -> TZTime
result
    Left (TZGap LocalTime
_ TZTime
_ TZTime
after) -> TZTime
after
    Left (TZOverlap LocalTime
_ TZTime
atEarliestOffset TZTime
atLatestOffset)
      | TZTime -> TimeZone
tzTimeOffset TZTime
atLatestOffset forall a. Eq a => a -> a -> Bool
== TZTime -> TimeZone
tzTimeOffset TZTime
tzt -> TZTime
atLatestOffset
      | Bool
otherwise -> TZTime
atEarliestOffset

-- | Similar to `modifyLocal`, but returns a `TZError`
-- if the result lands in a gap/overlap.
modifyLocalStrict :: MonadError TZError m => (LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalStrict :: forall (m :: * -> *).
MonadError TZError m =>
(LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalStrict = forall (m :: * -> *).
MonadError TZError m =>
(LocalTime -> LocalTime) -> TZTime -> m TZTime
Internal.modifyLocalTimeLine

-- | Similar to `modifyLocal`, but throws a `TZError` in `MonadThrow`
-- if the result lands in a gap/overlap.
modifyLocalThrow :: MonadThrow m => (LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalThrow :: forall (m :: * -> *).
MonadThrow m =>
(LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalThrow LocalTime -> LocalTime
f =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadError TZError m =>
(LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalStrict LocalTime -> LocalTime
f

----------------------------------------------------------------------------
-- Adding days/weeks/months/years.
----------------------------------------------------------------------------

-- | Add the given number of months first and then the given number of days,
-- using the proleptic Gregorian calendar.
--
-- When adding months, days past the last day of the month are clipped to the last day.
-- For instance, 2005-01-30 + 1 month = 2005-02-28.
addCalendarClip :: CalendarDiffDays -> LocalTime -> LocalTime
addCalendarClip :: CalendarDiffDays -> LocalTime -> LocalTime
addCalendarClip CalendarDiffDays
cdd LocalTime
lt = LocalTime
lt
  { localDay :: Day
localDay = CalendarDiffDays -> Day -> Day
Time.addGregorianDurationClip CalendarDiffDays
cdd forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
lt
  }

-- | Add the given number of months first and then the given number of days.
-- using the proleptic Gregorian calendar.
--
-- When adding months, days past the last day of the month roll over to the next month.
-- For instance, 2005-01-30 + 1 month = 2005-03-02.
addCalendarRollOver :: CalendarDiffDays -> LocalTime -> LocalTime
addCalendarRollOver :: CalendarDiffDays -> LocalTime -> LocalTime
addCalendarRollOver CalendarDiffDays
cdd LocalTime
lt = LocalTime
lt
  { localDay :: Day
localDay = CalendarDiffDays -> Day -> Day
Time.addGregorianDurationRollOver CalendarDiffDays
cdd forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
lt
  }

calendarDays :: Integer -> CalendarDiffDays
calendarDays :: Integer -> CalendarDiffDays
calendarDays Integer
n = Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
0 Integer
n

calendarWeeks :: Integer -> CalendarDiffDays
calendarWeeks :: Integer -> CalendarDiffDays
calendarWeeks Integer
n = Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
0 (Integer
n forall a. Num a => a -> a -> a
* Integer
7)

calendarMonths :: Integer -> CalendarDiffDays
calendarMonths :: Integer -> CalendarDiffDays
calendarMonths Integer
n = Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
n Integer
0

calendarYears :: Integer -> CalendarDiffDays
calendarYears :: Integer -> CalendarDiffDays
calendarYears Integer
n = Integer -> Integer -> CalendarDiffDays
CalendarDiffDays (Integer
n forall a. Num a => a -> a -> a
* Integer
12) Integer
0

----------------------------------------------------------------------------
-- Setting date/time components.
----------------------------------------------------------------------------

-- | Sets the year using the proleptic Gregorian calendar.
atYear :: Year -> LocalTime -> LocalTime
atYear :: Integer -> LocalTime -> LocalTime
atYear Integer
y LocalTime
lt =
  let YearMonthDay Integer
_ MonthOfYear
moy MonthOfYear
dom = LocalTime -> Day
localDay LocalTime
lt
  in  LocalTime
lt { localDay :: Day
localDay = Integer -> MonthOfYear -> MonthOfYear -> Day
YearMonthDay Integer
y MonthOfYear
moy MonthOfYear
dom }

-- | Sets the month using the proleptic Gregorian calendar.
-- Invalid values will be clipped to the correct range.
atMonthOfYear :: MonthOfYear -> LocalTime -> LocalTime
atMonthOfYear :: MonthOfYear -> LocalTime -> LocalTime
atMonthOfYear MonthOfYear
moy LocalTime
lt =
  let YearMonthDay Integer
y MonthOfYear
_ MonthOfYear
dom = LocalTime -> Day
localDay LocalTime
lt
  in  LocalTime
lt { localDay :: Day
localDay = Integer -> MonthOfYear -> MonthOfYear -> Day
YearMonthDay Integer
y MonthOfYear
moy MonthOfYear
dom }

-- | Sets the day of month using the proleptic Gregorian calendar.
-- Invalid values will be clipped to the correct range.
atDayOfMonth :: DayOfMonth -> LocalTime -> LocalTime
atDayOfMonth :: MonthOfYear -> LocalTime -> LocalTime
atDayOfMonth MonthOfYear
dom LocalTime
lt =
  let YearMonthDay Integer
y MonthOfYear
m MonthOfYear
_ = LocalTime -> Day
localDay LocalTime
lt
  in  LocalTime
lt { localDay :: Day
localDay = Integer -> MonthOfYear -> MonthOfYear -> Day
YearMonthDay Integer
y MonthOfYear
m MonthOfYear
dom }

-- | Sets the day.
atDay :: Day -> LocalTime -> LocalTime
atDay :: Day -> LocalTime -> LocalTime
atDay Day
day LocalTime
lt = LocalTime
lt { localDay :: Day
localDay = Day
day }

atHour :: Int -> LocalTime -> LocalTime
atHour :: MonthOfYear -> LocalTime -> LocalTime
atHour MonthOfYear
h LocalTime
lt = LocalTime
lt
  { localTimeOfDay :: TimeOfDay
localTimeOfDay = (LocalTime -> TimeOfDay
localTimeOfDay LocalTime
lt) { todHour :: MonthOfYear
todHour = MonthOfYear
h }
  }

atMinute :: Int -> LocalTime -> LocalTime
atMinute :: MonthOfYear -> LocalTime -> LocalTime
atMinute MonthOfYear
m LocalTime
lt = LocalTime
lt
  { localTimeOfDay :: TimeOfDay
localTimeOfDay = (LocalTime -> TimeOfDay
localTimeOfDay LocalTime
lt) { todMin :: MonthOfYear
todMin = MonthOfYear
m }
  }

atSecond :: Pico -> LocalTime -> LocalTime
atSecond :: Pico -> LocalTime -> LocalTime
atSecond Pico
s LocalTime
lt = LocalTime
lt
  { localTimeOfDay :: TimeOfDay
localTimeOfDay = (LocalTime -> TimeOfDay
localTimeOfDay LocalTime
lt) { todSec :: Pico
todSec = Pico
s }
  }

atTimeOfDay :: TimeOfDay -> LocalTime -> LocalTime
atTimeOfDay :: TimeOfDay -> LocalTime -> LocalTime
atTimeOfDay TimeOfDay
tod LocalTime
lt = LocalTime
lt { localTimeOfDay :: TimeOfDay
localTimeOfDay = TimeOfDay
tod }

-- | Sets the time to 00:00.
atMidnight :: LocalTime -> LocalTime
atMidnight :: LocalTime -> LocalTime
atMidnight = TimeOfDay -> LocalTime -> LocalTime
atTimeOfDay TimeOfDay
midnight

-- | Moves the date to the next given `DayOfWeek`.
-- If the current date is already a match, then the current date is returned unmodified.
--
-- >>> tzt = [tz|2022-02-24 10:00:00 [Europe/London]|]
-- >>> tzt & modifyLocal (atFirstDayOfWeekOnAfter Thursday)
-- 2022-02-24 10:00:00 +00:00 [Europe/London]
-- >>> tzt & modifyLocal (atFirstDayOfWeekOnAfter Wednesday)
-- 2022-03-02 10:00:00 +00:00 [Europe/London]
atFirstDayOfWeekOnAfter :: DayOfWeek -> LocalTime -> LocalTime
atFirstDayOfWeekOnAfter :: DayOfWeek -> LocalTime -> LocalTime
atFirstDayOfWeekOnAfter DayOfWeek
dow LocalTime
lt = LocalTime
lt
  { localDay :: Day
localDay = DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
dow forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
lt
  }

----------------------------------------------------------------------------
-- Other
----------------------------------------------------------------------------

-- | Calculate the difference in seconds between two points in time.
diffTZTime :: TZTime -> TZTime -> NominalDiffTime
diffTZTime :: TZTime -> TZTime -> NominalDiffTime
diffTZTime TZTime
tzt1 TZTime
tzt2 =
  UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (TZTime -> UTCTime
toUTC TZTime
tzt1) (TZTime -> UTCTime
toUTC TZTime
tzt2)