{-# 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 -> 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 (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. [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