{-# LANGUAGE Safe #-}

-- | Week-based calendars
module Data.Time.Calendar.WeekDate (
    Year,
    WeekOfYear,
    DayOfWeek (..),
    dayOfWeek,
    FirstWeekType (..),
    toWeekCalendar,
    fromWeekCalendar,
    fromWeekCalendarValid,

    -- * ISO 8601 Week Date format
    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
    = -- | first week is the first whole week of the year
      FirstWholeWeek
    | -- | first week is the first week with four days in the year
      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

-- | Convert to the given kind of "week calendar".
-- Note that the year number matches the weeks, and so is not always the same as the Gregorian year number.
toWeekCalendar ::
    -- | how to reckon the first week of the year
    FirstWeekType ->
    -- | the first day of each week
    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)

-- | Convert from the given kind of "week calendar".
-- Invalid week and day values will be clipped to the correct range.
fromWeekCalendar ::
    -- | how to reckon the first week of the year
    FirstWeekType ->
    -- | the first day of each week
    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

-- | Convert from the given kind of "week calendar".
-- Invalid week and day values will return Nothing.
fromWeekCalendarValid ::
    -- | how to reckon the first week of the year
    FirstWeekType ->
    -- | the first day of each week
    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

-- | Convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday).
-- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday.
-- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year.
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)

-- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
-- Invalid week and day values will be clipped to the correct range.
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)

-- | Bidirectional abstract constructor for ISO 8601 Week Date format.
-- Invalid week values will be clipped to the correct range.
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)

{-# COMPLETE YearWeekDay #-}

-- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
-- Invalid week and day values will return Nothing.
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)

-- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\").
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