module Data.Time.Calendar.WeekDate (
Year,
WeekOfYear,
DayOfWeek (..),
dayOfWeek,
FirstWeekType (..),
toWeekCalendar,
fromWeekCalendar,
fromWeekCalendarValid,
toWeekDate,
fromWeekDate,
pattern YearWeekDay,
fromWeekDateValid,
showWeekDate,
) where
import Data.Time.Calendar.Days
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Private
import Data.Time.Calendar.Week
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)
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