WeekDate.hs

-- | ISO 8601 Week Date format
module Data.Time.Calendar.WeekDate where

import Data.Time.Calendar.Days
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Private

-- | 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 -> (Integer, Int, Int)
toWeekDate date@(ModifiedJulianDay mjd) = (y1, fromInteger (w1 + 1), fromInteger d_mod_7 + 1)
  where
    (d_div_7, d_mod_7) = d `divMod` 7
    (y0, yd) = toOrdinalDate date
    d = mjd + 2
    foo :: Integer -> Integer
    foo y = bar (toModifiedJulianDay (fromOrdinalDate y 6))
    bar k = d_div_7 - k `div` 7
    (y1, w1) =
        case bar (d - toInteger yd + 4) of
            -1 -> (y0 - 1, foo (y0 - 1))
            52 ->
                if foo (y0 + 1) == 0
                    then (y0 + 1, 0)
                    else (y0, 52)
            w0 -> (y0, w0)

-- | 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 :: Integer -> Int -> Int -> Day
fromWeekDate y w d =
    ModifiedJulianDay
        (k - (mod k 7) +
         (toInteger
              (((clip
                     1
                     (if longYear
                          then 53
                          else 52)
                     w) *
                7) +
               (clip 1 7 d))) -
         10)
  where
    k = toModifiedJulianDay (fromOrdinalDate y 6)
    longYear =
        case toWeekDate (fromOrdinalDate y 365) of
            (_, 53, _) -> True
            _ -> False

-- | 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 :: Integer -> Int -> Int -> Maybe Day
fromWeekDateValid y w d = do
    d' <- clipValid 1 7 d
    let
        longYear =
            case toWeekDate (fromOrdinalDate y 365) of
                (_, 53, _) -> True
                _ -> False
    w' <-
        clipValid
            1
            (if longYear
                 then 53
                 else 52)
            w
    let k = toModifiedJulianDay (fromOrdinalDate y 6)
    return (ModifiedJulianDay (k - (mod k 7) + (toInteger ((w' * 7) + d')) - 10))

-- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\").
showWeekDate :: Day -> String
showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d)
  where
    (y, w, d) = toWeekDate date