module Data.HodaTime.LocalTime.Internal
(
LocalTime(..)
,HasLocalTime(..)
,Hour
,Minute
,Second
,Nanosecond
,fromInstant
)
where
import Data.HodaTime.Instant.Internal (Instant(..))
import Data.HodaTime.CalendarDateTime.Internal (LocalTime(..), CalendarDateTime(..), CalendarDate, day, IsCalendar(..))
import Data.HodaTime.Internal (hoursFromSecs, minutesFromSecs, secondsFromSecs)
import Data.HodaTime.Constants (secondsPerDay)
import Data.Functor.Identity (Identity(..))
import Data.Word (Word32)
type Hour = Int
type Minute = Int
type Second = Int
type Nanosecond = Int
class HasLocalTime lt where
hour :: Functor f => (Hour -> f Hour) -> lt -> f lt
minute :: Functor f => (Minute -> f Minute) -> lt -> f lt
second :: Functor f => (Second -> f Second) -> lt -> f lt
nanosecond :: Functor f => (Nanosecond -> f Nanosecond) -> lt -> f lt
instance HasLocalTime LocalTime where
hour f (LocalTime secs nsecs) = hoursFromSecs to f secs
where
to = fromSecondsClamped nsecs
{-# INLINE hour #-}
minute f (LocalTime secs nsecs) = minutesFromSecs to f secs
where
to = fromSecondsClamped nsecs
{-# INLINE minute #-}
second f (LocalTime secs nsecs) = secondsFromSecs to f secs
where
to = fromSecondsClamped nsecs
{-# INLINE second #-}
nanosecond f (LocalTime secs nsecs) = LocalTime secs . fromIntegral <$> (f . fromIntegral) nsecs
{-# INLINE nanosecond #-}
instance IsCalendar cal => HasLocalTime (CalendarDateTime cal) where
hour f (CalendarDateTime cd (LocalTime secs nsecs)) = hoursFromSecs to f secs
where
to = fromSecondsRolled cd nsecs
{-# INLINE hour #-}
minute f (CalendarDateTime cd (LocalTime secs nsecs)) = minutesFromSecs to f secs
where
to = fromSecondsRolled cd nsecs
{-# INLINE minute #-}
second f (CalendarDateTime cd (LocalTime secs nsecs)) = secondsFromSecs to f secs
where
to = fromSecondsRolled cd nsecs
{-# INLINE second #-}
nanosecond f (CalendarDateTime cd lt) = CalendarDateTime cd <$> nanosecond f lt
fromInstant :: Instant -> LocalTime
fromInstant (Instant _ secs nsecs) = LocalTime secs nsecs
fromSecondsClamped :: Word32 -> Word32 -> LocalTime
fromSecondsClamped nsecs = flip LocalTime nsecs . normalize
where
normalize x = if x >= secondsPerDay then x - secondsPerDay else x
fromSecondsRolled :: IsCalendar cal => CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal
fromSecondsRolled date nsecs secs = CalendarDateTime date' $ LocalTime secs' nsecs
where
(d, secs') = secs `divMod` secondsPerDay
date' = if d == 0 then date else runIdentity . day (Identity . (+ fromIntegral d)) $ date