{-# LANGUAGE Safe #-}

-- | ISO 8601 Ordinal Date format
module Data.Time.Calendar.OrdinalDate (Day, Year, DayOfYear, WeekOfYear, module Data.Time.Calendar.OrdinalDate) where

import Data.Time.Calendar.Types
import Data.Time.Calendar.Days
import Data.Time.Calendar.Private

-- | Convert to ISO 8601 Ordinal Date format.
toOrdinalDate :: Day -> (Year, DayOfYear)
toOrdinalDate :: Day -> (Year, DayOfYear)
toOrdinalDate (ModifiedJulianDay Year
mjd) = (Year
year, DayOfYear
yd)
  where
    a :: Year
a = Year
mjd forall a. Num a => a -> a -> a
+ Year
678575
    quadcent :: Year
quadcent = forall a. Integral a => a -> a -> a
div Year
a Year
146097
    b :: Year
b = forall a. Integral a => a -> a -> a
mod Year
a Year
146097
    cent :: Year
cent = forall a. Ord a => a -> a -> a
min (forall a. Integral a => a -> a -> a
div Year
b Year
36524) Year
3
    c :: Year
c = Year
b forall a. Num a => a -> a -> a
- (Year
cent forall a. Num a => a -> a -> a
* Year
36524)
    quad :: Year
quad = forall a. Integral a => a -> a -> a
div Year
c Year
1461
    d :: Year
d = forall a. Integral a => a -> a -> a
mod Year
c Year
1461
    y :: Year
y = forall a. Ord a => a -> a -> a
min (forall a. Integral a => a -> a -> a
div Year
d Year
365) Year
3
    yd :: DayOfYear
yd = forall a. Num a => Year -> a
fromInteger (Year
d forall a. Num a => a -> a -> a
- (Year
y forall a. Num a => a -> a -> a
* Year
365) forall a. Num a => a -> a -> a
+ Year
1)
    year :: Year
year = Year
quadcent forall a. Num a => a -> a -> a
* Year
400 forall a. Num a => a -> a -> a
+ Year
cent forall a. Num a => a -> a -> a
* Year
100 forall a. Num a => a -> a -> a
+ Year
quad forall a. Num a => a -> a -> a
* Year
4 forall a. Num a => a -> a -> a
+ Year
y forall a. Num a => a -> a -> a
+ Year
1

-- | Convert from ISO 8601 Ordinal Date format.
-- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).
fromOrdinalDate :: Year -> DayOfYear -> Day
fromOrdinalDate :: Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
day = Year -> Day
ModifiedJulianDay Year
mjd
  where
    y :: Year
y = Year
year forall a. Num a => a -> a -> a
- Year
1
    mjd :: Year
mjd =
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral
             (forall t. Ord t => t -> t -> t -> t
clip
                  DayOfYear
1
                  (if Year -> Bool
isLeapYear Year
year
                       then DayOfYear
366
                       else DayOfYear
365)
                  DayOfYear
day)) forall a. Num a => a -> a -> a
+
        (Year
365 forall a. Num a => a -> a -> a
* Year
y) forall a. Num a => a -> a -> a
+
        (forall a. Integral a => a -> a -> a
div Year
y Year
4) forall a. Num a => a -> a -> a
-
        (forall a. Integral a => a -> a -> a
div Year
y Year
100) forall a. Num a => a -> a -> a
+
        (forall a. Integral a => a -> a -> a
div Year
y Year
400) forall a. Num a => a -> a -> a
-
        Year
678576

-- | Bidirectional abstract constructor for ISO 8601 Ordinal Date format.
-- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).
pattern YearDay :: Year -> DayOfYear -> Day
pattern $mYearDay :: forall {r}. Day -> (Year -> DayOfYear -> r) -> ((# #) -> r) -> r
$bYearDay :: Year -> DayOfYear -> Day
YearDay y d <- (toOrdinalDate -> (y,d)) where
    YearDay Year
y DayOfYear
d = Year -> DayOfYear -> Day
fromOrdinalDate Year
y DayOfYear
d

#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE YearDay #-}
#endif

-- | Convert from ISO 8601 Ordinal Date format.
-- Invalid day numbers return 'Nothing'
fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day
fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day
fromOrdinalDateValid Year
year DayOfYear
day = do
    DayOfYear
day' <-
        forall t. Ord t => t -> t -> t -> Maybe t
clipValid
            DayOfYear
1
            (if Year -> Bool
isLeapYear Year
year
                 then DayOfYear
366
                 else DayOfYear
365)
            DayOfYear
day
    let
        y :: Year
y = Year
year forall a. Num a => a -> a -> a
- Year
1
        mjd :: Year
mjd = (forall a b. (Integral a, Num b) => a -> b
fromIntegral DayOfYear
day') forall a. Num a => a -> a -> a
+ (Year
365 forall a. Num a => a -> a -> a
* Year
y) forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
div Year
y Year
4) forall a. Num a => a -> a -> a
- (forall a. Integral a => a -> a -> a
div Year
y Year
100) forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
div Year
y Year
400) forall a. Num a => a -> a -> a
- Year
678576
    forall (m :: * -> *) a. Monad m => a -> m a
return (Year -> Day
ModifiedJulianDay Year
mjd)

-- | Show in ISO 8601 Ordinal Date format (yyyy-ddd)
showOrdinalDate :: Day -> String
showOrdinalDate :: Day -> String
showOrdinalDate 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
show3 DayOfYear
d)
  where
    (Year
y, DayOfYear
d) = Day -> (Year, DayOfYear)
toOrdinalDate Day
date

