```-- | 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 -> 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 -> 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
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
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
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