{-# 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
import qualified Language.Haskell.TH.Syntax as TH

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
$c== :: FirstWeekType -> FirstWeekType -> Bool
== :: FirstWeekType -> FirstWeekType -> Bool
$c/= :: FirstWeekType -> FirstWeekType -> Bool
/= :: FirstWeekType -> FirstWeekType -> Bool
Eq, (forall (m :: * -> *). Quote m => FirstWeekType -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    FirstWeekType -> Code m FirstWeekType)
-> Lift FirstWeekType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FirstWeekType -> m Exp
forall (m :: * -> *).
Quote m =>
FirstWeekType -> Code m FirstWeekType
$clift :: forall (m :: * -> *). Quote m => FirstWeekType -> m Exp
lift :: forall (m :: * -> *). Quote m => FirstWeekType -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
FirstWeekType -> Code m FirstWeekType
liftTyped :: forall (m :: * -> *).
Quote m =>
FirstWeekType -> Code m FirstWeekType
TH.Lift)

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

-- | 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 -> (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)

-- | 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 -> 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

-- | 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 -> 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

-- | 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 -> (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)

-- | 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 :: 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)

-- | 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 $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 #-}

-- | 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 :: 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)

-- | 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 = (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