-- Copyright 2016 Ertugrul Söylemez
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module:     Data.Time.Class.Time
-- Copyright:  Copyright 2016 Ertugrul Söylemez
-- License:    Apache License 2.0
-- Maintainer: Ertugrul Söylemez <esz@posteo.de>
--
-- This module defines orphan instances for 'UTCTime' and 'ZonedTime'.
-- You should import it with an empty import list to make your
-- intentions explicit about the otherwise unused import:
--
-- > import Data.Time.Class
-- > import Data.Time.Class.Time ()
--
-- Note that one second of time as measured by this library may take
-- zero or two seconds of real time because of leap seconds.
--
-- If you use 'dateSkip' and the day had a leap second, there is no way
-- to predict whether the new date will have one as well.  This library
-- handles that by assuming that it won't and scaling the day from 86401
-- seconds to 86400.
--
-- The 'ZonedTime' instances go through 'UTCTime' to do basic
-- arithmetic, but use local time for unit-aware arithmetic, such that
-- skipping to the next day actually skips to local midnight.  However,
-- keep in mind that in some areas of the world time zones may be
-- switched automatically and spontaneously (daylight savings time).
--
-- In time arithmetic it is important to understand the difference
-- between waiting for a duration of time and waiting for a certain
-- point in time.  Which one you do depends on the application.  For
-- example if you're writing a Cron daemon, you should be prepared to
-- handle the fact that the meaning of "3:00 AM" may change suddenly.
-- Ideally when dealing with user-specified local time allow them to
-- specify the time zone as well.
--
-- If you're writing a tea timer or any other duration-sensitive
-- application, do not use local time.  Ideally do not use this library
-- at all.  The <http://hackage.haskell.org/package/clock clock library>
-- along with its <http://hackage.haskell.org/package/timelike-clock
-- timelike interface> is more suitable in this case.

module Data.Time.Class.Time () where

import           Control.Monad.IO.Class
import qualified Data.Time.Calendar as Cal
import qualified Data.Time.Calendar.WeekDate as Cal
import           Data.Time.Class
import           Data.Time.Clock
import           Data.Time.LocalTime


instance (MonadIO m) => GetTime m UTCTime where
    getTime = liftIO getCurrentTime

