{-# LANGUAGE Safe #-}
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 (FirstWeekType -> FirstWeekType -> Bool
(FirstWeekType -> FirstWeekType -> Bool)
-> (FirstWeekType -> FirstWeekType -> Bool) -> Eq FirstWeekType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FirstWeekType -> FirstWeekType -> Bool
== :: FirstWeekType -> FirstWeekType -> Bool
$c/= :: FirstWeekType -> FirstWeekType -> Bool
/= :: 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
toWeekCalendar ::
FirstWeekType ->
DayOfWeek ->
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)
fromWeekCalendar ::
FirstWeekType ->
DayOfWeek ->
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
fromWeekCalendarValid ::
FirstWeekType ->
DayOfWeek ->
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
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)
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)
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)
{-# COMPLETE YearWeekDay #-}
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)
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