    {-# LANGUAGE Safe #-}

    module Data.Time.Calendar.Julian (
        Year,
        MonthOfYear,
        pattern January,
        pattern February,
        pattern March,
        pattern April,
        pattern May,
        pattern June,
        pattern July,
        pattern August,
        pattern September,
        pattern October,
        pattern November,
        pattern December,
        DayOfMonth,
        DayOfYear,
        module Data.Time.Calendar.JulianYearDay,
        toJulian,
        fromJulian,
        pattern JulianYearMonthDay,
        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.CalendarDiffDays
    import Data.Time.Calendar.Days
    import Data.Time.Calendar.JulianYearDay
    import Data.Time.Calendar.MonthDay
    import Data.Time.Calendar.Private
    import Data.Time.Calendar.Types

    -- | Convert to proleptic Julian calendar.
    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

    -- | Convert from proleptic Julian calendar.
    -- Invalid values will be clipped to the correct range, month first, then day.
    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)

    -- | Bidirectional abstract constructor for the proleptic Julian calendar.
    -- Invalid values will be clipped to the correct range, month first, then 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

    {-# COMPLETE JulianYearMonthDay #-}

    -- | Convert from proleptic Julian calendar.
    -- Invalid values will return Nothing.
    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

    -- | Show in ISO 8601 format (yyyy-mm-dd)
    showJulian :: Day -> String
    showJulian :: Day -> String
    showJulian 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]
    ++ (MonthOfYear -> String
    forall t. ShowPadded t => t -> String
    show2 MonthOfYear
    m) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (MonthOfYear -> String
    forall t. ShowPadded t => t -> String
    show2 MonthOfYear
    d)
      where
        (Year
    y, MonthOfYear
    m, MonthOfYear
    d) = Day -> (Year, MonthOfYear, MonthOfYear)
    toJulian Day
    date

    -- | The number of days in a given month according to the proleptic Julian calendar.
    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 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + (Year -> Year -> Year
    forall a. Integral a => a -> a -> a
    div (Year
    m Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1) Year
    12), Year -> MonthOfYear
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Year -> Year -> Year
    forall a. Integral a => a -> a -> a
    mod (Year
    m Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1) Year
    12) MonthOfYear -> MonthOfYear -> MonthOfYear
    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, MonthOfYear -> Year
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral MonthOfYear
    m Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + Year
    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 :: 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

    -- | 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 :: Year -> Day -> Day
    addJulianMonthsRollOver Year
    n Day
    day = Year -> Day -> Day
    addDays (MonthOfYear -> Year
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral MonthOfYear
    d Year -> Year -> Year
    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

    -- | 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 :: Year -> Day -> Day
    addJulianYearsClip Year
    n = Year -> Day -> Day
    addJulianMonthsClip (Year
    n Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    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 :: Year -> Day -> Day
    addJulianYearsRollOver Year
    n = Year -> Day -> Day
    addJulianMonthsRollOver (Year
    n Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12)

    -- | Add months (clipped to last day), then add days
    addJulianDurationClip :: CalendarDiffDays -> Day -> Day
    addJulianDurationClip :: CalendarDiffDays -> Day -> Day
    addJulianDurationClip (CalendarDiffDays Year
    m Year
    d) Day
    day = Year -> Day -> Day
    addDays Year
    d (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Year -> Day -> Day
    addJulianMonthsClip Year
    m Day
    day

    -- | Add months (rolling over to next month), then add days
    addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
    addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
    addJulianDurationRollOver (CalendarDiffDays Year
    m Year
    d) Day
    day = Year -> Day -> Day
    addDays Year
    d (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Year -> Day -> Day
    addJulianMonthsRollOver Year
    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
        (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 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m1
        ym2 :: Year
    ym2 = Year
    y2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m2
        ymdiff :: Year
    ymdiff = Year
    ym2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    ym1
        ymAllowed :: Year
    ymAllowed =
            if Day
    day2 Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Day
    day1
                then
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    >= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1
                else
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    <= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    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 (Year -> CalendarDiffDays) -> Year -> CalendarDiffDays
    forall a b. (a -> b) -> a -> b
    $ Day -> Day -> Year
    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
        (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 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m1
        ym2 :: Year
    ym2 = Year
    y2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m2
        ymdiff :: Year
    ymdiff = Year
    ym2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    ym1
        ymAllowed :: Year
    ymAllowed =
            if Day
    day2 Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Day
    day1
                then
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    >= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1
                else
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    <= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    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 (Year -> CalendarDiffDays) -> Year -> CalendarDiffDays
    forall a b. (a -> b) -> a -> b
    $ Day -> Day -> Year
    diffDays Day
    day2 Day
    dayAllowed