module Data.Time.Calendar.WeekDate
(
Year, WeekOfYear, DayOfWeek(..), dayOfWeek,
FirstWeekType (..),toWeekCalendar,fromWeekCalendar,fromWeekCalendarValid,
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
| FirstMostWeek
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
toWeekCalendar ::
FirstWeekType
-> DayOfWeek
-> 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)
fromWeekCalendar ::
FirstWeekType
-> DayOfWeek
-> 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
fromWeekCalendarValid ::
FirstWeekType
-> DayOfWeek
-> 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
toWeekDate :: Day -> (Year, WeekOfYear, Int)
toWeekDate d = let
(y,wy,dw) = toWeekCalendar FirstMostWeek Monday d
in (y,wy,fromEnum dw)
fromWeekDate :: Year -> WeekOfYear -> Int -> Day
fromWeekDate y wy dw = fromWeekCalendar FirstMostWeek Monday y wy (toEnum $ clip 1 7 dw)
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
#endif
fromWeekDateValid :: Year -> WeekOfYear -> Int -> Maybe Day
fromWeekDateValid y wy dwr = do
dw <- clipValid 1 7 dwr
fromWeekCalendarValid FirstMostWeek Monday y wy (toEnum dw)
showWeekDate :: Day -> String
showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d)
where
(y, w, d) = toWeekDate date