-- | ISO 8601 Ordinal Date format
module Data.Time.Calendar.OrdinalDate where

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

-- | Convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar),
-- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31.
toOrdinalDate :: Day -> (Integer,Int)
toOrdinalDate :: Day -> (Integer, Int)
toOrdinalDate (ModifiedJulianDay Integer
mjd) = (Integer
year,Int
yd) where
    a :: Integer
a = Integer
mjd Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
678575
    quadcent :: Integer
quadcent = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
a Integer
146097
    b :: Integer
b = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
a Integer
146097
    cent :: Integer
cent = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
b Integer
36524) Integer
3
    c :: Integer
c = Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
cent Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
36524)
    quad :: Integer
quad = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
c Integer
1461
    d :: Integer
d = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
c Integer
1461
    y :: Integer
y = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
d Integer
365) Integer
3
    yd :: Int
yd = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
365) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
    year :: Integer
year = Integer
quadcent Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
400 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
cent Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
quad Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1

-- | Convert from ISO 8601 Ordinal Date format.
-- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).
fromOrdinalDate :: Integer -> Int -> Day
fromOrdinalDate :: Integer -> Int -> Day
fromOrdinalDate Integer
year Int
day = Integer -> Day
ModifiedJulianDay Integer
mjd where
    y :: Integer
y = Integer
year Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    mjd :: Integer
mjd = (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 (if Integer -> Bool
isLeapYear Integer
year then Int
366 else Int
365) Int
day)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
365 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y Integer
4) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y Integer
100) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y Integer
400) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
678576

-- | Convert from ISO 8601 Ordinal Date format.
-- Invalid day numbers return 'Nothing'
fromOrdinalDateValid :: Integer -> Int -> Maybe Day
fromOrdinalDateValid :: Integer -> Int -> Maybe Day
fromOrdinalDateValid Integer
year Int
day = do
    Int
day' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 (if Integer -> Bool
isLeapYear Integer
year then Int
366 else Int
365) Int
day
    let
        y :: Integer
y = Integer
year Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
        mjd :: Integer
mjd = (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
day') Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
365 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y Integer
4) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y Integer
100) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y Integer
400) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
678576
    Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Day
ModifiedJulianDay Integer
mjd)

-- | Show in ISO 8601 Ordinal Date format (yyyy-ddd)
showOrdinalDate :: Day -> String
showOrdinalDate :: Day -> String
showOrdinalDate Day
date = (Integer -> String
forall t. ShowPadded t => t -> String
show4 Integer
y) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall t. ShowPadded t => t -> String
show3 Int
d) where
    (Integer
y,Int
d) = Day -> (Integer, Int)
toOrdinalDate Day
date

-- | Is this year a leap year according to the proleptic Gregorian calendar?
isLeapYear :: Integer -> Bool
isLeapYear :: Integer -> Bool
isLeapYear Integer
year = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
year Integer
4 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) Bool -> Bool -> Bool
&& ((Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
year Integer
400 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) Bool -> Bool -> Bool
|| Bool -> Bool
not (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
year Integer
100 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0))

-- | Get the number of the Monday-starting week in the year and the day of the week.
-- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
-- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
mondayStartWeek :: Day -> (Int,Int)
mondayStartWeek :: Day -> (Int, Int)
mondayStartWeek Day
date = (Integer -> Int
forall a. Num a => Integer -> a
fromInteger ((Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
d Integer
7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
k Integer
7)),Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
d Integer
7) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) where
    yd :: Int
yd = (Integer, Int) -> Int
forall a b. (a, b) -> b
snd (Day -> (Integer, Int)
toOrdinalDate Day
date)
    d :: Integer
d = (Day -> Integer
toModifiedJulianDay Day
date) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2
    k :: Integer
k = Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
yd)

-- | Get the number of the Sunday-starting week in the year and the day of the week.
-- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
-- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
sundayStartWeek :: Day -> (Int,Int)
sundayStartWeek :: Day -> (Int, Int)
sundayStartWeek Day
date =(Integer -> Int
forall a. Num a => Integer -> a
fromInteger ((Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
d Integer
7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
k Integer
7)),Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
d Integer
7)) where
    yd :: Int
yd = (Integer, Int) -> Int
forall a b. (a, b) -> b
snd (Day -> (Integer, Int)
toOrdinalDate Day
date)
    d :: Integer
