{-# LANGUAGE Safe #-}

module Data.Time.Calendar.MonthDay
    ( MonthOfYear, DayOfMonth, DayOfYear
    , monthAndDayToDayOfYear
    , monthAndDayToDayOfYearValid
    , dayOfYearToMonthAndDay
    , monthLength
    ) where

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

-- | 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