module Data.Time.Calendar.Julian
(
    module Data.Time.Calendar.JulianYearDay,

    toJulian,fromJulian,fromJulianValid,showJulian,julianMonthLength,

    -- calendrical arithmetic
    -- e.g. "one month after March 31st"
    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

-- | Convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31).
toJulian :: Day -> (Integer,Int,Int)
toJulian :: Day -> (Integer, Int, Int)
toJulian Day
date = (Integer
year,Int
month,Int
day) where
    (Integer
year,Int
yd) = Day -> (Integer, Int)
toJulianYearAndDay Day
date
    (Int
month,Int
day) = Bool -> Int -> (Int, Int)
dayOfYearToMonthAndDay (Integer -> Bool
isJulianLeapYear Integer
year) Int
yd

-- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).
-- Invalid values will be clipped to the correct range, month first, then day.
fromJulian :: Integer -> Int -> Int -> Day
fromJulian :: Integer -> Int -> Int -> Day
fromJulian Integer
year Int
month Int
day = Integer -> Int -> Day
fromJulianYearAndDay Integer
year (Bool -> Int -> Int -> Int
monthAndDayToDayOfYear (Integer -> Bool
isJulianLeapYear Integer
year) Int
month Int
day)

-- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).
-- Invalid values will return Nothing.
fromJulianValid :: Integer -> Int -> Int -> Maybe Day
fromJulianValid :: Integer -> Int -> Int -> Maybe Day
fromJulianValid Integer
year Int
month 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

-- | Show in ISO 8601 format (yyyy-mm-dd)
showJulian :: Day -> String
showJulian :: Day -> String
showJulian 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
show2 Int
m) 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
show2 Int
d) where
    (Integer
y,Int
m,Int
d) = Day -> (Integer, Int, Int)
toJulian Day
date

-- | The number of days in a given month according to the proleptic Julian calendar. First argument is year, second is month.
julianMonthLength :: Integer -> Int -> Int
julianMonthLength :: Integer -> Int -> Int
julianMonthLength Integer
year = Bool -> Int -> Int
monthLength (Integer -> Bool
isJulianLeapYear Integer
year)

rolloverMonths :: (Integer,Integer) -> (Integer,Int)
rolloverMonths :: (Integer, Integer) -> (Integer, Int)
rolloverMonths (Integer
y,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
- Integer
1) Integer
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
- Integer
1) Integer
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

addJulianMonths :: Integer -> Day -> (Integer,Int,Int)
addJulianMonths :: Integer -> Day -> (Integer, Int, Int)
addJulianMonths Integer
n Day
day = (Integer
y',Int
m',Int
d) where
    (Integer
y,Int
m,Int
d) = Day -> (Integer, Int, Int)
toJulian Day
day
    (Integer
y',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)

-- | Add months, with days past the last day of the month clipped to the last day.
-- For instance, 2005-01-30 + 1 month = 2005-02-28.
addJulianMonthsClip :: Integer -> Day -> Day
addJulianMonthsClip :: Integer -> Day -> Day
addJulianMonthsClip Integer
n Day
day = Integer -> Int -> Int -> Day
fromJulian Integer
y Int
m Int
d where
    (Integer
y,Int
m,Int
d) = Integer -> Day -> (Integer, Int, Int)
addJulianMonths Integer
n Day
day

-- | Add months, with days past the last day of the month rolling over to the next month.
-- For instance, 2005-01-30 + 1 month = 2005-03-02.
addJulianMonthsRollOver :: Integer -> Day -> Day
addJulianMonthsRollOver :: Integer -> Day -> Day
addJulianMonthsRollOver Integer
n 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
- Integer
1) (Integer -> Int -> Int -> Day
fromJulian Integer
y Int
m Int
1) where
    (Integer
y,Int
m,Int
d) = Integer -> Day -> (Integer, Int, Int)
addJulianMonths Integer
n Day
day

-- | Add years, matching month and day, with Feb 29th clipped to Feb 28th if necessary.
-- For instance, 2004-02-29 + 2 years = 2006-02-28.
addJulianYearsClip :: Integer -> Day -> Day
addJulianYearsClip :: Integer -> Day -> Day
addJulianYearsClip Integer
n = Integer -> Day -> Day
addJulianMonthsClip (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12)

-- | Add years, matching month and day, with Feb 29th rolled over to Mar 1st if necessary.
-- For instance, 2004-02-29 + 2 years = 2006-03-01.
addJulianYearsRollOver :: Integer -> Day -> Day
addJulianYearsRollOver :: Integer -> Day -> Day
addJulianYearsRollOver Integer
n = Integer -> Day -> Day
addJulianMonthsRollOver (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12)

-- | Add months (clipped to last day), then add days
addJulianDurationClip :: CalendarDiffDays -> Day -> Day
addJulianDurationClip :: CalendarDiffDays -> Day -> Day
addJulianDurationClip (CalendarDiffDays Integer
m Integer
d) 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

-- | Add months (rolling over to next month), then add days
addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
addJulianDurationRollOver (CalendarDiffDays Integer
m Integer
d) 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

-- | Calendrical difference, with as many whole months as possible
diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
diffJulianDurationClip Day
day2 Day
day1 = let
    (Integer
y1,Int
m1,Int
d1) = Day -> (Integer, Int, Int)
toJulian Day
day1
    (Integer
y2,Int
m2,Int
d2) = Day -> (Integer, Int, Int)
toJulian Day
day2
    ym1 :: Integer
ym1 = Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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
* Integer
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
- Integer
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
+ Integer
1
    dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addJulianDurationClip (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed Integer
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

-- | Calendrical difference, with as many whole months as possible.
-- Same as 'diffJulianDurationClip' for positive durations.
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver Day
day2 Day
day1 = let
    (Integer
y1,Int
m1,Int
d1) = Day -> (Integer, Int, Int)
toJulian Day
day1
    (Integer
y2,Int
m2,Int
d2) = Day -> (Integer, Int, Int)
toJulian Day
day2
    ym1 :: Integer
ym1 = Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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
* Integer
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
- Integer
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
+ Integer
1
    dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addJulianDurationRollOver (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed Integer
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