{-# LANGUAGE Safe #-}
module Data.Time.Calendar.OrdinalDate (Day, Year, DayOfYear, WeekOfYear, module Data.Time.Calendar.OrdinalDate) where
import Data.Time.Calendar.Days
import Data.Time.Calendar.Private
import Data.Time.Calendar.Types
toOrdinalDate :: Day -> (Year, DayOfYear)
toOrdinalDate :: Day -> (Year, DayOfYear)
toOrdinalDate (ModifiedJulianDay Year
mjd) = (Year
year, DayOfYear
yd)
where
a :: Year
a = Year
mjd Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
678575
quadcent :: Year
quadcent = Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
a Year
146097
b :: Year
b = Year -> Year -> Year
forall a. Integral a => a -> a -> a
mod Year
a Year
146097
cent :: Year
cent = Year -> Year -> Year
forall a. Ord a => a -> a -> a
min (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
b Year
36524) Year
3
c :: Year
c = Year
b Year -> Year -> Year
forall a. Num a => a -> a -> a
- (Year
cent Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
36524)
quad :: Year
quad = Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
c Year
1461
d :: Year
d = Year -> Year -> Year
forall a. Integral a => a -> a -> a
mod Year
c Year
1461
y :: Year
y = Year -> Year -> Year
forall a. Ord a => a -> a -> a
min (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
d Year
365) Year
3
yd :: DayOfYear
yd = Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger (Year
d Year -> Year -> Year
forall a. Num a => a -> a -> a
- (Year
y Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
365) Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1)
year :: Year
year = Year
quadcent Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
400 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
cent Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
100 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
quad Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
4 Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
y Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
1
fromOrdinalDate :: Year -> DayOfYear -> Day
fromOrdinalDate :: Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
day = Year -> Day
ModifiedJulianDay Year
mjd
where
y :: Year
y = Year
year Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
1
mjd :: Year
mjd =
( DayOfYear -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral
( DayOfYear -> DayOfYear -> DayOfYear -> DayOfYear
forall t. Ord t => t -> t -> t -> t
clip
DayOfYear
1
( if Year -> Bool
isLeapYear Year
year
then DayOfYear
366
else DayOfYear
365
)
DayOfYear
day
)
)
Year -> Year -> Year
forall a. Num a => a -> a -> a
+ (Year
365 Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
y)
Year -> Year -> Year
forall a. Num a => a -> a -> a
+ (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
y Year
4)
Year -> Year -> Year
forall a. Num a => a -> a -> a
- (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
y Year
100)
Year -> Year -> Year
forall a. Num a => a -> a -> a
+ (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
y Year
400)
Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
678576
pattern YearDay :: Year -> DayOfYear -> Day
pattern $mYearDay :: forall {r}. Day -> (Year -> DayOfYear -> r) -> ((# #) -> r) -> r
$bYearDay :: Year -> DayOfYear -> Day
YearDay y d <-
(toOrdinalDate -> (y, d))
where
YearDay Year
y DayOfYear
d = Year -> DayOfYear -> Day
fromOrdinalDate Year
y DayOfYear
d
{-# COMPLETE YearDay #-}
fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day
fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day
fromOrdinalDateValid Year
year DayOfYear
day = do
DayOfYear
day' <-
DayOfYear -> DayOfYear -> DayOfYear -> Maybe DayOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid
DayOfYear
1
( if Year -> Bool
isLeapYear Year
year
then DayOfYear
366
else DayOfYear
365
)
DayOfYear
day
let y :: Year
y = Year
year Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
1
mjd :: Year
mjd = (DayOfYear -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral DayOfYear
day') Year -> Year -> Year
forall a. Num a => a -> a -> a
+ (Year
365 Year -> Year -> Year
forall a. Num a => a -> a -> a
* Year
y) Year -> Year -> Year
forall a. Num a => a -> a -> a
+ (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
y Year
4) Year -> Year -> Year
forall a. Num a => a -> a -> a
- (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
y Year
100) Year -> Year -> Year
forall a. Num a => a -> a -> a
+ (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
y Year
400) Year -> Year -> Year
forall a. Num a => a -> a -> a
- Year
678576
Day -> Maybe Day
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Year -> Day
ModifiedJulianDay Year
mjd)
showOrdinalDate :: Day -> String
showOrdinalDate :: Day -> String
showOrdinalDate Day
date = (Year -> String
forall t. ShowPadded t => t -> String
show4 Year
y) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (DayOfYear -> String
forall t. ShowPadded t => t -> String
show3 DayOfYear
d)
where
(Year
y, DayOfYear
d) = Day -> (Year, DayOfYear)
toOrdinalDate Day
date
isLeapYear :: Year -> Bool
isLeapYear :: Year -> Bool
isLeapYear Year
year = (Year -> Year -> Year
forall a. Integral a => a -> a -> a
mod Year
year Year
4 Year -> Year -> Bool
forall a. Eq a => a -> a -> Bool
== Year
0) Bool -> Bool -> Bool
&& ((Year -> Year -> Year
forall a. Integral a => a -> a -> a
mod Year
year Year
400 Year -> Year -> Bool
forall a. Eq a => a -> a -> Bool
== Year
0) Bool -> Bool -> Bool
|| Bool -> Bool
not (Year -> Year -> Year
forall a. Integral a => a -> a -> a
mod Year
year Year
100 Year -> Year -> Bool
forall a. Eq a => a -> a -> Bool
== Year
0))
mondayStartWeek :: Day -> (WeekOfYear, Int)
mondayStartWeek :: Day -> (DayOfYear, DayOfYear)
mondayStartWeek Day
date = (Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger ((Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
d Year
7) Year -> Year -> Year
forall a. Num a => a -> a -> a
- (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
k Year
7)), Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger (Year -> Year -> Year
forall a. Integral a => a -> a -> a
mod Year
d Year
7) DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
+ DayOfYear
1)
where
yd :: DayOfYear
yd = (Year, DayOfYear) -> DayOfYear
forall a b. (a, b) -> b
snd (Day -> (Year, DayOfYear)
toOrdinalDate Day
date)
d :: Year
d = (Day -> Year
toModifiedJulianDay Day
date) Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
2
k :: Year
k = Year
d Year -> Year -> Year
forall a. Num a => a -> a -> a
- (DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
yd)
sundayStartWeek :: Day -> (WeekOfYear, Int)
sundayStartWeek :: Day -> (DayOfYear, DayOfYear)
sundayStartWeek Day
date = (Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger ((Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
d Year
7) Year -> Year -> Year
forall a. Num a => a -> a -> a
- (Year -> Year -> Year
forall a. Integral a => a -> a -> a
div Year
k Year
7)), Year -> DayOfYear
forall a. Num a => Year -> a
fromInteger (Year -> Year -> Year
forall a. Integral a => a -> a -> a
mod Year
d Year
7))
where
yd :: DayOfYear
yd = (Year, DayOfYear) -> DayOfYear
forall a b. (a, b) -> b
snd (Day -> (Year, DayOfYear)
toOrdinalDate Day
date)
d :: Year
d = (Day -> Year
toModifiedJulianDay Day
date) Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
3
k :: Year
k = Year
d Year -> Year -> Year
forall a. Num a => a -> a -> a
- (DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
yd)
fromMondayStartWeek ::
Year ->
WeekOfYear ->
Int ->
Day
fromMondayStartWeek :: Year -> DayOfYear -> DayOfYear -> Day
fromMondayStartWeek Year
year DayOfYear
w DayOfYear
d =
let
firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
zbFirstMonday :: Year
zbFirstMonday = (Year
5 Year -> Year -> Year
forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) Year -> Year -> Year
forall a. Integral a => a -> a -> a
`mod` Year
7
zbWeek :: DayOfYear
zbWeek = DayOfYear
w DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
- DayOfYear
1
zbDay :: DayOfYear
zbDay = DayOfYear
d DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
- DayOfYear
1
zbYearDay :: Year
zbYearDay = Year
zbFirstMonday Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
7 Year -> Year -> Year
forall a. Num a => a -> a -> a
* DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek Year -> Year -> Year
forall a. Num a => a -> a -> a
+ DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
in Year -> Day -> Day
addDays Year
zbYearDay Day
firstDay
fromMondayStartWeekValid ::
Year ->
WeekOfYear ->
Int ->
Maybe Day
fromMondayStartWeekValid :: Year -> DayOfYear -> DayOfYear -> Maybe Day
fromMondayStartWeekValid Year
year DayOfYear
w DayOfYear
d = do
DayOfYear
d' <- DayOfYear -> DayOfYear -> DayOfYear -> Maybe DayOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid DayOfYear
1 DayOfYear
7 DayOfYear
d
let
firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
zbFirstMonday :: Year
zbFirstMonday = (Year
5 Year -> Year -> Year
forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) Year -> Year -> Year
forall a. Integral a => a -> a -> a
`mod` Year
7
zbWeek :: DayOfYear
zbWeek = DayOfYear
w DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
- DayOfYear
1
zbDay :: DayOfYear
zbDay = DayOfYear
d' DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
- DayOfYear
1
zbYearDay :: Year
zbYearDay = Year
zbFirstMonday Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
7 Year -> Year -> Year
forall a. Num a => a -> a -> a
* DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek Year -> Year -> Year
forall a. Num a => a -> a -> a
+ DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
Year
zbYearDay' <-
Year -> Year -> Year -> Maybe Year
forall t. Ord t => t -> t -> t -> Maybe t
clipValid
Year
0
( if Year -> Bool
isLeapYear Year
year
then Year
365
else Year
364
)
Year
zbYearDay
Day -> Maybe Day
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
zbYearDay' Day
firstDay
fromSundayStartWeek ::
Year ->
WeekOfYear ->
Int ->
Day
fromSundayStartWeek :: Year -> DayOfYear -> DayOfYear -> Day
fromSundayStartWeek Year
year DayOfYear
w DayOfYear
d =
let
firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
zbFirstSunday :: Year
zbFirstSunday = (Year
4 Year -> Year -> Year
forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) Year -> Year -> Year
forall a. Integral a => a -> a -> a
`mod` Year
7
zbWeek :: DayOfYear
zbWeek = DayOfYear
w DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
- DayOfYear
1
zbDay :: DayOfYear
zbDay = DayOfYear
d
zbYearDay :: Year
zbYearDay = Year
zbFirstSunday Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
7 Year -> Year -> Year
forall a. Num a => a -> a -> a
* DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek Year -> Year -> Year
forall a. Num a => a -> a -> a
+ DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
in Year -> Day -> Day
addDays Year
zbYearDay Day
firstDay
fromSundayStartWeekValid ::
Year ->
WeekOfYear ->
Int ->
Maybe Day
fromSundayStartWeekValid :: Year -> DayOfYear -> DayOfYear -> Maybe Day
fromSundayStartWeekValid Year
year DayOfYear
w DayOfYear
d = do
DayOfYear
d' <- DayOfYear -> DayOfYear -> DayOfYear -> Maybe DayOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid DayOfYear
0 DayOfYear
6 DayOfYear
d
let
firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
zbFirstSunday :: Year
zbFirstSunday = (Year
4 Year -> Year -> Year
forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) Year -> Year -> Year
forall a. Integral a => a -> a -> a
`mod` Year
7
zbWeek :: DayOfYear
zbWeek = DayOfYear
w DayOfYear -> DayOfYear -> DayOfYear
forall a. Num a => a -> a -> a
- DayOfYear
1
zbDay :: DayOfYear
zbDay = DayOfYear
d'
zbYearDay :: Year
zbYearDay = Year
zbFirstSunday Year -> Year -> Year
forall a. Num a => a -> a -> a
+ Year
7 Year -> Year -> Year
forall a. Num a => a -> a -> a
* DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek Year -> Year -> Year
forall a. Num a => a -> a -> a
+ DayOfYear -> Year
forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
Year
zbYearDay' <-
Year -> Year -> Year -> Maybe Year
forall t. Ord t => t -> t -> t -> Maybe t
clipValid
Year
0
( if Year -> Bool
isLeapYear Year
year
then Year
365
else Year
364
)
Year
zbYearDay
Day -> Maybe Day
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
zbYearDay' Day
firstDay