instance SkipDate UTCTime where
    dateBegin (Week wd0) (UTCTime d tod) =
        let (_, _, wd) = Cal.toWeekDate d
            dd         = mod (wd0 - wd) 7
        in UTCTime (Cal.addDays (if dd == 0 && tod /= 0 then 7 else toInteger dd) d) 0
    dateBegin Month (UTCTime d' tod) =
        let (y, m, md) = Cal.toGregorian d'
            d          = Cal.fromGregorian y m 1
        in UTCTime (if tod == 0 && md == 1 then d else Cal.addGregorianMonthsClip 1 d) 0
    dateBegin Year (UTCTime d' tod) =
        let (y, m, md) = Cal.toGregorian d'
            d          = Cal.fromGregorian y 1 1
        in UTCTime (if tod == 0 && md == 1 && m == 1 then d else Cal.addGregorianYearsClip 1 d) 0

    dateNext (Week wd0) (UTCTime d _) =
        let (_, _, wd) = Cal.toWeekDate d
            dd         = mod (wd0 - wd) 7
        in UTCTime (Cal.addDays (if dd == 0 then 7 else toInteger dd) d) 0
    dateNext Month (UTCTime d' _) =
        let (y, m, _) = Cal.toGregorian d'
            d         = Cal.fromGregorian y m 1
        in UTCTime (Cal.addGregorianMonthsClip 1 d) 0
    dateNext Year (UTCTime d' _) =
        let (y, _, _) = Cal.toGregorian d'
            d         = Cal.fromGregorian y 1 1
        in UTCTime (Cal.addGregorianYearsClip 1 d) 0

    dateSkip n unit (UTCTime d tod) =
        UTCTime (case unit of
                   Week _ -> Cal.addDays (7*n) d
                   Month  -> Cal.addGregorianMonthsClip n d
                   Year   -> Cal.addGregorianYearsClip n d)
                (-- Since we don't know on which day leap seconds occur,
                 -- we simply scale such days down to the usual length.
                 if tod < 86400
                   then tod
                   else tod / 86401 * 86400)

instance SkipUnit UTCTime where
    begin unit t@(UTCTime _ tod) =
        let pf = properFraction in
        case unit of
          Second | (_, 0) <- pf tod                  -> t
          Minute | (s, 0) <- pf tod, mod s 60 == 0   -> t
          Hour   | (s, 0) <- pf tod, mod s 3600 == 0 -> t
          Day    | tod == 0                          -> t
          _                                          -> next unit t

    next Second (UTCTime d tod) =
        addTime 1 (UTCTime d (fromInteger (floor tod)))
    next Minute (UTCTime d tod)
        | u < 3599  = addTime 60 (UTCTime d (fromInteger (60*u)))
        | otherwise = UTCTime (Cal.addDays 1 d) 0
        where
        u = floor tod `div` 60
    next Hour (UTCTime d tod)
        | u < 23    = addTime 3600 (UTCTime d (fromInteger (3600*u)))
        | otherwise = UTCTime (Cal.addDays 1 d) 0
        where
        u = floor tod `div` 3600
    next Day (UTCTime d _) = UTCTime (Cal.addDays 1 d) 0

    -- According to the documentation, 'NominalDiffTime' arithmetic
    -- handles leap seconds by itself, so we'll trust that.
    skip n Second = addTime (fromInteger n)
    skip n Minute = addTime (fromInteger n * 60)
    skip n Hour   = addTime (fromInteger n * 3600)
    skip n Day    = addTime (fromInteger n * 86400)

instance Time UTCTime where
    type Delta UTCTime = NominalDiffTime

    diffTime = diffUTCTime
    addTime  = addUTCTime

instance TimeSeconds UTCTime where
    oneSecond _ = 1


instance (MonadIO m) => GetTime m ZonedTime where
    getTime = liftIO getZonedTime

instance SkipDate ZonedTime where
    dateBegin unit (ZonedTime (LocalTime d' tod) tz) =
        ZonedTime (LocalTime d (TimeOfDay 0 0 0)) tz

        where
        d = case unit of
              Week wd0 ->
                  let (_, _, wd) = Cal.toWeekDate d'
                      dd         = mod (wd0 - wd) 7
                  in Cal.addDays (if tod /= midnight && dd == 0 then 7 else toInteger dd) d'
              Month ->
                  let (y, m, md) = Cal.toGregorian d'
                      d          = Cal.fromGregorian y m 1
                  in if tod == midnight && md == 1 then d else Cal.addGregorianMonthsClip 1 d
              Year ->
                  let (y, m, md) = Cal.toGregorian d'
                      d          = Cal.fromGregorian y 1 1
                  in if tod == midnight && md == 1 && m == 1 then d else Cal.addGregorianYearsClip 1 d

    dateNext unit (ZonedTime (LocalTime d' _) tz) =
        ZonedTime (LocalTime d (TimeOfDay 0 0 0)) tz

        where
        d = case unit of
              Week wd0 ->
                  let (_, _, wd) = Cal.toWeekDate d'
                      dd         = mod (wd0 - wd) 7
                  in Cal.addDays (if dd == 0 then 7 else toInteger dd) d'
              Month ->
                  let (y, m, _) = Cal.toGregorian d'
                      d         = Cal.fromGregorian y m 1
                  in Cal.addGregorianMonthsClip 1 d
              Year ->
                  let (y, _, _) = Cal.toGregorian d'
                      d         = Cal.fromGregorian y 1 1
                  in Cal.addGregorianYearsClip 1 d

    dateSkip n unit (ZonedTime (LocalTime d' tod') tz) =
        ZonedTime (LocalTime d tod) tz

        where
        -- Since we don't know on which day leap seconds occur, we
        -- simply scale such days down to the usual length.
        tod | todSec tod' < 60 = tod'
            | otherwise        =
                timeToTimeOfDay
                    (timeOfDayToTime tod' / 86401 * 86400)

        d = case unit of
              Week _ -> Cal.addDays (7*n) d'
              Month  -> Cal.addGregorianMonthsClip n d'
              Year   -> Cal.addGregorianYearsClip n d'

instance SkipUnit ZonedTime where
    begin unit t@(ZonedTime (LocalTime _ (TimeOfDay h m s)) _) =
        case unit of
          Second | (_, 0) <- properFraction s -> t
          Minute | s == 0                     -> t
          Hour   | s == 0 && m == 0           -> t
          Day    | s == 0 && m == 0 && h == 0 -> t
          _                                   -> next unit t

    next unit t@(ZonedTime (LocalTime d (TimeOfDay h m s)) tz) =
        case unit of
          Second | s < 59    -> todRes (TimeOfDay h m (fromInteger (floor s + 1)))
                 | otherwise -> next Minute t
          Minute | m < 59    -> todRes (TimeOfDay h (m + 1) 0)
                 | otherwise -> next Hour t
          Hour   | h < 23    -> todRes (TimeOfDay (h + 1) 0 0)
          _                  -> res (LocalTime (Cal.addDays 1 d) (TimeOfDay 0 0 0))

        where
        todRes = res . LocalTime d
        res lt = ZonedTime lt tz

    skip n unit lt =
        utcToZonedTime
            (zonedTimeZone lt)
            (skip n unit (zonedTimeToUTC lt))

instance Time ZonedTime where
    type Delta ZonedTime = NominalDiffTime

    diffTime lt0 lt1 =
        diffTime (zonedTimeToUTC lt0)
                 (zonedTimeToUTC lt1)

    addTime dt lt =
        utcToZonedTime
            (zonedTimeZone lt)
            (addTime dt (zonedTimeToUTC lt))

instance TimeSeconds ZonedTime where
    oneSecond _ = 1