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

import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Days
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 :: Day -> (Integer, Int, Int)
toWeekDate date :: Day
date@(ModifiedJulianDay Integer
mjd) = (Integer
y1,Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
w1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1),Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
d_mod_7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) where
    (Integer
d_div_7, Integer
d_mod_7) = Integer
d Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
7
    (Integer
y0,Int
yd) = Day -> (Integer, Int)
toOrdinalDate Day
date
    d :: Integer
d = Integer
mjd Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2
    foo :: Integer -> Integer
    foo :: Integer -> Integer
foo Integer
y = Integer -> Integer
bar (Day -> Integer
toModifiedJulianDay (Integer -> Int -> Day
fromOrdinalDate Integer
y Int
6))
    bar :: Integer -> Integer
bar Integer
k = Integer
d_div_7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
k Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
7
    (Integer
y1,Integer
w1) = case Integer -> Integer
bar (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
yd Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
4) of
                -1 -> (Integer
y0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1, Integer -> Integer
foo (Integer
y0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
                Integer
52 -> if Integer -> Integer
foo (Integer
y0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
                      then (Integer
y0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer
0)
                      else (Integer
y0, Integer
52)
                Integer
w0  -> (Integer
y0, Integer
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 :: Integer -> Int -> Int -> Day
fromWeekDate Integer
y Int
w Int
d = Integer -> Day
ModifiedJulianDay (Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
k Integer
7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (((Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 (if Bool
longYear then Int
53 else Int
52) Int
w) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 Int
7 Int
d))) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
10) where
        k :: Integer
k = Day -> Integer
toModifiedJulianDay (Integer -> Int -> Day
fromOrdinalDate Integer
y Int
6)
        longYear :: Bool
longYear = case Day -> (Integer, Int, Int)
toWeekDate (Integer -> Int -> Day
fromOrdinalDate Integer
y Int
365) of
            (Integer
_,Int
53,Int
_) -> Bool
True
            (Integer, Int, Int)
_ -> Bool
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 :: Integer -> Int -> Int -> Maybe Day
fromWeekDateValid Integer
y Int
w Int
d = do
    Int
d' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
7 Int
d
    let
        longYear :: Bool
longYear = case Day -> (Integer, Int, Int)
toWeekDate (Integer -> Int -> Day
fromOrdinalDate Integer
y Int
365) of
            (Integer
_,Int
53,Int
_) -> Bool
True
            (Integer, Int, Int)
_ -> Bool
False
    Int
w' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 (if Bool
longYear then Int
53 else Int
52) Int
w
    let
        k :: Integer
k = Day -> Integer
toModifiedJulianDay (Integer -> Int -> Day
fromOrdinalDate Integer
y Int
6)
    Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Day
ModifiedJulianDay (Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
k Integer
7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger ((Int
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d')) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
10))

-- | 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]
++ (Int -> String
forall t. ShowPadded t => t -> String
show2 Int
w) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
d) where
    (Integer
y,Int
w,Int
d) = Day -> (Integer, Int, Int)
toWeekDate Day
date