{-# 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
(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 -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
dow Year
year = let
jan1st :: Day
jan1st = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
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
$ Year -> Day -> Day
addDays (-Year
3) Day
jan1st
toWeekCalendar ::
FirstWeekType
-> DayOfWeek
-> Day
-> (Year, WeekOfYear, DayOfWeek)
toWeekCalendar :: FirstWeekType -> DayOfWeek -> Day -> (Year, DayOfYear, DayOfWeek)
toWeekCalendar FirstWeekType
wt DayOfWeek
ws Day
d = let
dw :: DayOfWeek
dw = Day -> DayOfWeek
dayOfWeek Day
d
(Year
y0,DayOfYear
_) = Day -> (Year, DayOfYear)
toOrdinalDate Day
d
j1p :: Day
j1p = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws (Year -> Day) -> Year -> Day
forall a b. (a -> b) -> a -> b
$ Year -> Year
forall a. Enum a => a -> a
pred Year
y0
j1 :: Day
j1 = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y0
j1s :: Day
j1s = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws (Year -> Day) -> Year -> Day
forall a b. (a -> b) -> a -> b
$ Year -> Year
forall a. Enum a => a -> a
succ Year
y0
in if Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
j1
then (Year -> Year
forall a. Enum a => a -> a
pred Year
y0,DayOfYear -> DayOfYear
forall a. Enum a => a -> a
succ (DayOfYear -> DayOfYear) -> DayOfYear -> DayOfYear
forall a b. (a -> b) -> a -> b
$ DayOfYear -> DayOfYear -> DayOfYear
forall a. Integral a => a -> a -> a
div (Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger (Year -> DayOfYear) -> Year -> DayOfYear
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
d Day
j1p) DayOfYear
7,DayOfWeek
dw)
else if Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
j1s then (Year
y0,DayOfYear -> DayOfYear
forall a. Enum a => a -> a
succ (DayOfYear -> DayOfYear) -> DayOfYear -> DayOfYear
forall a b. (a -> b) -> a -> b
$ DayOfYear -> DayOfYear -> DayOfYear
forall a. Integral a => a -> a -> a
div (Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger (Year -> DayOfYear) -> Year -> DayOfYear
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
d Day
j1) DayOfYear
7,DayOfWeek
dw)
else (Year -> Year
forall a. Enum a => a -> a
succ Year
y0,DayOfYear -> DayOfYear
forall a. Enum a => a -> a
succ (DayOfYear -> DayOfYear) -> DayOfYear -> DayOfYear
forall a b. (a -> b) -> a -> b
$ DayOfYear -> DayOfYear -> DayOfYear
forall a. Integral a => a -> a -> a
div (Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger (Year -> DayOfYear) -> Year -> DayOfYear
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
d Day
j1s) DayOfYear
7,DayOfWeek
dw)
fromWeekCalendar ::
FirstWeekType
-> DayOfWeek
-> Year -> WeekOfYear -> DayOfWeek -> Day
fromWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> DayOfYear -> DayOfWeek -> Day
fromWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y DayOfYear
wy DayOfWeek
dw = let
d1 :: Day
d1 :: Day
d1 = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y
wy' :: DayOfYear
wy' = DayOfYear -> DayOfYear -> DayOfYear -> DayOfYear
forall t. Ord t => t -> t -> t -> t
clip DayOfYear
1 DayOfYear
53 DayOfYear
wy
getday :: WeekOfYear -> Day
getday :: DayOfYear -> Day
getday DayOfYear
wy'' = Year -> Day -> Day
addDays (DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger (DayOfYear -> Year) -> DayOfYear -> Year
forall a b. (a -> b) -> a -> b
$ (DayOfYear -> DayOfYear
forall a. Enum a => a -> a
pred DayOfYear
wy'' DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
* DayOfYear
7) DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
+ (DayOfWeek -> DayOfWeek -> DayOfYear
dayOfWeekDiff DayOfWeek
dw DayOfWeek
ws)) Day
d1
d1s :: Day
d1s = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws (Year -> Day) -> Year -> Day
forall a b. (a -> b) -> a -> b
$ Year -> Year
forall a. Enum a => a -> a
succ Year
y
day :: Day
day = DayOfYear -> Day
getday DayOfYear
wy'
in if DayOfYear
wy' DayOfYear -> DayOfYear -> Bool
forall a. Eq a => a -> a -> Bool
== DayOfYear
53 then if Day
day Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
d1s then DayOfYear -> Day
getday DayOfYear
52 else Day
day else Day
day
fromWeekCalendarValid ::
FirstWeekType
-> DayOfWeek
-> Year -> WeekOfYear -> DayOfWeek -> Maybe Day
fromWeekCalendarValid :: FirstWeekType
-> DayOfWeek -> Year -> DayOfYear -> DayOfWeek -> Maybe Day
fromWeekCalendarValid FirstWeekType
wt DayOfWeek
ws Year
y DayOfYear
wy DayOfWeek
dw = let
d :: Day
d = FirstWeekType -> DayOfWeek -> Year -> DayOfYear -> DayOfWeek -> Day
fromWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y DayOfYear
wy DayOfWeek
dw
in if FirstWeekType -> DayOfWeek -> Day -> (Year, DayOfYear, DayOfWeek)
toWeekCalendar FirstWeekType
wt DayOfWeek
ws Day
d (Year, DayOfYear, DayOfWeek)
-> (Year, DayOfYear, DayOfWeek) -> Bool
forall a. Eq a => a -> a -> Bool
== (Year
y,DayOfYear
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 -> (Year, DayOfYear, DayOfYear)
toWeekDate Day
d = let
(Year
y,DayOfYear
wy,DayOfWeek
dw) = FirstWeekType -> DayOfWeek -> Day -> (Year, DayOfYear, DayOfWeek)
toWeekCalendar FirstWeekType
FirstMostWeek DayOfWeek
Monday Day
d
in (Year
y,DayOfYear
wy,DayOfWeek -> DayOfYear
forall a. Enum a => a -> DayOfYear
fromEnum DayOfWeek
dw)
fromWeekDate :: Year -> WeekOfYear -> Int -> Day
fromWeekDate :: Year -> DayOfYear -> DayOfYear -> Day
fromWeekDate Year
y DayOfYear
wy DayOfYear
dw = FirstWeekType -> DayOfWeek -> Year -> DayOfYear -> DayOfWeek -> Day
fromWeekCalendar FirstWeekType
FirstMostWeek DayOfWeek
Monday Year
y DayOfYear
wy (DayOfYear -> DayOfWeek
forall a. Enum a => DayOfYear -> a
toEnum (DayOfYear -> DayOfWeek) -> DayOfYear -> DayOfWeek
forall a b. (a -> b) -> a -> b
$ DayOfYear -> DayOfYear -> DayOfYear -> DayOfYear
forall t. Ord t => t -> t -> t -> t
clip DayOfYear
1 DayOfYear
7 DayOfYear
dw)
pattern YearWeekDay :: Year -> WeekOfYear -> DayOfWeek -> Day
pattern $bYearWeekDay :: Year -> DayOfYear -> DayOfWeek -> Day
$mYearWeekDay :: forall r.
Day -> (Year -> DayOfYear -> DayOfWeek -> r) -> (Void# -> r) -> r
YearWeekDay y wy dw <- (toWeekDate -> (y,wy,toEnum -> dw)) where
YearWeekDay Year
y DayOfYear
wy DayOfWeek
dw = Year -> DayOfYear -> DayOfYear -> Day
fromWeekDate Year
y DayOfYear
wy (DayOfWeek -> DayOfYear
forall a. Enum a => a -> DayOfYear
fromEnum DayOfWeek
dw)
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE YearWeekDay #-}
#endif
fromWeekDateValid :: Year -> WeekOfYear -> Int -> Maybe Day
fromWeekDateValid :: Year -> DayOfYear -> DayOfYear -> Maybe Day
fromWeekDateValid Year
y DayOfYear
wy DayOfYear
dwr = do
DayOfYear
dw <- DayOfYear -> DayOfYear -> DayOfYear -> Maybe DayOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid DayOfYear
1 DayOfYear
7 DayOfYear
dwr
FirstWeekType
-> DayOfWeek -> Year -> DayOfYear -> DayOfWeek -> Maybe Day
fromWeekCalendarValid FirstWeekType
FirstMostWeek DayOfWeek
Monday Year
y DayOfYear
wy (DayOfYear -> DayOfWeek
forall a. Enum a => DayOfYear -> a
toEnum DayOfYear
dw)
showWeekDate :: Day -> String
showWeekDate :: Day -> String
showWeekDate Day
date = (Year -> String
forall t. ShowPadded t => t -> String
show4 Year
y) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-W" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (DayOfYear -> String
forall t. ShowPadded t => t -> String
show2 DayOfYear
w) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (DayOfYear -> String
forall a. Show a => a -> String
show DayOfYear
d)
where
(Year
y, DayOfYear
w, DayOfYear
d) = Day -> (Year, DayOfYear, DayOfYear)
toWeekDate Day
date