{-# 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
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
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'')
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)
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
]