-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HodaTime.ZonedDateTime
-- Copyright   :  (C) 2017 Jason Johnson
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>
-- Stability   :  experimental
-- Portability :  POSIX, Windows
--
-- This is the module for 'ZonedDateTime'.  A 'ZonedDateTime' is a universal time, it represents the same moment anywhere in the world and is completely
-- unambiguous.  Each instance of a 'ZonedDateTime' corresponds to exactly one point on a continuous time line.
----------------------------------------------------------------------------
module Data.HodaTime.ZonedDateTime
(
  -- * Types
   ZonedDateTime
  -- * Constructors
  ,fromCalendarDateTimeLeniently
  ,fromCalendarDateTimeStrictly
  ,fromInstant
  -- * Math
  -- * Conversion
  ,toCalendarDateTime
  ,toCalendarDate
  ,toLocalTime
  -- * Accessors
  ,inDst
  ,zoneAbbreviation
  ,year
  ,month
  ,day
  ,hour
  ,minute
  ,second
  ,nanosecond
  -- * Special constructors
  ,fromCalendarDateTimeAll
  ,resolve
  -- * Exceptions
  ,DateTimeDoesNotExistException
  ,DateTimeAmbiguousException
)
where

import Data.HodaTime.ZonedDateTime.Internal
import Data.HodaTime.CalendarDateTime.Internal (CalendarDateTime(..), CalendarDate(..), IsCalendarDateTime(..), IsCalendar(..), LocalTime)
import qualified Data.HodaTime.LocalTime.Internal as LT(second)
import Data.HodaTime.Offset.Internal (Offset(..))
import Data.HodaTime.TimeZone.Internal (TimeZone, TransitionInfo(..), calDateTransitionsFor, aroundCalDateTransition)
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow, throwM)
import Data.Typeable (Typeable)

-- exceptions

-- TODO: find a way to get the offending CalendarDateTime into the exception so that if this is thrown in deeply nested code users can figure out
-- TODO: which date caused it.  The current problem is that "instance Exception" doesn't work if there is a type variable, even if the data type
-- TODO: itself is typeable
data DateTimeDoesNotExistException = DateTimeDoesNotExistException
  deriving (Typeable, Int -> DateTimeDoesNotExistException -> ShowS
[DateTimeDoesNotExistException] -> ShowS
DateTimeDoesNotExistException -> String
(Int -> DateTimeDoesNotExistException -> ShowS)
-> (DateTimeDoesNotExistException -> String)
-> ([DateTimeDoesNotExistException] -> ShowS)
-> Show DateTimeDoesNotExistException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateTimeDoesNotExistException -> ShowS
showsPrec :: Int -> DateTimeDoesNotExistException -> ShowS
$cshow :: DateTimeDoesNotExistException -> String
show :: DateTimeDoesNotExistException -> String
$cshowList :: [DateTimeDoesNotExistException] -> ShowS
showList :: [DateTimeDoesNotExistException] -> ShowS
Show)

instance Exception DateTimeDoesNotExistException

data DateTimeAmbiguousException = DateTimeAmbiguousException
  deriving (Typeable, Int -> DateTimeAmbiguousException -> ShowS
[DateTimeAmbiguousException] -> ShowS
DateTimeAmbiguousException -> String
(Int -> DateTimeAmbiguousException -> ShowS)
-> (DateTimeAmbiguousException -> String)
-> ([DateTimeAmbiguousException] -> ShowS)
-> Show DateTimeAmbiguousException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateTimeAmbiguousException -> ShowS
showsPrec :: Int -> DateTimeAmbiguousException -> ShowS
$cshow :: DateTimeAmbiguousException -> String
show :: DateTimeAmbiguousException -> String
$cshowList :: [DateTimeAmbiguousException] -> ShowS
showList :: [DateTimeAmbiguousException] -> ShowS
Show)

instance Exception DateTimeAmbiguousException

-- constructors

