module Data.Time.Calendar.WeekDate where
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Days
import Data.Time.Calendar.Private
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)
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
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))
showWeekDate :: Day -> String
showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d) where
    (y,w,d) = toWeekDate date