module Data.Thyme.LocalTime.Internal where
import Prelude hiding ((.))
import Control.Applicative
import Control.Category hiding (id)
import Control.DeepSeq
import Control.Lens
import Control.Monad
import Data.AffineSpace
import Data.Data
import Data.Micro
import Data.Thyme.Calendar
import Data.Thyme.Clock.Internal
#if !SHOW_INTERNAL
import Data.Thyme.Format.Internal
#endif
import Data.Thyme.LocalTime.TimeZone
import Data.VectorSpace
type Hour = Int
type Minute = Int
data TimeOfDay = TimeOfDay
{ todHour :: !Hour
, todMin :: !Minute
, todSec :: !DiffTime
} deriving (Eq, Ord, Data, Typeable)
instance NFData TimeOfDay
#if SHOW_INTERNAL
deriving instance Show TimeOfDay
#else
instance Show TimeOfDay where
showsPrec _ (TimeOfDay h m (DiffTime s))
= shows02 h . (:) ':' . shows02 m . (:) ':'
. shows02 (fromIntegral si) . frac where
(si, Micro su) = microQuotRem s (Micro 1000000)
frac = if su == 0 then id else (:) '.' . fills06 su . drops0 su
#endif
midnight :: TimeOfDay
midnight = TimeOfDay 0 0 zeroV
midday :: TimeOfDay
midday = TimeOfDay 12 0 zeroV
makeTimeOfDayValid :: Hour -> Minute -> DiffTime -> Maybe TimeOfDay
makeTimeOfDayValid h m s@(DiffTime u) = TimeOfDay h m s
<$ guard (0 <= h && h <= 23 && 0 <= m && m <= 59)
<* guard (Micro 0 <= u && u < Micro 61000000)
timeOfDay :: Iso' DiffTime TimeOfDay
timeOfDay = iso fromDiff toDiff where
fromDiff :: DiffTime -> TimeOfDay
fromDiff (DiffTime t) = TimeOfDay
(fromIntegral h) (fromIntegral m) (DiffTime s) where
(h, ms) = microQuotRem t (toMicro 3600)
(m, s) = microQuotRem ms (toMicro 60)
toDiff :: TimeOfDay -> DiffTime
toDiff (TimeOfDay h m s) = s
^+^ fromIntegral m *^ DiffTime (toMicro 60)
^+^ fromIntegral h *^ DiffTime (toMicro 3600)
type Minutes = Int
addMinutes :: Minutes -> TimeOfDay -> (Days, TimeOfDay)
addMinutes dm (TimeOfDay h m s) = (dd, TimeOfDay h' m' s) where
(dd, h') = divMod (h + dh) 24
(dh, m') = divMod (m + dm) 60
dayFraction :: Iso' TimeOfDay Rational
dayFraction = from timeOfDay . iso toRatio fromRatio where
NominalDiffTime posixDay = posixDayLength
toRatio :: DiffTime -> Rational
toRatio (DiffTime t) = t ^/^ posixDay
fromRatio :: Rational -> DiffTime
fromRatio r = DiffTime (r *^ posixDay)
data LocalTime = LocalTime
{ localDay :: !Day
, localTimeOfDay :: !TimeOfDay
} deriving (Eq, Ord, Data, Typeable)
instance NFData LocalTime
#if SHOW_INTERNAL
deriving instance Show LocalTime
#else
instance Show LocalTime where
showsPrec p (LocalTime d t) = showsPrec p d . (:) ' ' . showsPrec p t
#endif
utcLocalTime :: TimeZone -> Iso' UTCTime LocalTime
utcLocalTime TimeZone {..} = utcTime . iso localise globalise where
localise :: UTCView -> LocalTime
localise (UTCTime day dt) = LocalTime (day .+^ dd) tod where
(dd, tod) = addMinutes timeZoneMinutes (view timeOfDay dt)
globalise :: LocalTime -> UTCView
globalise (LocalTime day tod) = UTCTime (day .+^ dd)
(review timeOfDay utcToD) where
(dd, utcToD) = addMinutes (negate timeZoneMinutes) tod
ut1LocalTime :: Rational -> Iso' UniversalTime LocalTime
ut1LocalTime long = iso localise globalise where
NominalDiffTime posixDay@(Micro usDay) = posixDayLength
localise :: UniversalTime -> LocalTime
localise (UniversalRep (NominalDiffTime t)) = LocalTime
(ModifiedJulianDay day) (view timeOfDay (DiffTime dt)) where
(day, dt) = microDivMod (t ^+^ (long / 360) *^ posixDay) posixDay
globalise :: LocalTime -> UniversalTime
globalise (LocalTime day tod) = UniversalRep . NominalDiffTime $
Micro (mjd * usDay) ^+^ dt ^-^ (long / 360) *^ posixDay where
ModifiedJulianDay mjd = day
DiffTime dt = review timeOfDay tod
data ZonedTime = ZonedTime
{ zonedTimeToLocalTime :: !LocalTime
, zonedTimeZone :: !TimeZone
} deriving (Eq, Ord, Data, Typeable)
instance NFData ZonedTime where
rnf ZonedTime {..} = rnf zonedTimeZone
zonedTime :: Iso' (TimeZone, UTCTime) ZonedTime
zonedTime = iso toZoned fromZoned where
toZoned :: (TimeZone, UTCTime) -> ZonedTime
toZoned (tz, time) = ZonedTime (view (utcLocalTime tz) time) tz
fromZoned :: ZonedTime -> (TimeZone, UTCTime)
fromZoned (ZonedTime lt tz) = (tz, review (utcLocalTime tz) lt)
#if SHOW_INTERNAL
deriving instance Show ZonedTime
#else
instance Show ZonedTime where
showsPrec p (ZonedTime lt tz) = showsPrec p lt . (:) ' ' . showsPrec p tz
#endif