{-# LANGUAGE Safe #-}
module Data.Time.Calendar.Julian
( Year
, MonthOfYear
, DayOfMonth
, DayOfYear
, module Data.Time.Calendar.JulianYearDay
, toJulian
, fromJulian
, pattern JulianYearMonthDay
, fromJulianValid
, showJulian
, julianMonthLength
, addJulianMonthsClip
, addJulianMonthsRollOver
, addJulianYearsClip
, addJulianYearsRollOver
, addJulianDurationClip
, addJulianDurationRollOver
, diffJulianDurationClip
, diffJulianDurationRollOver
) where
import Data.Time.Calendar.Types
import Data.Time.Calendar.CalendarDiffDays
import Data.Time.Calendar.Days
import Data.Time.Calendar.JulianYearDay
import Data.Time.Calendar.MonthDay
import Data.Time.Calendar.Private
toJulian :: Day -> (Year, MonthOfYear, DayOfMonth)
toJulian :: Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
date = (Year
year, MonthOfYear
month, MonthOfYear
day)
where
(Year
year, MonthOfYear
yd) = Day -> (Year, MonthOfYear)
toJulianYearAndDay Day
date
(MonthOfYear
month, MonthOfYear
day) = Bool -> MonthOfYear -> (MonthOfYear, MonthOfYear)
dayOfYearToMonthAndDay (Year -> Bool
isJulianLeapYear Year
year) MonthOfYear
yd
fromJulian :: Year -> MonthOfYear -> DayOfMonth -> Day
fromJulian :: Year -> MonthOfYear -> MonthOfYear -> Day
fromJulian Year
year MonthOfYear
month MonthOfYear
day = Year -> MonthOfYear -> Day
fromJulianYearAndDay Year
year (Bool -> MonthOfYear -> MonthOfYear -> MonthOfYear
monthAndDayToDayOfYear (Year -> Bool
isJulianLeapYear Year
year) MonthOfYear
month MonthOfYear
day)
pattern JulianYearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day
pattern $mJulianYearMonthDay :: forall {r}.
Day
-> (Year -> MonthOfYear -> MonthOfYear -> r) -> ((# #) -> r) -> r
$bJulianYearMonthDay :: Year -> MonthOfYear -> MonthOfYear -> Day
JulianYearMonthDay y m d <- (toJulian -> (y,m,d)) where
JulianYearMonthDay Year
y MonthOfYear
m MonthOfYear
d = Year -> MonthOfYear -> MonthOfYear -> Day
fromJulian Year
y MonthOfYear
m MonthOfYear
d
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE JulianYearMonthDay #-}
#endif
fromJulianValid :: Year -> MonthOfYear -> DayOfMonth -> Maybe Day
fromJulianValid :: Year -> MonthOfYear -> MonthOfYear -> Maybe Day
fromJulianValid Year
year MonthOfYear
month MonthOfYear
day = do
MonthOfYear
doy <- Bool -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
monthAndDayToDayOfYearValid (Year -> Bool
isJulianLeapYear Year
year) MonthOfYear
month MonthOfYear
day
Year -> MonthOfYear -> Maybe Day
fromJulianYearAndDayValid Year
year MonthOfYear
doy
showJulian :: Day -> String
showJulian :: Day -> String
showJulian Day
date = (forall t. ShowPadded t => t -> String
show4 Year
y) forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ (forall t. ShowPadded t => t -> String
show2 MonthOfYear
m) forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ (forall t. ShowPadded t => t -> String
show2 MonthOfYear
d)
where
(Year
y, MonthOfYear
m, MonthOfYear
d) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
date
julianMonthLength :: Year -> MonthOfYear -> DayOfMonth
julianMonthLength :: Year -> MonthOfYear -> MonthOfYear
julianMonthLength Year
year = Bool -> MonthOfYear -> MonthOfYear
monthLength (Year -> Bool
isJulianLeapYear Year
year)
rolloverMonths :: (Year, Integer) -> (Year, MonthOfYear)
rolloverMonths :: (Year, Year) -> (Year, MonthOfYear)
rolloverMonths (Year
y, Year
m) = (Year
y forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
div (Year
m forall a. Num a => a -> a -> a
- Year
1) Year
12), forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Integral a => a -> a -> a
mod (Year
m forall a. Num a => a -> a -> a
- Year
1) Year
12) forall a. Num a => a -> a -> a
+ MonthOfYear
1)
addJulianMonths :: Integer -> Day -> (Year, MonthOfYear, DayOfMonth)
addJulianMonths :: Year -> Day -> (Year, MonthOfYear, MonthOfYear)
addJulianMonths Year
n Day
day = (Year
y', MonthOfYear
m', MonthOfYear
d)
where
(Year
y, MonthOfYear
m, MonthOfYear
d) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
day
(Year
y', MonthOfYear
m') = (Year, Year) -> (Year, MonthOfYear)
rolloverMonths (Year
y, forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
m forall a. Num a => a -> a -> a
+ Year
n)
addJulianMonthsClip :: Integer -> Day -> Day
addJulianMonthsClip :: Year -> Day -> Day
addJulianMonthsClip Year
n Day
day = Year -> MonthOfYear -> MonthOfYear -> Day
fromJulian Year
y MonthOfYear
m MonthOfYear
d
where
(Year
y, MonthOfYear
m, MonthOfYear
d) = Year -> Day -> (Year, MonthOfYear, MonthOfYear)
addJulianMonths Year
n Day
day
addJulianMonthsRollOver :: Integer -> Day -> Day
addJulianMonthsRollOver :: Year -> Day -> Day
addJulianMonthsRollOver Year
n Day
day = Year -> Day -> Day
addDays (forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
d forall a. Num a => a -> a -> a
- Year
1) (Year -> MonthOfYear -> MonthOfYear -> Day
fromJulian Year
y MonthOfYear
m MonthOfYear
1)
where
(Year
y, MonthOfYear
m, MonthOfYear
d) = Year -> Day -> (Year, MonthOfYear, MonthOfYear)
addJulianMonths Year
n Day
day
addJulianYearsClip :: Integer -> Day -> Day
addJulianYearsClip :: Year -> Day -> Day
addJulianYearsClip Year
n = Year -> Day -> Day
addJulianMonthsClip (Year
n forall a. Num a => a -> a -> a
* Year
12)
addJulianYearsRollOver :: Integer -> Day -> Day
addJulianYearsRollOver :: Year -> Day -> Day
addJulianYearsRollOver Year
n = Year -> Day -> Day
addJulianMonthsRollOver (Year
n forall a. Num a => a -> a -> a
* Year
12)
addJulianDurationClip :: CalendarDiffDays -> Day -> Day
addJulianDurationClip :: CalendarDiffDays -> Day -> Day
addJulianDurationClip (CalendarDiffDays Year
m Year
d) Day
day = Year -> Day -> Day
addDays Year
d forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addJulianMonthsClip Year
m Day
day
addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
addJulianDurationRollOver (CalendarDiffDays Year
m Year
d) Day
day = Year -> Day -> Day
addDays Year
d forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addJulianMonthsRollOver Year
m Day
day
diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
diffJulianDurationClip Day
day2 Day
day1 = let
(Year
y1, MonthOfYear
m1, MonthOfYear
d1) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
day1
(Year
y2, MonthOfYear
m2, MonthOfYear
d2) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
day2
ym1 :: Year
ym1 = Year
y1 forall a. Num a => a -> a -> a
* Year
12 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger MonthOfYear
m1
ym2 :: Year
ym2 = Year
y2 forall a. Num a => a -> a -> a
* Year
12 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger MonthOfYear
m2
ymdiff :: Year
ymdiff = Year
ym2 forall a. Num a => a -> a -> a
- Year
ym1
ymAllowed :: Year
ymAllowed =
if Day
day2 forall a. Ord a => a -> a -> Bool
>= Day
day1
then if MonthOfYear
d2 forall a. Ord a => a -> a -> Bool
>= MonthOfYear
d1
then Year
ymdiff
else Year
ymdiff forall a. Num a => a -> a -> a
- Year
1
else if MonthOfYear
d2 forall a. Ord a => a -> a -> Bool
<= MonthOfYear
d1
then Year
ymdiff
else Year
ymdiff forall a. Num a => a -> a -> a
+ Year
1
dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addJulianDurationClip (Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
ymAllowed Year
0) Day
day1
in Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
ymAllowed forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
day2 Day
dayAllowed
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver Day
day2 Day
day1 = let
(Year
y1, MonthOfYear
m1, MonthOfYear
d1) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
day1
(Year
y2, MonthOfYear
m2, MonthOfYear
d2) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
day2
ym1 :: Year
ym1 = Year
y1 forall a. Num a => a -> a -> a
* Year
12 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger MonthOfYear
m1
ym2 :: Year
ym2 = Year
y2 forall a. Num a => a -> a -> a
* Year
12 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger MonthOfYear
m2
ymdiff :: Year
ymdiff = Year
ym2 forall a. Num a => a -> a -> a
- Year
ym1
ymAllowed :: Year
ymAllowed =
if Day
day2 forall a. Ord a => a -> a -> Bool
>= Day
day1
then if MonthOfYear
d2 forall a. Ord a => a -> a -> Bool
>= MonthOfYear
d1
then Year
ymdiff
else Year
ymdiff forall a. Num a => a -> a -> a
- Year
1
else if MonthOfYear
d2 forall a. Ord a => a -> a -> Bool
<= MonthOfYear
d1
then Year
ymdiff
else Year
ymdiff forall a. Num a => a -> a -> a
+ Year
1
dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addJulianDurationRollOver (Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
ymAllowed Year
0) Day
day1
in Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
ymAllowed forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
day2 Day
dayAllowed