module Data.Time.Calendar.Julian
(
module Data.Time.Calendar.JulianYearDay,
toJulian,fromJulian,fromJulianValid,showJulian,julianMonthLength,
addJulianMonthsClip,addJulianMonthsRollOver,
addJulianYearsClip,addJulianYearsRollOver,
addJulianDurationClip,addJulianDurationRollOver,
diffJulianDurationClip,diffJulianDurationRollOver,
) where
import Data.Time.Calendar.MonthDay
import Data.Time.Calendar.JulianYearDay
import Data.Time.Calendar.Days
import Data.Time.Calendar.CalendarDiffDays
import Data.Time.Calendar.Private
toJulian :: Day -> (Integer,Int,Int)
toJulian :: Day -> (Integer, Int, Int)
toJulian date :: Day
date = (Integer
year,Int
month,Int
day) where
(year :: Integer
year,yd :: Int
yd) = Day -> (Integer, Int)
toJulianYearAndDay Day
date
(month :: Int
month,day :: Int
day) = Bool -> Int -> (Int, Int)
dayOfYearToMonthAndDay (Integer -> Bool
isJulianLeapYear Integer
year) Int
yd
fromJulian :: Integer -> Int -> Int -> Day
fromJulian :: Integer -> Int -> Int -> Day
fromJulian year :: Integer
year month :: Int
month day :: Int
day = Integer -> Int -> Day
fromJulianYearAndDay Integer
year (Bool -> Int -> Int -> Int
monthAndDayToDayOfYear (Integer -> Bool
isJulianLeapYear Integer
year) Int
month Int
day)
fromJulianValid :: Integer -> Int -> Int -> Maybe Day
fromJulianValid :: Integer -> Int -> Int -> Maybe Day
fromJulianValid year :: Integer
year month :: Int
month day :: Int
day = do
Int
doy <- Bool -> Int -> Int -> Maybe Int
monthAndDayToDayOfYearValid (Integer -> Bool
isJulianLeapYear Integer
year) Int
month Int
day
Integer -> Int -> Maybe Day
fromJulianYearAndDayValid Integer
year Int
doy
showJulian :: Day -> String
showJulian :: Day -> String
showJulian 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
show2 Int
m) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall t. ShowPadded t => t -> String
show2 Int
d) where
(y :: Integer
y,m :: Int
m,d :: Int
d) = Day -> (Integer, Int, Int)
toJulian Day
date
julianMonthLength :: Integer -> Int -> Int
julianMonthLength :: Integer -> Int -> Int
julianMonthLength year :: Integer
year = Bool -> Int -> Int
monthLength (Integer -> Bool
isJulianLeapYear Integer
year)
rolloverMonths :: (Integer,Integer) -> (Integer,Int)
rolloverMonths :: (Integer, Integer) -> (Integer, Int)
rolloverMonths (y :: Integer
y,m :: Integer
m) = (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1) 12),Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod (Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1) 12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
addJulianMonths :: Integer -> Day -> (Integer,Int,Int)
addJulianMonths :: Integer -> Day -> (Integer, Int, Int)
addJulianMonths n :: Integer
n day :: Day
day = (Integer
y',Int
m',Int
d) where
(y :: Integer
y,m :: Int
m,d :: Int
d) = Day -> (Integer, Int, Int)
toJulian Day
day
(y' :: Integer
y',m' :: Int
m') = (Integer, Integer) -> (Integer, Int)
rolloverMonths (Integer
y,Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n)
addJulianMonthsClip :: Integer -> Day -> Day
addJulianMonthsClip :: Integer -> Day -> Day
addJulianMonthsClip n :: Integer
n day :: Day
day = Integer -> Int -> Int -> Day
fromJulian Integer
y Int
m Int
d where
(y :: Integer
y,m :: Int
m,d :: Int
d) = Integer -> Day -> (Integer, Int, Int)
addJulianMonths Integer
n Day
day
addJulianMonthsRollOver :: Integer -> Day -> Day
addJulianMonthsRollOver :: Integer -> Day -> Day
addJulianMonthsRollOver n :: Integer
n day :: Day
day = Integer -> Day -> Day
addDays (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1) (Integer -> Int -> Int -> Day
fromJulian Integer
y Int
m 1) where
(y :: Integer
y,m :: Int
m,d :: Int
d) = Integer -> Day -> (Integer, Int, Int)
addJulianMonths Integer
n Day
day
addJulianYearsClip :: Integer -> Day -> Day
addJulianYearsClip :: Integer -> Day -> Day
addJulianYearsClip n :: Integer
n = Integer -> Day -> Day
addJulianMonthsClip (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 12)
addJulianYearsRollOver :: Integer -> Day -> Day
addJulianYearsRollOver :: Integer -> Day -> Day
addJulianYearsRollOver n :: Integer
n = Integer -> Day -> Day
addJulianMonthsRollOver (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 12)
addJulianDurationClip :: CalendarDiffDays -> Day -> Day
addJulianDurationClip :: CalendarDiffDays -> Day -> Day
addJulianDurationClip (CalendarDiffDays m :: Integer
m d :: Integer
d) day :: Day
day = Integer -> Day -> Day
addDays Integer
d (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addJulianMonthsClip Integer
m Day
day
addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
addJulianDurationRollOver (CalendarDiffDays m :: Integer
m d :: Integer
d) day :: Day
day = Integer -> Day -> Day
addDays Integer
d (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addJulianMonthsRollOver Integer
m Day
day
diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
diffJulianDurationClip day2 :: Day
day2 day1 :: Day
day1 = let
(y1 :: Integer
y1,m1 :: Int
m1,d1 :: Int
d1) = Day -> (Integer, Int, Int)
toJulian Day
day1
(y2 :: Integer
y2,m2 :: Int
m2,d2 :: Int
d2) = Day -> (Integer, Int, Int)
toJulian Day
day2
ym1 :: Integer
ym1 = Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m1
ym2 :: Integer
ym2 = Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m2
ymdiff :: Integer
ymdiff = Integer
ym2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ym1
ymAllowed :: Integer
ymAllowed =
if Day
day2 Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
day1 then
if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
else if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addJulianDurationClip (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed 0) Day
day1
in Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed (Integer -> CalendarDiffDays) -> Integer -> CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
day2 Day
dayAllowed
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver day2 :: Day
day2 day1 :: Day
day1 = let
(y1 :: Integer
y1,m1 :: Int
m1,d1 :: Int
d1) = Day -> (Integer, Int, Int)
toJulian Day
day1
(y2 :: Integer
y2,m2 :: Int
m2,d2 :: Int
d2) = Day -> (Integer, Int, Int)
toJulian Day
day2
ym1 :: Integer
ym1 = Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m1
ym2 :: Integer
ym2 = Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m2
ymdiff :: Integer
ymdiff = Integer
ym2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ym1
ymAllowed :: Integer
ymAllowed =
if Day
day2 Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
day1 then
if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
else if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addJulianDurationRollOver (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed 0) Day
day1
in Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed (Integer -> CalendarDiffDays) -> Integer -> CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
day2 Day
dayAllowed