module Data.Time.CalendarTime.CalendarTime
(
CalendarTime (..)
, toDay
, withDay
, toTimeOfDay
, daysInYear
, lastDayOfMonth
, weekNumber
, CalendarTimeConvertible (..)
)
where
import Data.Time
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Month
import Data.Time.Calendar.WeekDay
import Data.Time.Moment.StartOfWeek
import System.IO.Unsafe
data CalendarTime = CalendarTime
{
calendarSecond :: Int
, calendarMinute :: Int
, calendarHour :: Int
, calendarDay :: Int
, calendarMonth :: Month
, calendarYear :: Integer
, calendarWeekDay :: WeekDay
, calendarYearDay :: Int
, calendarTimeZone :: TimeZone
} deriving (Eq,Ord,Show)
class CalendarTimeConvertible t where
toCalendarTime :: t -> CalendarTime
toCalendarTimeWithTimeZone :: t -> TimeZone -> CalendarTime
fromCalendarTime :: CalendarTime -> Maybe t
instance CalendarTimeConvertible CalendarTime where
toCalendarTime = id
toCalendarTimeWithTimeZone ct tz = ct { calendarTimeZone = tz }
fromCalendarTime = Just . id
toDay :: CalendarTime -> Maybe Day
toDay t = fromGregorianValid (calendarYear t) (fromEnum $ calendarMonth t) (calendarDay t)
toTimeOfDay :: CalendarTime -> Maybe TimeOfDay
toTimeOfDay t = makeTimeOfDayValid (calendarHour t) (calendarMinute t) (toEnum $ calendarSecond t)
withDay :: CalendarTime -> Day -> CalendarTime
withDay ct day = ct
{ calendarYear = y
, calendarMonth = toEnum m
, calendarDay = d}
where
(y, m, d) = toGregorian day
dayInfo ::
Day
-> ( Integer
, Int
, Int
, WeekDay
, Int
)
dayInfo day = let
(y, m, d) = toGregorian day
weekDay = toEnum $ snd (mondayStartWeek day) 1
yearDay = snd $ toOrdinalDate day
in (y, m, d, weekDay, yearDay)
instance CalendarTimeConvertible UTCTime where
toCalendarTime (UTCTime utcDay utcTime) = CalendarTime (fromEnum ss) mm hh d (toEnum m) y weekDay yearDay utc
where
(TimeOfDay hh mm ss) = timeToTimeOfDay utcTime
(y, m, d, weekDay, yearDay) = dayInfo utcDay
toCalendarTimeWithTimeZone utcTime tz | tz == utc = toCalendarTime utcTime
| otherwise = error ("UTCTime.toCalendarTimeWithTimeZone cannot be represented with time zone " ++ show tz)
fromCalendarTime t = do
day <- toDay t
time <- toTimeOfDay t
return $ UTCTime day (timeOfDayToTime time)
instance CalendarTimeConvertible LocalTime where
toCalendarTime _ = error ("LocalTime.toCalendarTime cannot be represented without a time zone")
toCalendarTimeWithTimeZone (LocalTime day t) tz = CalendarTime (fromEnum $ todSec t) (todMin t) (todHour t) d (toEnum m) y weekDay yearDay tz
where
(y, m, d, weekDay, yearDay) = dayInfo day
fromCalendarTime t = do
day <- toDay t
time <- toTimeOfDay t
return $ LocalTime day time
instance CalendarTimeConvertible ZonedTime where
toCalendarTime (ZonedTime (LocalTime day t) tz) = CalendarTime (fromEnum $ todSec t) (todMin t) (todHour t) d (toEnum m) y weekDay yearDay tz
where
(y, m, d, weekDay, yearDay) = dayInfo day
toCalendarTimeWithTimeZone (ZonedTime lt _) tz = toCalendarTime (ZonedTime lt tz)
fromCalendarTime t = do
day <- toDay t
time <- toTimeOfDay t
return $ ZonedTime (LocalTime day time) (calendarTimeZone t)
daysInYear :: (CalendarTimeConvertible a) => a -> Int
daysInYear t = let ct = toCalendarTime t
in if isLeapYear $ calendarYear ct then 366 else 365
lastDayOfMonth :: (CalendarTimeConvertible a) => a -> Int
lastDayOfMonth t = let ct = toCalendarTime t
in gregorianMonthLength (calendarYear ct) (fromEnum $ calendarMonth ct)
weekNumber :: (CalendarTimeConvertible a) => StartOfWeek -> a -> Maybe Int
weekNumber _ t = do
day <- toDay $ toCalendarTime t
return $ fst $ mondayStartWeek day