module Data.HodaTime.ZonedDateTime.Internal
(
   ZonedDateTime(..)
  ,fromInstant
  ,year
  ,month
  ,day
  ,hour
  ,minute
  ,second
  ,nanosecond
)
where

import Data.HodaTime.CalendarDateTime.Internal (CalendarDateTime, IsCalendarDateTime, IsCalendar, fromAdjustedInstant)
import qualified Data.HodaTime.CalendarDateTime.Internal as CDT
import qualified Data.HodaTime.LocalTime.Internal as LT
import Data.HodaTime.TimeZone.Internal (TimeZone, TransitionInfo, activeTransitionFor, tiUtcOffset)
import Data.HodaTime.Offset.Internal (adjustInstant)
import Data.HodaTime.Instant.Internal (Instant)
import Data.HodaTime.Internal.Lens (view)

-- | A CalendarDateTime in a specific time zone. A 'ZonedDateTime' is global and maps directly to a single 'Instant'.
data ZonedDateTime cal = ZonedDateTime { forall cal. ZonedDateTime cal -> CalendarDateTime cal
zdtCalendarDateTime :: CalendarDateTime cal, forall cal. ZonedDateTime cal -> TimeZone
zdtTimeZone :: TimeZone, forall cal. ZonedDateTime cal -> TransitionInfo
zdtActiveTransition :: TransitionInfo }
  deriving (ZonedDateTime cal -> ZonedDateTime cal -> Bool
(ZonedDateTime cal -> ZonedDateTime cal -> Bool)
-> (ZonedDateTime cal -> ZonedDateTime cal -> Bool)
-> Eq (ZonedDateTime cal)
forall cal. ZonedDateTime cal -> ZonedDateTime cal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall cal. ZonedDateTime cal -> ZonedDateTime cal -> Bool
== :: ZonedDateTime cal -> ZonedDateTime cal -> Bool
$c/= :: forall cal. ZonedDateTime cal -> ZonedDateTime cal -> Bool
/= :: ZonedDateTime cal -> ZonedDateTime cal -> Bool
Eq, Int -> ZonedDateTime cal -> ShowS
[ZonedDateTime cal] -> ShowS
ZonedDateTime cal -> String
(Int -> ZonedDateTime cal -> ShowS)
-> (ZonedDateTime cal -> String)
-> ([ZonedDateTime cal] -> ShowS)
-> Show (ZonedDateTime cal)
forall cal. Int -> ZonedDateTime cal -> ShowS
forall cal. [ZonedDateTime cal] -> ShowS
forall cal. ZonedDateTime cal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall cal. Int -> ZonedDateTime cal -> ShowS
showsPrec :: Int -> ZonedDateTime cal -> ShowS
$cshow :: forall cal. ZonedDateTime cal -> String
show :: ZonedDateTime cal -> String
$cshowList :: forall cal. [ZonedDateTime cal] -> ShowS
showList :: [ZonedDateTime cal] -> ShowS
Show)
-- TODO: We should have an Ord instance, we can just ignore the timezone field.  It would be especially good so that when CalendarDateTime is equal we can
-- TODO: compare the TransitionInfo to see which one comes first


-- | Returns the 'ZonedDateTime' represented by the passed 'Instant' within the given 'TimeZone'.  This is always an unambiguous conversion.
fromInstant :: IsCalendarDateTime cal => Instant -> TimeZone -> ZonedDateTime cal
fromInstant :: forall cal.
IsCalendarDateTime cal =>
Instant -> TimeZone -> ZonedDateTime cal
fromInstant Instant
instant TimeZone
tz = CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
forall cal.
CalendarDateTime cal
-> TimeZone -> TransitionInfo -> ZonedDateTime cal
ZonedDateTime CalendarDateTime cal
cdt TimeZone
tz TransitionInfo
ti
  where
    ti :: TransitionInfo
ti = Instant -> TimeZone -> TransitionInfo
activeTransitionFor Instant
instant TimeZone
tz
    offset :: Offset
offset = TransitionInfo -> Offset
tiUtcOffset TransitionInfo
ti
    instant' :: Instant
instant' = Offset -> Instant -> Instant
adjustInstant Offset
offset Instant
instant
    cdt :: CalendarDateTime cal
cdt = Instant -> CalendarDateTime cal
forall cal.
IsCalendarDateTime cal =>
Instant -> CalendarDateTime cal
fromAdjustedInstant Instant
instant'

-- TODO: We'd like to define lenses here but they must all be getters.  Then we could take advantage of the type class, but to do that we probably have to pull the functor constraint to the
-- TODO: class level.  This would be a big undertaking so we'll look at it after the merge