-- | Returns the mapping of this 'CalendarDateTime' within the given 'TimeZone', with "lenient" rules applied such that ambiguous values map to the earlier of the alternatives,
--   and "skipped" values are shifted forward by the duration of the "gap".
fromCalendarDateTimeLeniently :: (IsCalendar cal, IsCalendarDateTime cal) => CalendarDateTime cal -> TimeZone -> ZonedDateTime cal
fromCalendarDateTimeLeniently :: forall cal.
(IsCalendar cal, IsCalendarDateTime cal) =>
CalendarDateTime cal -> TimeZone -> ZonedDateTime cal
fromCalendarDateTimeLeniently = (ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal)
-> (ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal)
-> CalendarDateTime cal
-> TimeZone
-> ZonedDateTime cal
forall cal.
IsCalendarDateTime cal =>
(ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal)
-> (ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal)
-> CalendarDateTime cal
-> TimeZone
-> ZonedDateTime cal
resolve ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
forall {p} {p}. p -> p -> p
ambiguous ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
forall {cal} {cal}.
IsCalendar cal =>
ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
skipped
  where
    ambiguous :: p -> p -> p
ambiguous p
zdt p
_ = p
zdt
    skipped :: ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
skipped (ZonedDateTime CalendarDateTime cal
_ TimeZone
_ (TransitionInfo (Offset Int
bOff) Bool
_ String
_)) (ZonedDateTime CalendarDateTime cal
cdt TimeZone
tz ti :: TransitionInfo
ti@(TransitionInfo (Offset Int
aOff) Bool
_ String
_)) = CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
forall cal.
CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
ZonedDateTime CalendarDateTime cal
cdt' TimeZone
tz TransitionInfo
ti
      where
        cdt' :: CalendarDateTime cal
cdt' = (Int -> Int)
-> ((Int -> [Int])
    -> CalendarDateTime cal -> [CalendarDateTime cal])
-> CalendarDateTime cal
-> CalendarDateTime cal
forall {a} {b} {a} {c}.
(a -> b) -> ((a -> [b]) -> a -> [c]) -> a -> c
modify (\Int
s -> Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
aOff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bOff) (Int -> [Int]) -> CalendarDateTime cal -> [CalendarDateTime cal]
forall lt (f :: * -> *).
(HasLocalTime lt, Functor f) =>
(Int -> f Int) -> lt -> f lt
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
LT.second CalendarDateTime cal
cdt
        modify :: (a -> b) -> ((a -> [b]) -> a -> [c]) -> a -> c
modify a -> b
f (a -> [b]) -> a -> [c]
l = [c] -> c
forall a. HasCallStack => [a] -> a
head ([c] -> c) -> (a -> [c]) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [b]) -> a -> [c]
l ((b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[]) (b -> [b]) -> (a -> b) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)                 -- TODO: We may want to break down and define the 3 lens primitives we need somewhere

