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 (mod d 7) + 1) where
(y0,yd) = toOrdinalDate date
d = mjd + 2
foo :: Integer -> Integer
foo y = bar (toModifiedJulianDay (fromOrdinalDate y 6))
bar k = (div d 7) (div k 7)
w0 = bar (d (toInteger yd) + 4)
(y1,w1) = if w0 == 1
then (y0 1,foo (y0 1))
else if w0 == 52
then if (foo (y0 + 1)) == 0
then (y0 + 1,0)
else (y0,w0)
else (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 (Just '0') y) ++ "-W" ++ (show2 (Just '0') w) ++ "-" ++ (show d) where
(y,w,d) = toWeekDate date