-- | Is this year a leap year according to the proleptic Gregorian calendar?
isLeapYear :: Year -> Bool
isLeapYear :: Year -> Bool
isLeapYear Year
year = (forall a. Integral a => a -> a -> a
mod Year
year Year
4 forall a. Eq a => a -> a -> Bool
== Year
0) Bool -> Bool -> Bool
&& ((forall a. Integral a => a -> a -> a
mod Year
year Year
400 forall a. Eq a => a -> a -> Bool
== Year
0) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Integral a => a -> a -> a
mod Year
year Year
100 forall a. Eq a => a -> a -> Bool
== Year
0))

-- | Get the number of the Monday-starting week in the year and the day of the week.
-- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
-- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
mondayStartWeek :: Day -> (WeekOfYear, Int)
mondayStartWeek :: Day -> (DayOfYear, DayOfYear)
mondayStartWeek Day
date = (forall a. Num a => Year -> a
fromInteger ((forall a. Integral a => a -> a -> a
div Year
d Year
7) forall a. Num a => a -> a -> a
- (forall a. Integral a => a -> a -> a
div Year
k Year
7)), forall a. Num a => Year -> a
fromInteger (forall a. Integral a => a -> a -> a
mod Year
d Year
7) forall a. Num a => a -> a -> a
+ DayOfYear
1)
  where
    yd :: DayOfYear
yd = forall a b. (a, b) -> b
snd (Day -> (Year, DayOfYear)
toOrdinalDate Day
date)
    d :: Year
d = (Day -> Year
toModifiedJulianDay Day
date) forall a. Num a => a -> a -> a
+ Year
2
    k :: Year
k = Year
d forall a. Num a => a -> a -> a
- (forall a. Integral a => a -> Year
toInteger DayOfYear
yd)

-- | Get the number of the Sunday-starting week in the year and the day of the week.
-- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
-- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
sundayStartWeek :: Day -> (WeekOfYear, Int)
sundayStartWeek :: Day -> (DayOfYear, DayOfYear)
sundayStartWeek Day
date = (forall a. Num a => Year -> a
fromInteger ((forall a. Integral a => a -> a -> a
div Year
d Year
7) forall a. Num a => a -> a -> a
- (forall a. Integral a => a -> a -> a
div Year
k Year
7)), forall a. Num a => Year -> a
fromInteger (forall a. Integral a => a -> a -> a
mod Year
d Year
7))
  where
    yd :: DayOfYear
yd = forall a b. (a, b) -> b
snd (Day -> (Year, DayOfYear)
toOrdinalDate Day
date)
    d :: Year
d = (Day -> Year
toModifiedJulianDay Day
date) forall a. Num a => a -> a -> a
+ Year
3
    k :: Year
k = Year
d forall a. Num a => a -> a -> a
- (forall a. Integral a => a -> Year
toInteger DayOfYear
yd)

-- | The inverse of 'mondayStartWeek'. Get a 'Day' given the year,
-- the number of the Monday-starting week, and the day of the week.
-- The first Monday is the first day of week 1, any earlier days in the year
-- are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
fromMondayStartWeek ::
       Year -- ^ Year.
    -> WeekOfYear -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
    -> Int -- ^ Day of week.
                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
    -> Day
fromMondayStartWeek :: Year -> DayOfYear -> DayOfYear -> Day
fromMondayStartWeek Year
year DayOfYear
w DayOfYear
d = let
    -- first day of the year
    firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
    -- 0-based year day of first monday of the year
    zbFirstMonday :: Year
zbFirstMonday = (Year
5 forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) forall a. Integral a => a -> a -> a
`mod` Year
7
    -- 0-based week of year
    zbWeek :: DayOfYear
zbWeek = DayOfYear
w forall a. Num a => a -> a -> a
- DayOfYear
1
    -- 0-based day of week
    zbDay :: DayOfYear
zbDay = DayOfYear
d forall a. Num a => a -> a -> a
- DayOfYear
1
    -- 0-based day in year
    zbYearDay :: Year
