{-# LANGUAGE Safe #-} -- | Week-based calendars module Data.Time.Calendar.WeekDate ( Year, WeekOfYear, DayOfWeek(..), dayOfWeek, FirstWeekType (..),toWeekCalendar,fromWeekCalendar,fromWeekCalendarValid, -- * ISO 8601 Week Date format toWeekDate, fromWeekDate, pattern YearWeekDay, fromWeekDateValid, showWeekDate ) where import Data.Time.Calendar.Types import Data.Time.Calendar.Days import Data.Time.Calendar.Week import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private data FirstWeekType = FirstWholeWeek -- ^ first week is the first whole week of the year | FirstMostWeek -- ^ first week is the first week with four days in the year deriving Eq firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day firstDayOfWeekCalendar wt dow year = let jan1st = fromOrdinalDate year 1 in case wt of FirstWholeWeek -> firstDayOfWeekOnAfter dow jan1st FirstMostWeek -> firstDayOfWeekOnAfter dow $ addDays (-3) jan1st -- | Convert to the given kind of "week calendar". -- Note that the year number matches the weeks, and so is not always the same as the Gregorian year number. toWeekCalendar :: FirstWeekType -- ^ how to reckon the first week of the year -> DayOfWeek -- ^ the first day of each week -> Day -> (Year, WeekOfYear, DayOfWeek) toWeekCalendar wt ws d = let dw = dayOfWeek d (y0,_) = toOrdinalDate d j1p = firstDayOfWeekCalendar wt ws $ pred y0 j1 = firstDayOfWeekCalendar wt ws y0 j1s = firstDayOfWeekCalendar wt ws $ succ y0 in if d < j1 then (pred y0,succ $ div (fromInteger $ diffDays d j1p) 7,dw) else if d < j1s then (y0,succ $ div (fromInteger $ diffDays d j1) 7,dw) else (succ y0,succ $ div (fromInteger $ diffDays d j1s) 7,dw) -- | Convert from the given kind of "week calendar". -- Invalid week and day values will be clipped to the correct range. fromWeekCalendar :: FirstWeekType -- ^ how to reckon the first week of the year -> DayOfWeek -- ^ the first day of each week -> Year -> WeekOfYear -> DayOfWeek -> Day fromWeekCalendar wt ws y wy dw = let d1 :: Day d1 = firstDayOfWeekCalendar wt ws y wy' = clip 1 53 wy getday :: WeekOfYear -> Day getday wy'' = addDays (toInteger $ (pred wy'' * 7) + (dayOfWeekDiff dw ws)) d1 d1s = firstDayOfWeekCalendar wt ws $ succ y day = getday wy' in if wy' == 53 then if day >= d1s then getday 52 else day else day -- | Convert from the given kind of "week calendar". -- Invalid week and day values will return Nothing. fromWeekCalendarValid :: FirstWeekType -- ^ how to reckon the first week of the year -> DayOfWeek -- ^ the first day of each week -> Year -> WeekOfYear -> DayOfWeek -> Maybe Day fromWeekCalendarValid wt ws y wy dw = let d = fromWeekCalendar wt ws y wy dw in if toWeekCalendar wt ws d == (y,wy,dw) then Just d else Nothing -- | Convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday). -- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday. -- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year. toWeekDate :: Day -> (Year, WeekOfYear, Int) toWeekDate d = let (y,wy,dw) = toWeekCalendar FirstMostWeek Monday d in (y,wy,fromEnum dw) -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). -- Invalid week and day values will be clipped to the correct range. fromWeekDate :: Year -> WeekOfYear -> Int -> Day fromWeekDate y wy dw = fromWeekCalendar FirstMostWeek Monday y wy (toEnum $ clip 1 7 dw) -- | Bidirectional abstract constructor for ISO 8601 Week Date format. -- Invalid week values will be clipped to the correct range. pattern YearWeekDay :: Year -> WeekOfYear -> DayOfWeek -> Day pattern YearWeekDay y wy dw <- (toWeekDate -> (y,wy,toEnum -> dw)) where YearWeekDay y wy dw = fromWeekDate y wy (fromEnum dw) #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE YearWeekDay #-} #endif -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). -- Invalid week and day values will return Nothing. fromWeekDateValid :: Year -> WeekOfYear -> Int -> Maybe Day fromWeekDateValid y wy dwr = do dw <- clipValid 1 7 dwr fromWeekCalendarValid FirstMostWeek Monday y wy (toEnum dw) -- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\"). showWeekDate :: Day -> String showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d) where (y, w, d) = toWeekDate date