{-# 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 FirstWeekType -> FirstWeekType -> Bool (FirstWeekType -> FirstWeekType -> Bool) -> (FirstWeekType -> FirstWeekType -> Bool) -> Eq FirstWeekType forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: FirstWeekType -> FirstWeekType -> Bool $c/= :: FirstWeekType -> FirstWeekType -> Bool == :: FirstWeekType -> FirstWeekType -> Bool $c== :: FirstWeekType -> FirstWeekType -> Bool Eq firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Integer -> Day firstDayOfWeekCalendar FirstWeekType wt DayOfWeek dow Integer year = let jan1st :: Day jan1st = Integer -> WeekOfYear -> Day fromOrdinalDate Integer year WeekOfYear 1 in case FirstWeekType wt of FirstWeekType FirstWholeWeek -> DayOfWeek -> Day -> Day firstDayOfWeekOnAfter DayOfWeek dow Day jan1st FirstWeekType FirstMostWeek -> DayOfWeek -> Day -> Day firstDayOfWeekOnAfter DayOfWeek dow (Day -> Day) -> Day -> Day forall a b. (a -> b) -> a -> b $ Integer -> Day -> Day addDays (-Integer 3) Day 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 :: FirstWeekType -> DayOfWeek -> Day -> (Integer, WeekOfYear, DayOfWeek) toWeekCalendar FirstWeekType wt DayOfWeek ws Day d = let dw :: DayOfWeek dw = Day -> DayOfWeek dayOfWeek Day d (Integer y0,WeekOfYear _) = Day -> (Integer, WeekOfYear) toOrdinalDate Day d j1p :: Day j1p = FirstWeekType -> DayOfWeek -> Integer -> Day firstDayOfWeekCalendar FirstWeekType wt DayOfWeek ws (Integer -> Day) -> Integer -> Day forall a b. (a -> b) -> a -> b $ Integer -> Integer forall a. Enum a => a -> a pred Integer y0 j1 :: Day j1 = FirstWeekType -> DayOfWeek -> Integer -> Day firstDayOfWeekCalendar FirstWeekType wt DayOfWeek ws Integer y0 j1s :: Day j1s = FirstWeekType -> DayOfWeek -> Integer -> Day firstDayOfWeekCalendar FirstWeekType wt DayOfWeek ws (Integer -> Day) -> Integer -> Day forall a b. (a -> b) -> a -> b $ Integer -> Integer forall a. Enum a => a -> a succ Integer y0 in if Day d Day -> Day -> Bool forall a. Ord a => a -> a -> Bool < Day j1 then (Integer -> Integer forall a. Enum a => a -> a pred Integer y0,WeekOfYear -> WeekOfYear forall a. Enum a => a -> a succ (WeekOfYear -> WeekOfYear) -> WeekOfYear -> WeekOfYear forall a b. (a -> b) -> a -> b $ WeekOfYear -> WeekOfYear -> WeekOfYear forall a. Integral a => a -> a -> a div (Integer -> WeekOfYear forall a. Num a => Integer -> a fromInteger (Integer -> WeekOfYear) -> Integer -> WeekOfYear forall a b. (a -> b) -> a -> b $ Day -> Day -> Integer diffDays Day d Day j1p) WeekOfYear 7,DayOfWeek dw) else if Day d Day -> Day -> Bool forall a. Ord a => a -> a -> Bool < Day j1s then (Integer y0,WeekOfYear -> WeekOfYear forall a. Enum a => a -> a succ (WeekOfYear -> WeekOfYear) -> WeekOfYear -> WeekOfYear forall a b. (a -> b) -> a -> b $ WeekOfYear -> WeekOfYear -> WeekOfYear forall a. Integral a => a -> a -> a div (Integer -> WeekOfYear forall a. Num a => Integer -> a fromInteger (Integer -> WeekOfYear) -> Integer -> WeekOfYear forall a b. (a -> b) -> a -> b $ Day -> Day -> Integer diffDays Day d Day j1) WeekOfYear 7,DayOfWeek dw) else (Integer -> Integer forall a. Enum a => a -> a succ Integer y0,WeekOfYear -> WeekOfYear forall a. Enum a => a -> a succ (WeekOfYear -> WeekOfYear) -> WeekOfYear -> WeekOfYear forall a b. (a -> b) -> a -> b $ WeekOfYear -> WeekOfYear -> WeekOfYear forall a. Integral a => a -> a -> a div (Integer -> WeekOfYear forall a. Num a => Integer -> a fromInteger (Integer -> WeekOfYear) -> Integer -> WeekOfYear forall a b. (a -> b) -> a -> b $ Day -> Day -> Integer diffDays Day d Day j1s) WeekOfYear 7,DayOfWeek 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 :: FirstWeekType -> DayOfWeek -> Integer -> WeekOfYear -> DayOfWeek -> Day fromWeekCalendar FirstWeekType wt DayOfWeek ws Integer y WeekOfYear wy DayOfWeek dw = let d1 :: Day d1 :: Day d1 = FirstWeekType -> DayOfWeek -> Integer -> Day firstDayOfWeekCalendar FirstWeekType wt DayOfWeek ws Integer y wy' :: WeekOfYear wy' = WeekOfYear -> WeekOfYear -> WeekOfYear -> WeekOfYear forall t. Ord t => t -> t -> t -> t clip WeekOfYear 1 WeekOfYear 53 WeekOfYear wy getday :: WeekOfYear -> Day getday :: WeekOfYear -> Day getday WeekOfYear wy'' = Integer -> Day -> Day addDays (WeekOfYear -> Integer forall a. Integral a => a -> Integer toInteger (WeekOfYear -> Integer) -> WeekOfYear -> Integer forall a b. (a -> b) -> a -> b $ (WeekOfYear -> WeekOfYear forall a. Enum a => a -> a pred WeekOfYear wy'' WeekOfYear -> WeekOfYear -> WeekOfYear forall a. Num a => a -> a -> a * WeekOfYear 7) WeekOfYear -> WeekOfYear -> WeekOfYear forall a. Num a => a -> a -> a + (DayOfWeek -> DayOfWeek -> WeekOfYear dayOfWeekDiff DayOfWeek dw DayOfWeek ws)) Day d1 d1s :: Day d1s = FirstWeekType -> DayOfWeek -> Integer -> Day firstDayOfWeekCalendar FirstWeekType wt DayOfWeek ws (Integer -> Day) -> Integer -> Day forall a b. (a -> b) -> a -> b $ Integer -> Integer forall a. Enum a => a -> a succ Integer y day :: Day day = WeekOfYear -> Day getday WeekOfYear wy' in if WeekOfYear wy' WeekOfYear -> WeekOfYear -> Bool forall a. Eq a => a -> a -> Bool == WeekOfYear 53 then if Day day Day -> Day -> Bool forall a. Ord a => a -> a -> Bool >= Day d1s then WeekOfYear -> Day getday WeekOfYear 52 else Day day else Day 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 :: FirstWeekType -> DayOfWeek -> Integer -> WeekOfYear -> DayOfWeek -> Maybe Day fromWeekCalendarValid FirstWeekType wt DayOfWeek ws Integer y WeekOfYear wy DayOfWeek dw = let d :: Day d = FirstWeekType -> DayOfWeek -> Integer -> WeekOfYear -> DayOfWeek -> Day fromWeekCalendar FirstWeekType wt DayOfWeek ws Integer y WeekOfYear wy DayOfWeek dw in if FirstWeekType -> DayOfWeek -> Day -> (Integer, WeekOfYear, DayOfWeek) toWeekCalendar FirstWeekType wt DayOfWeek ws Day d (Integer, WeekOfYear, DayOfWeek) -> (Integer, WeekOfYear, DayOfWeek) -> Bool forall a. Eq a => a -> a -> Bool == (Integer y,WeekOfYear wy,DayOfWeek dw) then Day -> Maybe Day forall a. a -> Maybe a Just Day d else Maybe Day forall a. Maybe a 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 :: Day -> (Integer, WeekOfYear, WeekOfYear) toWeekDate Day d = let (Integer y,WeekOfYear wy,DayOfWeek dw) = FirstWeekType -> DayOfWeek -> Day -> (Integer, WeekOfYear, DayOfWeek) toWeekCalendar FirstWeekType FirstMostWeek DayOfWeek Monday Day d in (Integer y,WeekOfYear wy,DayOfWeek -> WeekOfYear forall a. Enum a => a -> WeekOfYear fromEnum DayOfWeek 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 :: Integer -> WeekOfYear -> WeekOfYear -> Day fromWeekDate Integer y WeekOfYear wy WeekOfYear dw = FirstWeekType -> DayOfWeek -> Integer -> WeekOfYear -> DayOfWeek -> Day fromWeekCalendar FirstWeekType FirstMostWeek DayOfWeek Monday Integer y WeekOfYear wy (WeekOfYear -> DayOfWeek forall a. Enum a => WeekOfYear -> a toEnum (WeekOfYear -> DayOfWeek) -> WeekOfYear -> DayOfWeek forall a b. (a -> b) -> a -> b $ WeekOfYear -> WeekOfYear -> WeekOfYear -> WeekOfYear forall t. Ord t => t -> t -> t -> t clip WeekOfYear 1 WeekOfYear 7 WeekOfYear 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 $mYearWeekDay :: forall {r}. Day -> (Integer -> WeekOfYear -> DayOfWeek -> r) -> ((# #) -> r) -> r $bYearWeekDay :: Integer -> WeekOfYear -> DayOfWeek -> Day YearWeekDay y wy dw <- (toWeekDate -> (y,wy,toEnum -> dw)) where YearWeekDay Integer y WeekOfYear wy DayOfWeek dw = Integer -> WeekOfYear -> WeekOfYear -> Day fromWeekDate Integer y WeekOfYear wy (DayOfWeek -> WeekOfYear forall a. Enum a => a -> WeekOfYear fromEnum DayOfWeek 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 :: Integer -> WeekOfYear -> WeekOfYear -> Maybe Day fromWeekDateValid Integer y WeekOfYear wy WeekOfYear dwr = do WeekOfYear dw <- WeekOfYear -> WeekOfYear -> WeekOfYear -> Maybe WeekOfYear forall t. Ord t => t -> t -> t -> Maybe t clipValid WeekOfYear 1 WeekOfYear 7 WeekOfYear dwr FirstWeekType -> DayOfWeek -> Integer -> WeekOfYear -> DayOfWeek -> Maybe Day fromWeekCalendarValid FirstWeekType FirstMostWeek DayOfWeek Monday Integer y WeekOfYear wy (WeekOfYear -> DayOfWeek forall a. Enum a => WeekOfYear -> a toEnum WeekOfYear dw) -- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\"). showWeekDate :: Day -> String showWeekDate :: Day -> String showWeekDate Day date = (Integer -> String forall t. ShowPadded t => t -> String show4 Integer y) String -> String -> String forall a. [a] -> [a] -> [a] ++ String "-W" String -> String -> String forall a. [a] -> [a] -> [a] ++ (WeekOfYear -> String forall t. ShowPadded t => t -> String show2 WeekOfYear w) String -> String -> String forall a. [a] -> [a] -> [a] ++ String "-" String -> String -> String forall a. [a] -> [a] -> [a] ++ (WeekOfYear -> String forall a. Show a => a -> String show WeekOfYear d) where (Integer y, WeekOfYear w, WeekOfYear d) = Day -> (Integer, WeekOfYear, WeekOfYear) toWeekDate Day date