-- | Accessor for the Year of a 'ZonedDateTime'.
year :: IsCalendar cal => ZonedDateTime cal -> CDT.Year
year :: forall cal. IsCalendar cal => ZonedDateTime cal -> Int
year (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_ TransitionInfo
_) = Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
-> CalendarDateTime cal -> Int
forall s t a b. Lens s t a b -> s -> a
view (Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
forall d (f :: * -> *).
(HasDate d, Functor f) =>
(Int -> f Int) -> d -> f d
Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
CDT.year CalendarDateTime cal
cdt

-- | Accessor for the Month of a 'ZonedDateTime'.
month :: IsCalendar cal => ZonedDateTime cal -> CDT.Month cal
month :: forall cal. IsCalendar cal => ZonedDateTime cal -> Month cal
month (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_ TransitionInfo
_) = CalendarDateTime cal -> MoY (CalendarDateTime cal)
forall d. HasDate d => d -> MoY d
CDT.month CalendarDateTime cal
cdt

-- | Accessor for the Day of a 'ZonedDateTime'.
day :: IsCalendar cal => ZonedDateTime cal -> CDT.DayOfMonth
day :: forall cal. IsCalendar cal => ZonedDateTime cal -> Int
day (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_ TransitionInfo
_) = Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
-> CalendarDateTime cal -> Int
forall s t a b. Lens s t a b -> s -> a
view (Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
forall d (f :: * -> *).
(HasDate d, Functor f) =>
(Int -> f Int) -> d -> f d
Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
CDT.day CalendarDateTime cal
cdt

-- | Accessor for the Hour of a 'ZonedDateTime'.
hour :: IsCalendar cal => ZonedDateTime cal -> LT.Hour
hour :: forall cal. IsCalendar cal => ZonedDateTime cal -> Int
hour (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_ TransitionInfo
_) = Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
-> CalendarDateTime cal -> Int
forall s t a b. Lens s t a b -> s -> a
view (Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
forall lt (f :: * -> *).
(HasLocalTime lt, Functor f) =>
(Int -> f Int) -> lt -> f lt
Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
LT.hour CalendarDateTime cal
cdt

-- | Accessor for the Minute of a 'ZonedDateTime'.
minute :: IsCalendar cal => ZonedDateTime cal -> LT.Minute
minute :: forall cal. IsCalendar cal => ZonedDateTime cal -> Int
minute (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_ TransitionInfo
_) = Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
-> CalendarDateTime cal -> Int
forall s t a b. Lens s t a b -> s -> a
view (Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
forall lt (f :: * -> *).
(HasLocalTime lt, Functor f) =>
(Int -> f Int) -> lt -> f lt
Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
LT.minute CalendarDateTime cal
cdt

-- | Accessor for the Second of a 'ZonedDateTime'.
second :: IsCalendar cal => ZonedDateTime cal -> LT.Second
second :: forall cal. IsCalendar cal => ZonedDateTime cal -> Int
second (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_ TransitionInfo
_) = Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
-> CalendarDateTime cal -> Int
forall s t a b. Lens s t a b -> s -> a
view (Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
forall lt (f :: * -> *).
(HasLocalTime lt, Functor f) =>
(Int -> f Int) -> lt -> f lt
Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
LT.second CalendarDateTime cal
cdt

-- | Accessor for the Nanosecond of a 'ZonedDateTime'.
nanosecond :: IsCalendar cal => ZonedDateTime cal -> LT.Nanosecond
nanosecond :: forall cal. IsCalendar cal => ZonedDateTime cal -> Int
nanosecond (ZonedDateTime CalendarDateTime cal
cdt TimeZone
_ TransitionInfo
_) = Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
-> CalendarDateTime cal -> Int
forall s t a b. Lens s t a b -> s -> a
view (Int -> f Int) -> CalendarDateTime cal -> f (CalendarDateTime cal)
forall lt (f :: * -> *).
(HasLocalTime lt, Functor f) =>
(Int -> f Int) -> lt -> f lt
Lens (CalendarDateTime cal) (CalendarDateTime cal) Int Int
LT.nanosecond CalendarDateTime cal
cdt

-- helper functions

-- TODO: We need functions that help construct this type.  Some of those functions probably need to be in OffsetDateTime so we can hide details of
-- TODO: CalendarDateTime from this module.  What we're trying to do is make sure the OffsetDateTime has the time set to the local time zone
-- TODO: and that the offset part tells us how far we are from UTC.  Nanos tell us how far we are into the current day