#include "thyme.h"
module Data.Thyme.Calendar.Julian
( OrdinalDate (..), Year, DayOfYear
, module Data.Thyme.Calendar.Julian
, _odYear, _odDay
) where
import Prelude
import Control.Applicative
import Control.Monad
import Control.Lens
import Data.Thyme.Calendar
import Data.Thyme.Calendar.Internal
import Data.Thyme.Calendar.OrdinalDate
julianOrdinal :: Iso' Day OrdinalDate
julianOrdinal = iso toOrdinal fromOrdinal where
toOrdinal :: Day -> OrdinalDate
toOrdinal (ModifiedJulianDay mjd) = OrdinalDate {..} where
(quad, d) = divMod (mjd + 678577) 1461
yoff = min (div d 365) 3
odDay = d (yoff * 365) + 1
odYear = quad * 4 + yoff + 1
fromOrdinal :: OrdinalDate -> Day
fromOrdinal OrdinalDate {..} = ModifiedJulianDay mjd where
yd = clip 1 (if isJulianLeapYear odYear then 366 else 365) odDay
clip a b = max a . min b
y = odYear 1
mjd = yd + 365 * y + div y 4 678578
julianOrdinalValid :: OrdinalDate -> Maybe Day
julianOrdinalValid OrdinalDate {..} = ModifiedJulianDay mjd
<$ guard (1 <= odDay && odDay <= lastDay) where
lastDay = if isJulianLeapYear odYear then 366 else 365
y = odYear 1
mjd = odDay + 365 * y + div y 4 678578
isJulianLeapYear :: Year -> Bool
isJulianLeapYear y = mod y 4 == 0
julianYearMonthDay :: Iso' OrdinalDate YearMonthDay
julianYearMonthDay = iso fromOrdinal toOrdinal where
fromOrdinal :: OrdinalDate -> YearMonthDay
fromOrdinal OrdinalDate {..} = YearMonthDay odYear m d where
MonthDay m d = odDay ^. monthDay (isJulianLeapYear odYear)
toOrdinal :: YearMonthDay -> OrdinalDate
toOrdinal YearMonthDay {..} = OrdinalDate ymdYear yd where
yd = monthDay (isJulianLeapYear ymdYear) # MonthDay ymdMonth ymdDay
julianYearMonthDayValid :: YearMonthDay -> Maybe OrdinalDate
julianYearMonthDayValid YearMonthDay {..} = OrdinalDate ymdYear
<$> monthDayValid (isJulianLeapYear ymdYear) (MonthDay ymdMonth ymdDay)
julian :: Iso' Day YearMonthDay
julian = julianOrdinal . julianYearMonthDay
julianValid :: YearMonthDay -> Maybe Day
julianValid ymd = review julianOrdinal <$> julianYearMonthDayValid ymd