{-# LANGUAGE Safe #-}

module Data.Time.Calendar.MonthDay (
    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,
    monthAndDayToDayOfYear,
    monthAndDayToDayOfYearValid,
    dayOfYearToMonthAndDay,
    monthLength,
) where

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

-- | Convert month and day in the Gregorian or Julian calendars to day of year.
-- First arg is leap year flag.
monthAndDayToDayOfYear :: Bool -> MonthOfYear -> DayOfMonth -> DayOfYear
monthAndDayToDayOfYear :: Bool -> MonthOfYear -> MonthOfYear -> MonthOfYear
monthAndDayToDayOfYear Bool
isLeap MonthOfYear
month MonthOfYear
day = (MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Integral a => a -> a -> a
div (MonthOfYear
367 MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
* MonthOfYear
month'' MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
- MonthOfYear
362) MonthOfYear
12) MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
+ MonthOfYear
k MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
+ MonthOfYear
day'
  where
    month' :: MonthOfYear
month' = MonthOfYear -> MonthOfYear -> MonthOfYear -> MonthOfYear
forall t. Ord t => t -> t -> t -> t
clip MonthOfYear
1 MonthOfYear
12 MonthOfYear
month
    day' :: MonthOfYear
day' = MonthOfYear -> MonthOfYear
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MonthOfYear -> MonthOfYear -> MonthOfYear -> MonthOfYear
forall t. Ord t => t -> t -> t -> t
clip MonthOfYear
1 (Bool -> MonthOfYear -> MonthOfYear
monthLength' Bool
isLeap MonthOfYear
month') MonthOfYear
day)
    month'' :: MonthOfYear
month'' = MonthOfYear -> MonthOfYear
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
month'
    k :: MonthOfYear
k =
        if MonthOfYear
month' MonthOfYear -> MonthOfYear -> Bool
forall a. Ord a => a -> a -> Bool
<= MonthOfYear
2
            then MonthOfYear
0
            else
                if Bool
isLeap
                    then -MonthOfYear
1
                    else -MonthOfYear
2

-- | Convert month and day in the Gregorian or Julian calendars to day of year.
-- First arg is leap year flag.
monthAndDayToDayOfYearValid :: Bool -> MonthOfYear -> DayOfMonth -> Maybe DayOfYear
monthAndDayToDayOfYearValid :: Bool -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
monthAndDayToDayOfYearValid Bool
isLeap MonthOfYear
month MonthOfYear
day = do
    MonthOfYear
month' <- MonthOfYear -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid MonthOfYear
1 MonthOfYear
12 MonthOfYear
month
    MonthOfYear
day' <- MonthOfYear -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid MonthOfYear
1 (Bool -> MonthOfYear -> MonthOfYear
monthLength' Bool
isLeap MonthOfYear
month') MonthOfYear
day
    let
        day'' :: MonthOfYear
day'' = MonthOfYear -> MonthOfYear
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
day'
        month'' :: MonthOfYear
month'' = MonthOfYear -> MonthOfYear
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
month'
        k :: MonthOfYear
k =
            if MonthOfYear
month' MonthOfYear -> MonthOfYear -> Bool
forall a. Ord a => a -> a -> Bool
<= MonthOfYear
2
                then MonthOfYear
0
                else
                    if Bool
isLeap
                        then -MonthOfYear
1
                        else -MonthOfYear
2
    MonthOfYear -> Maybe MonthOfYear
forall (m :: * -> *) a. Monad m => a -> m a
return ((MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Integral a => a -> a -> a
div (MonthOfYear
367 MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
* MonthOfYear
month'' MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
- MonthOfYear
362) MonthOfYear
12) MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
+ MonthOfYear
k MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
+ MonthOfYear
day'')

-- | Convert day of year in the Gregorian or Julian calendars to month and day.
-- First arg is leap year flag.
dayOfYearToMonthAndDay :: Bool -> DayOfYear -> (MonthOfYear, DayOfMonth)
dayOfYearToMonthAndDay :: Bool -> MonthOfYear -> (MonthOfYear, MonthOfYear)
dayOfYearToMonthAndDay Bool
isLeap MonthOfYear
yd =
    [MonthOfYear] -> MonthOfYear -> (MonthOfYear, MonthOfYear)
findMonthDay
        (Bool -> [MonthOfYear]
monthLengths Bool
isLeap)
        ( MonthOfYear -> MonthOfYear -> MonthOfYear -> MonthOfYear
forall t. Ord t => t -> t -> t -> t
clip
            MonthOfYear
1
            ( if Bool
isLeap
                then MonthOfYear
366
                else MonthOfYear
365
            )
            MonthOfYear
yd
        )

findMonthDay :: [Int] -> Int -> (Int, Int)
findMonthDay :: [MonthOfYear] -> MonthOfYear -> (MonthOfYear, MonthOfYear)
findMonthDay (MonthOfYear
n : [MonthOfYear]
ns) MonthOfYear
yd
    | MonthOfYear
yd MonthOfYear -> MonthOfYear -> Bool
forall a. Ord a => a -> a -> Bool
> MonthOfYear
n = (\(MonthOfYear
m, MonthOfYear
d) -> (MonthOfYear
m MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
+ MonthOfYear
1, MonthOfYear
d)) ([MonthOfYear] -> MonthOfYear -> (MonthOfYear, MonthOfYear)
findMonthDay [MonthOfYear]
ns (MonthOfYear
yd MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
- MonthOfYear
n))
findMonthDay [MonthOfYear]
_ MonthOfYear
yd = (MonthOfYear
1, MonthOfYear
yd)

-- | The length of a given month in the Gregorian or Julian calendars.
-- First arg is leap year flag.
monthLength :: Bool -> MonthOfYear -> DayOfMonth
monthLength :: Bool -> MonthOfYear -> MonthOfYear
monthLength Bool
isLeap MonthOfYear
month' = Bool -> MonthOfYear -> MonthOfYear
monthLength' Bool
isLeap (MonthOfYear -> MonthOfYear -> MonthOfYear -> MonthOfYear
forall t. Ord t => t -> t -> t -> t
clip MonthOfYear
1 MonthOfYear
12 MonthOfYear
month')

monthLength' :: Bool -> MonthOfYear -> DayOfMonth
monthLength' :: Bool -> MonthOfYear -> MonthOfYear
monthLength' Bool
isLeap MonthOfYear
month' = (Bool -> [MonthOfYear]
monthLengths Bool
isLeap) [MonthOfYear] -> MonthOfYear -> MonthOfYear
forall a. [a] -> MonthOfYear -> a
!! (MonthOfYear
month' MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
- MonthOfYear
1)

monthLengths :: Bool -> [DayOfMonth]
monthLengths :: Bool -> [MonthOfYear]
monthLengths Bool
isleap =
    [ MonthOfYear
31
    , if Bool
isleap
        then MonthOfYear
29
        else MonthOfYear
28
    , MonthOfYear
31
    , MonthOfYear
30
    , MonthOfYear
31
    , MonthOfYear
30
    , MonthOfYear
31
    , MonthOfYear
31
    , MonthOfYear
30
    , MonthOfYear
31
    , MonthOfYear
30
    , MonthOfYear
31
    ]

-- J        F                   M  A  M  J  J  A  S  O  N  D