module Data.Time.Calendar.OrdinalDate where
import Data.Time.Calendar.Days
import Data.Time.Calendar.Private
toOrdinalDate :: Day -> (Integer,Int)
toOrdinalDate :: Day -> (Integer, Int)
toOrdinalDate (ModifiedJulianDay mjd :: Integer
mjd) = (Integer
year,Int
yd) where
a :: Integer
a = Integer
mjd Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 678575
quadcent :: Integer
quadcent = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
a 146097
b :: Integer
b = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
a 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 36524) 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
* 36524)
quad :: Integer
quad = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
c 1461
d :: Integer
d = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
c 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 365) 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
* 365) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1)
year :: Integer
year = Integer
quadcent Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 400 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
cent Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
quad Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
fromOrdinalDate :: Integer -> Int -> Day
fromOrdinalDate :: Integer -> Int -> Day
fromOrdinalDate year :: Integer
year day :: Int
day = Integer -> Day
ModifiedJulianDay Integer
mjd where
y :: Integer
y = Integer
year Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 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 1 (if Integer -> Bool
isLeapYear Integer
year then 366 else 365) Int
day)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (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 4) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y 100) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y 400) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 678576
fromOrdinalDateValid :: Integer -> Int -> Maybe Day
fromOrdinalDateValid :: Integer -> Int -> Maybe Day
fromOrdinalDateValid year :: Integer
year day :: Int
day = do
Int
day' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid 1 (if Integer -> Bool
isLeapYear Integer
year then 366 else 365) Int
day
let
y :: Integer
y = Integer
year Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 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
+ (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 4) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y 100) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
y 400) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 678576
Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Day
ModifiedJulianDay Integer
mjd)
showOrdinalDate :: Day -> String
showOrdinalDate :: Day -> String
showOrdinalDate date :: Day
date = (Integer -> String
forall t. ShowPadded t => t -> String
show4 Integer
y) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall t. ShowPadded t => t -> String
show3 Int
d) where
(y :: Integer
y,d :: Int
d) = Day -> (Integer, Int)
toOrdinalDate Day
date
isLeapYear :: Integer -> Bool
isLeapYear :: Integer -> Bool
isLeapYear year :: Integer
year = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
year 4 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0) Bool -> Bool -> Bool
&& ((Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
year 400 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0) Bool -> Bool -> Bool
|| Bool -> Bool
not (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
year 100 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0))
mondayStartWeek :: Day -> (Int,Int)
mondayStartWeek :: Day -> (Int, Int)
mondayStartWeek date :: Day
date = (Integer -> Int
forall a. Num a => Integer -> a
fromInteger ((Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
d 7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
k 7)),Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
d 7) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
+ 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)
sundayStartWeek :: Day -> (Int,Int)
sundayStartWeek :: Day -> (Int, Int)
sundayStartWeek date :: Day
date =(Integer -> Int
forall a. Num a => Integer -> a
fromInteger ((Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
d 7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
k 7)),Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
d 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
+ 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)
fromMondayStartWeek :: Integer
-> Int
-> Int
-> Day
fromMondayStartWeek :: Integer -> Int -> Int -> Day
fromMondayStartWeek year :: Integer
year w :: Int
w d :: Int
d = let
firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year 1
zbFirstMonday :: Integer
zbFirstMonday = (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` 7
zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
zbDay :: Int
zbDay = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
zbYearDay :: Integer
zbYearDay = Integer
zbFirstMonday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 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
-> Int
-> Int
-> Maybe Day
fromMondayStartWeekValid :: Integer -> Int -> Int -> Maybe Day
fromMondayStartWeekValid year :: Integer
year w :: Int
w d :: Int
d = do
Int
d' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid 1 7 Int
d
let
firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year 1
zbFirstMonday :: Integer
zbFirstMonday = (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` 7
zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
zbDay :: Int
zbDay = Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
zbYearDay :: Integer
zbYearDay = Integer
zbFirstMonday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 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 0 (if Integer -> Bool
isLeapYear Integer
year then 365 else 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
fromSundayStartWeek :: Integer
-> Int
-> Int
-> Day
fromSundayStartWeek :: Integer -> Int -> Int -> Day
fromSundayStartWeek year :: Integer
year w :: Int
w d :: Int
d = let
firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year 1
zbFirstSunday :: Integer
zbFirstSunday = (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` 7
zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
zbDay :: Int
zbDay = Int
d
zbYearDay :: Integer
zbYearDay = Integer
zbFirstSunday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 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
-> Int
-> Int
-> Maybe Day
fromSundayStartWeekValid :: Integer -> Int -> Int -> Maybe Day
fromSundayStartWeekValid year :: Integer
year w :: Int
w d :: Int
d = do
Int
d' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid 0 6 Int
d
let
firstDay :: Day
firstDay = Integer -> Int -> Day
fromOrdinalDate Integer
year 1
zbFirstSunday :: Integer
zbFirstSunday = (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` 7
zbWeek :: Int
zbWeek = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
zbDay :: Int
zbDay = Int
d'
zbYearDay :: Integer
zbYearDay = Integer
zbFirstSunday Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 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 0 (if Integer -> Bool
isLeapYear Integer
year then 365 else 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