{-# 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 -> Int -> Int -> Int
monthAndDayToDayOfYear Bool
isLeap Int
month Int
day = (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
367 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
month'' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
362) Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
day'
  where
    month' :: Int
month' = Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 Int
12 Int
month
    day' :: Int
day' = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 (Bool -> Int -> Int
monthLength' Bool
isLeap Int
month') Int
day)
    month'' :: Int
month'' = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
month'
    k :: Int
k =
        if Int
month' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2
            then Int
0
            else
                if Bool
isLeap
                    then -Int
1
                    else -Int
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 -> Int -> Int -> Maybe Int
monthAndDayToDayOfYearValid Bool
isLeap Int
month Int
day = do
    Int
month' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
12 Int
month
    Int
day' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 (Bool -> Int -> Int
monthLength' Bool
isLeap Int
month') Int
day
    let day'' :: Int
day'' = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
day'
        month'' :: Int
month'' = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
month'
        k :: Int
k =
            if Int
month' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2
                then Int
0
                else
                    if Bool
isLeap
                        then -Int
1
                        else -Int
2
    Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
367 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
month'' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
362) Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 -> Int -> (Int, Int)
dayOfYearToMonthAndDay Bool
isLeap Int
yd =
    [Int] -> Int -> (Int, Int)
findMonthDay
        (Bool -> [Int]
monthLengths Bool
isLeap)
        ( Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip
            Int
1
            ( if Bool
isLeap
                then Int
366
                else Int
365
            )
            Int
yd
        )

findMonthDay :: [Int] -> Int -> (Int, Int)
findMonthDay :: [Int] -> Int -> (Int, Int)
findMonthDay (Int
n : [Int]
ns) Int
yd
    | Int
yd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = (\(Int
m, Int
d) -> (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
d)) ([Int] -> Int -> (Int, Int)
findMonthDay [Int]
ns (Int
yd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))
findMonthDay [Int]
_ Int
yd = (Int
1, Int
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 -> Int -> Int
monthLength Bool
isLeap Int
month' = Bool -> Int -> Int
monthLength' Bool
isLeap (Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 Int
12 Int
month')

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

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

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