-- | Returns the mapping of this 'CalendarDateTime' within the given 'TimeZone', with "strict" rules applied such that ambiguous or skipped date times
--   return the requested failure response (e.g. Nothing, Left, exception, etc.)
fromCalendarDateTimeStrictly :: (MonadThrow m, IsCalendarDateTime cal) => CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
fromCalendarDateTimeStrictly :: forall (m :: * -> *) cal.
(MonadThrow m, IsCalendarDateTime cal) =>
CalendarDateTime cal -> TimeZone -> m (ZonedDateTime cal)
fromCalendarDateTimeStrictly CalendarDateTime cal
cdt = [ZonedDateTime cal] -> m (ZonedDateTime cal)
forall {m :: * -> *} {a}. MonadThrow m => [a] -> m a
go ([ZonedDateTime cal] -> m (ZonedDateTime cal))
-> (TimeZone -> [ZonedDateTime cal])
-> TimeZone
-> m (ZonedDateTime cal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarDateTime cal -> TimeZone -> [ZonedDateTime cal]
forall cal.
IsCalendarDateTime cal =>
CalendarDateTime cal -> TimeZone -> [ZonedDateTime cal]
fromCalendarDateTimeAll CalendarDateTime cal
cdt
  where
    go :: [a] -> m a
go [] = DateTimeDoesNotExistException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (DateTimeDoesNotExistException -> m a)
-> DateTimeDoesNotExistException -> m a
forall a b. (a -> b) -> a -> b
$ DateTimeDoesNotExistException
DateTimeDoesNotExistException
    go [a
zdt] = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
zdt
    go [a]
_ = DateTimeAmbiguousException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (DateTimeAmbiguousException -> m a)
-> DateTimeAmbiguousException -> m a
forall a b. (a -> b) -> a -> b
$ DateTimeAmbiguousException
DateTimeAmbiguousException

-- | Return all 'ZonedDateTime' entries for a specific 'CalendarDateTime' in a 'TimeZone'. Normally this would be one, but in the case that a time
-- occurs twice in a zone (i.e. due to daylight savings time change) both would be returned.  Also, if the time does not occur at all, an empty list
-- will be returned.  This method allows the user to choose exactly what to do in the case of ambigiuty.
fromCalendarDateTimeAll :: IsCalendarDateTime cal => CalendarDateTime cal -> TimeZone -> [ZonedDateTime cal]
fromCalendarDateTimeAll :: forall cal.
IsCalendarDateTime cal =>
CalendarDateTime cal -> TimeZone -> [ZonedDateTime cal]
fromCalendarDateTimeAll CalendarDateTime cal
cdt TimeZone
tz = [ZonedDateTime cal]
zdts
  where
    instant :: Instant
instant = CalendarDateTime cal -> Instant
forall cal.
IsCalendarDateTime cal =>
CalendarDateTime cal -> Instant
toUnadjustedInstant CalendarDateTime cal
cdt
    zdts :: [ZonedDateTime cal]
zdts = (TransitionInfo -> ZonedDateTime cal)
-> [TransitionInfo] -> [ZonedDateTime cal]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransitionInfo -> ZonedDateTime cal
mkZdt ([TransitionInfo] -> [ZonedDateTime cal])
-> (TimeZone -> [TransitionInfo])
-> TimeZone
-> [ZonedDateTime cal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instant -> TimeZone -> [TransitionInfo]
calDateTransitionsFor Instant
instant (TimeZone -> [ZonedDateTime cal])
-> TimeZone -> [ZonedDateTime cal]
forall a b. (a -> b) -> a -> b
$ TimeZone
tz
    mkZdt :: TransitionInfo -> ZonedDateTime cal
mkZdt = CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
forall cal.
CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
ZonedDateTime CalendarDateTime cal
cdt TimeZone
tz

-- | Takes two functions to determine how to resolve a 'CalendarDateTime' to a 'ZonedDateTime' in the case of ambiguity or skipped times.  The first
-- function is for the ambigous case and is past the first matching 'ZonedDateTime', followed by the second match. The second function is for the case
-- that the 'CalendarDateTime' doesn't exist in the 'TimeZone' (e.g. in a spring-forward situation, there will be a missing hour), the first
-- 'ZonedDateTime' will be the the last time before the gap and the second will be the first time after the gap.
resolve ::
  IsCalendarDateTime cal =>
  (ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal) ->
  (ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal) ->
  CalendarDateTime cal ->
  TimeZone ->
  ZonedDateTime cal -- TODO: This function should probably allow failure
resolve :: forall cal.
IsCalendarDateTime cal =>
(ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal)
-> (ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal)
-> CalendarDateTime cal
-> TimeZone
-> ZonedDateTime cal
resolve ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
ambiguous ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
skipped CalendarDateTime cal
cdt TimeZone
tz = [ZonedDateTime cal] -> ZonedDateTime cal
go ([ZonedDateTime cal] -> ZonedDateTime cal)
-> (TimeZone -> [ZonedDateTime cal])
-> TimeZone
-> ZonedDateTime cal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransitionInfo -> ZonedDateTime cal)
-> [TransitionInfo] -> [ZonedDateTime cal]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransitionInfo -> ZonedDateTime cal
mkZdt ([TransitionInfo] -> [ZonedDateTime cal])
-> (TimeZone -> [TransitionInfo])
-> TimeZone
-> [ZonedDateTime cal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instant -> TimeZone -> [TransitionInfo]
calDateTransitionsFor Instant
instant (TimeZone -> ZonedDateTime cal) -> TimeZone -> ZonedDateTime cal
forall a b. (a -> b) -> a -> b
$ TimeZone
tz
  where
    instant :: Instant
instant = CalendarDateTime cal -> Instant
forall cal.
IsCalendarDateTime cal =>
CalendarDateTime cal -> Instant
toUnadjustedInstant CalendarDateTime cal
cdt
    (TransitionInfo
before, TransitionInfo
after) = Instant -> TimeZone -> (TransitionInfo, TransitionInfo)
aroundCalDateTransition Instant
instant (TimeZone -> (TransitionInfo, TransitionInfo))
-> TimeZone -> (TransitionInfo, TransitionInfo)
forall a b. (a -> b) -> a -> b
$ TimeZone
tz
    mkZdt :: TransitionInfo -> ZonedDateTime cal
mkZdt = CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
forall cal.
CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
ZonedDateTime CalendarDateTime cal
cdt TimeZone
tz
    go :: [ZonedDateTime cal] -> ZonedDateTime cal
go [] = ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
skipped (TransitionInfo -> ZonedDateTime cal
mkZdt TransitionInfo
before) (TransitionInfo -> ZonedDateTime cal
mkZdt TransitionInfo
after)
    go [ZonedDateTime cal
zdt] = ZonedDateTime cal
zdt
    go (ZonedDateTime cal
zdt1:ZonedDateTime cal
zdt2:[]) = ZonedDateTime cal -> ZonedDateTime cal -> ZonedDateTime cal
ambiguous ZonedDateTime cal
zdt1 ZonedDateTime cal
zdt2
    go [ZonedDateTime cal]
_ = String -> ZonedDateTime cal
forall a. HasCallStack => String -> a
error String
"misconfiguration: more than 2 dates returns from calDateTransitionsFor"

-- conversion

-- | Return the 'CalendarDateTime' represented by this 'ZonedDateTime'.
toCalendarDateTime :: ZonedDateTime cal -> CalendarDateTime cal
toCalendarDateTime :: forall cal. ZonedDateTime cal -> CalendarDateTime cal
toCalendarDateTime (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_  TransitionInfo
_) = CalendarDateTime cal
cdt

-- | Return the 'CalendarDate' represented by this 'ZonedDateTime'.
toCalendarDate :: ZonedDateTime cal -> CalendarDate cal
toCalendarDate :: forall cal. ZonedDateTime cal -> CalendarDate cal
toCalendarDate (ZonedDateTime (CalendarDateTime CalendarDate cal
cd LocalTime
_) TimeZone
_  TransitionInfo
_) = CalendarDate cal
cd

-- | Return the 'LocalTime' represented by this 'ZonedDateTime'.
toLocalTime :: ZonedDateTime cal -> LocalTime
toLocalTime :: forall cal. ZonedDateTime cal -> LocalTime
toLocalTime (ZonedDateTime (CalendarDateTime CalendarDate cal
_ LocalTime
lt) TimeZone
_  TransitionInfo
_) = LocalTime
lt

-- Accessors

-- | Return a 'Bool' specifying if this 'ZonedDateTime' is currently in Daylight savings time.
inDst :: ZonedDateTime cal -> Bool
inDst :: forall cal. ZonedDateTime cal -> Bool
inDst (ZonedDateTime CalendarDateTime cal
_ TimeZone
_ (TransitionInfo Offset
_ Bool
isInDst String
_)) = Bool
isInDst

-- | Return a 'String' representing the abbreviation for the TimeZone this 'ZonedDateTime' is currently in.
zoneAbbreviation :: ZonedDateTime cal -> String
zoneAbbreviation :: forall cal. ZonedDateTime cal -> String
zoneAbbreviation (ZonedDateTime CalendarDateTime cal
_ TimeZone
_ (TransitionInfo Offset
_ Bool
_ String
abbr)) = String
abbr