d = (Day -> Integer
toModifiedJulianDay Day
date) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3
    k :: Integer
k = Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
yd)

-- | The inverse of 'mondayStartWeek'. Get a 'Day' given the year,
-- the number of the Monday-starting week, and the day of the week.
-- The first Monday is the first day of week 1, any earlier days in the year
-- are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
fromMondayStartWeek :: Integer -- ^ Year.
                    -> Int     -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
                    -> Int     -- ^ Day of week.
                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
                    -> Day
fromMondayStartWeek :: Integer -> Int -> Int -> Day
fromMondayStartWeek Integer
year Int
w Int
d = let
    -- first day of the year
    firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year Int
1

    -- 0-based year day of first monday of the year
    zbFirstMonday :: Integer
zbFirstMonday = (Integer
5 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Day -> Integer
toModifiedJulianDay Day
firstDay) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
7

    -- 0-based week of year
    zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    -- 0-based day of week
    zbDay :: Int
zbDay = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    -- 0-based day in year
    zbYearDay :: Integer
zbYearDay = Integer
zbFirstMonday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbWeek Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbDay

    in Integer -> Day -> Day
addDays Integer
zbYearDay Day
firstDay

fromMondayStartWeekValid :: Integer -- ^ Year.
                    -> Int     -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
                    -> Int     -- ^ Day of week.
                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
                    -> Maybe Day
fromMondayStartWeekValid :: Integer -> Int -> Int -> Maybe Day
fromMondayStartWeekValid Integer
year 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
        -- first day of the year
        firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year Int
1

        -- 0-based week of year
        zbFirstMonday :: Integer
zbFirstMonday = (Integer
5 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Day -> Integer
toModifiedJulianDay Day
firstDay) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
7

        -- 0-based week number
        zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

        -- 0-based day of week
        zbDay :: Int
zbDay = Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

        -- 0-based day in year
        zbYearDay :: Integer
zbYearDay = Integer
zbFirstMonday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbWeek Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbDay

    Integer
zbYearDay' <- Integer -> Integer -> Integer -> Maybe Integer
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Integer
0 (if Integer -> Bool
isLeapYear Integer
year then Integer
365 else Integer
364) Integer
zbYearDay
    Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
zbYearDay' Day
firstDay

-- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and
-- the number of the day of a Sunday-starting week.
-- The first Sunday is the first day of week 1, any earlier days in the
-- year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
fromSundayStartWeek :: Integer -- ^ Year.
                    -> Int     -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
                    -> Int     -- ^ Day of week
                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
                    -> Day
fromSundayStartWeek :: Integer -> Int -> Int -> Day
fromSundayStartWeek Integer
year Int
w Int
d = let
    -- first day of the year
    firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year Int
1

    -- 0-based year day of first monday of the year
    zbFirstSunday :: Integer
zbFirstSunday = (Integer
4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Day -> Integer
toModifiedJulianDay Day
firstDay) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
7

    -- 0-based week of year
    zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    -- 0-based day of week
    zbDay :: Int
zbDay = Int
d

    -- 0-based day in year
    zbYearDay :: Integer
zbYearDay = Integer
zbFirstSunday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbWeek Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbDay

    in Integer -> Day -> Day
addDays Integer
zbYearDay Day
firstDay

fromSundayStartWeekValid :: Integer -- ^ Year.
                    -> Int     -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
                    -> Int     -- ^ Day of week.
                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
                    -> Maybe Day
fromSundayStartWeekValid :: Integer -> Int -> Int -> Maybe Day
fromSundayStartWeekValid Integer
year Int
w Int
d =  do
    Int
d' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
6 Int
d
    let
        -- first day of the year
        firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year Int
1

        -- 0-based week of year
        zbFirstSunday :: Integer
zbFirstSunday = (Integer
4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Day -> Integer
toModifiedJulianDay Day
firstDay) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
7

        -- 0-based week number
        zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

        -- 0-based day of week
        zbDay :: Int
zbDay = Int
d'

        -- 0-based day in year
        zbYearDay :: Integer
zbYearDay = Integer
zbFirstSunday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbWeek Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
zbDay

    Integer
zbYearDay' <- Integer -> Integer -> Integer -> Maybe Integer
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Integer
0 (if Integer -> Bool
isLeapYear Integer
year then Integer
365 else Integer
364) Integer
zbYearDay
    Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
zbYearDay' Day
firstDay