{-# 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.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 FirstWeekType -> FirstWeekType -> Bool
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 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ Integer
y0
in if Day
d forall a. Ord a => a -> a -> Bool
< Day
j1
then (forall a. Enum a => a -> a
pred Integer
y0,forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
d Day
j1p) WeekOfYear
7,DayOfWeek
dw)
else if Day
d forall a. Ord a => a -> a -> Bool
< Day
j1s then (Integer
y0,forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
d Day
j1) WeekOfYear
7,DayOfWeek
dw)
else (forall a. Enum a => a -> a
succ Integer
y0,forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div (forall a. Num a => Integer -> a
fromInteger 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' = 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 (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ (forall a. Enum a => a -> a
pred WeekOfYear
wy'' forall a. Num a => a -> a -> a
* WeekOfYear
7) 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 forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ Integer
y
day :: Day
day = WeekOfYear -> Day
getday WeekOfYear
wy'
in if WeekOfYear
wy' forall a. Eq a => a -> a -> Bool
== WeekOfYear
53 then if Day
day 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 forall a. Eq a => a -> a -> Bool
== (Integer
y,WeekOfYear
wy,DayOfWeek
dw) then forall a. a -> Maybe a
Just Day
d else 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,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 (forall a. Enum a => WeekOfYear -> a
toEnum forall a b. (a -> b) -> a -> b
$ 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 (forall a. Enum a => a -> WeekOfYear
fromEnum DayOfWeek
dw)
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE YearWeekDay #-}
#endif
fromWeekDateValid :: Year -> WeekOfYear -> Int -> Maybe Day
fromWeekDateValid :: Integer -> WeekOfYear -> WeekOfYear -> Maybe Day
fromWeekDateValid Integer
y WeekOfYear
wy WeekOfYear
dwr = do
WeekOfYear
dw <- 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 (forall a. Enum a => WeekOfYear -> a
toEnum WeekOfYear
dw)
showWeekDate :: Day -> String
showWeekDate :: Day -> String
showWeekDate Day
date = (forall t. ShowPadded t => t -> String
show4 Integer
y) forall a. [a] -> [a] -> [a]
++ String
"-W" forall a. [a] -> [a] -> [a]
++ (forall t. ShowPadded t => t -> String
show2 WeekOfYear
w) forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show WeekOfYear
d)
where
(Integer
y, WeekOfYear
w, WeekOfYear
d) = Day -> (Integer, WeekOfYear, WeekOfYear)
toWeekDate Day
date