zbYearDay = Year
zbFirstMonday forall a. Num a => a -> a -> a
+ Year
7 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
    in Year -> Day -> Day
addDays Year
zbYearDay Day
firstDay

fromMondayStartWeekValid ::
       Year -- ^ Year.
    -> WeekOfYear -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
    -> Int -- ^ Day of week.
                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
    -> Maybe Day
fromMondayStartWeekValid :: Year -> DayOfYear -> DayOfYear -> Maybe Day
fromMondayStartWeekValid Year
year DayOfYear
w DayOfYear
d = do
    DayOfYear
d' <- forall t. Ord t => t -> t -> t -> Maybe t
clipValid DayOfYear
1 DayOfYear
7 DayOfYear
d
    let
        -- first day of the year
        firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
        -- 0-based week of year
        zbFirstMonday :: Year
zbFirstMonday = (Year
5 forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) forall a. Integral a => a -> a -> a
`mod` Year
7
        -- 0-based week number
        zbWeek :: DayOfYear
zbWeek = DayOfYear
w forall a. Num a => a -> a -> a
- DayOfYear
1
        -- 0-based day of week
        zbDay :: DayOfYear
zbDay = DayOfYear
d' forall a. Num a => a -> a -> a
- DayOfYear
1
        -- 0-based day in year
        zbYearDay :: Year
zbYearDay = Year
zbFirstMonday forall a. Num a => a -> a -> a
+ Year
7 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
    Year
zbYearDay' <-
        forall t. Ord t => t -> t -> t -> Maybe t
clipValid
            Year
0
            (if Year -> Bool
isLeapYear Year
year
                 then Year
365
                 else Year
364)
            Year
zbYearDay
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
zbYearDay' Day
firstDay

-- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and
-- the number of the day of a Sunday-starting week.
-- The first Sunday is the first day of week 1, any earlier days in the
-- year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
fromSundayStartWeek ::
       Year -- ^ Year.
    -> WeekOfYear -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
    -> Int -- ^ Day of week
                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
    -> Day
fromSundayStartWeek :: Year -> DayOfYear -> DayOfYear -> Day
fromSundayStartWeek Year
year DayOfYear
w DayOfYear
d = let
    -- first day of the year
    firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
    -- 0-based year day of first monday of the year
    zbFirstSunday :: Year
zbFirstSunday = (Year
4 forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) forall a. Integral a => a -> a -> a
`mod` Year
7
    -- 0-based week of year
    zbWeek :: DayOfYear
zbWeek = DayOfYear
w forall a. Num a => a -> a -> a
- DayOfYear
1
    -- 0-based day of week
    zbDay :: DayOfYear
zbDay = DayOfYear
d
    -- 0-based day in year
    zbYearDay :: Year
zbYearDay = Year
zbFirstSunday forall a. Num a => a -> a -> a
+ Year
7 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
    in Year -> Day -> Day
addDays Year
zbYearDay Day
firstDay

fromSundayStartWeekValid ::
       Year -- ^ Year.
    -> WeekOfYear -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
    -> Int -- ^ Day of week.
                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
    -> Maybe Day
fromSundayStartWeekValid :: Year -> DayOfYear -> DayOfYear -> Maybe Day
fromSundayStartWeekValid Year
year DayOfYear
w DayOfYear
d = do
    DayOfYear
d' <- forall t. Ord t => t -> t -> t -> Maybe t
clipValid DayOfYear
0 DayOfYear
6 DayOfYear
d
    let
        -- first day of the year
        firstDay :: Day
firstDay = Year -> DayOfYear -> Day
fromOrdinalDate Year
year DayOfYear
1
        -- 0-based week of year
        zbFirstSunday :: Year
zbFirstSunday = (Year
4 forall a. Num a => a -> a -> a
- Day -> Year
toModifiedJulianDay Day
firstDay) forall a. Integral a => a -> a -> a
`mod` Year
7
        -- 0-based week number
        zbWeek :: DayOfYear
zbWeek = DayOfYear
w forall a. Num a => a -> a -> a
- DayOfYear
1
        -- 0-based day of week
        zbDay :: DayOfYear
zbDay = DayOfYear
d'
        -- 0-based day in year
        zbYearDay :: Year
zbYearDay = Year
zbFirstSunday forall a. Num a => a -> a -> a
+ Year
7 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Year
toInteger DayOfYear
zbWeek forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Year
toInteger DayOfYear
zbDay
    Year
zbYearDay' <-
        forall t. Ord t => t -> t -> t -> Maybe t
clipValid
            Year
0
            (if Year -> Bool
isLeapYear Year
year
                 then Year
365
                 else Year
364)
            Year
zbYearDay
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
zbYearDay' Day
firstDay