{-# LANGUAGE Safe #-}

-- | An absolute count of common calendar months.
module Data.Time.Calendar.Month (
    Month (..),
    addMonths,
    diffMonths,
    pattern YearMonth,
    fromYearMonthValid,
    pattern MonthDay,
    fromMonthDayValid,
) where

import Control.DeepSeq
import Data.Data
import Data.Fixed
import Data.Ix
import Data.Time.Calendar.Days
import Data.Time.Calendar.Gregorian
import Data.Time.Calendar.Private
import Text.ParserCombinators.ReadP
import Text.Read

-- | An absolute count of common calendar months.
-- Number is equal to @(year * 12) + (monthOfYear - 1)@.
newtype Month = MkMonth Integer deriving (Month -> Month -> Bool
(Month -> Month -> Bool) -> (Month -> Month -> Bool) -> Eq Month
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Month -> Month -> Bool
== :: Month -> Month -> Bool
$c/= :: Month -> Month -> Bool
/= :: Month -> Month -> Bool
Eq, Eq Month
Eq Month =>
(Month -> Month -> Ordering)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Month)
-> (Month -> Month -> Month)
-> Ord Month
Month -> Month -> Bool
Month -> Month -> Ordering
Month -> Month -> Month
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Month -> Month -> Ordering
compare :: Month -> Month -> Ordering
$c< :: Month -> Month -> Bool
< :: Month -> Month -> Bool
$c<= :: Month -> Month -> Bool
<= :: Month -> Month -> Bool
$c> :: Month -> Month -> Bool
> :: Month -> Month -> Bool
$c>= :: Month -> Month -> Bool
>= :: Month -> Month -> Bool
$cmax :: Month -> Month -> Month
max :: Month -> Month -> Month
$cmin :: Month -> Month -> Month
min :: Month -> Month -> Month
Ord, Typeable Month
Typeable Month =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Month -> c Month)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Month)
-> (Month -> Constr)
-> (Month -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Month))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Month))
-> ((forall b. Data b => b -> b) -> Month -> Month)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r)
-> (forall u. (forall d. Data d => d -> u) -> Month -> [u])
-> (forall u.
    MonthOfYear -> (forall d. Data d => d -> u) -> Month -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Month -> m Month)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Month -> m Month)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Month -> m Month)
-> Data Month
Month -> Constr
Month -> DataType
(forall b. Data b => b -> b) -> Month -> Month
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u.
    MonthOfYear -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. MonthOfYear -> (forall d. Data d => d -> u) -> Month -> u
forall u. (forall d. Data d => d -> u) -> Month -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Month -> m Month
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Month -> m Month
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Month
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Month -> c Month
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Month)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Month)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Month -> c Month
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Month -> c Month
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Month
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Month
$ctoConstr :: Month -> Constr
toConstr :: Month -> Constr
$cdataTypeOf :: Month -> DataType
dataTypeOf :: Month -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Month)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Month)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Month)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Month)
$cgmapT :: (forall b. Data b => b -> b) -> Month -> Month
gmapT :: (forall b. Data b => b -> b) -> Month -> Month
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Month -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Month -> [u]
$cgmapQi :: forall u. MonthOfYear -> (forall d. Data d => d -> u) -> Month -> u
gmapQi :: forall u. MonthOfYear -> (forall d. Data d => d -> u) -> Month -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Month -> m Month
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Month -> m Month
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Month -> m Month
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Month -> m Month
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Month -> m Month
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Month -> m Month
Data, Typeable)

instance NFData Month where
    rnf :: Month -> ()
rnf (MkMonth Integer
m) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
m

instance Enum Month where
    succ :: Month -> Month
succ (MkMonth Integer
a) = Integer -> Month
MkMonth (Integer -> Integer
forall a. Enum a => a -> a
succ Integer
a)
    pred :: Month -> Month
pred (MkMonth Integer
a) = Integer -> Month
MkMonth (Integer -> Integer
forall a. Enum a => a -> a
pred Integer
a)
    toEnum :: MonthOfYear -> Month
toEnum = Integer -> Month
MkMonth (Integer -> Month)
-> (MonthOfYear -> Integer) -> MonthOfYear -> Month
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthOfYear -> Integer
forall a. Enum a => MonthOfYear -> a
toEnum
    fromEnum :: Month -> MonthOfYear
fromEnum (MkMonth Integer
a) = Integer -> MonthOfYear
forall a. Enum a => a -> MonthOfYear
fromEnum Integer
a
    enumFrom :: Month -> [Month]
enumFrom (MkMonth Integer
a) = (Integer -> Month) -> [Integer] -> [Month]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Month
MkMonth (Integer -> [Integer]
forall a. Enum a => a -> [a]
enumFrom Integer
a)
    enumFromThen :: Month -> Month -> [Month]
enumFromThen (MkMonth Integer
a) (MkMonth Integer
b) = (Integer -> Month) -> [Integer] -> [Month]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Month
MkMonth (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromThen Integer
a Integer
b)
    enumFromTo :: Month -> Month -> [Month]
enumFromTo (MkMonth Integer
a) (MkMonth Integer
b) = (Integer -> Month) -> [Integer] -> [Month]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Month
MkMonth (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromTo Integer
a Integer
b)
    enumFromThenTo :: Month -> Month -> Month -> [Month]
enumFromThenTo (MkMonth Integer
a) (MkMonth Integer
b) (MkMonth Integer
c) =
        (Integer -> Month) -> [Integer] -> [Month]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Month
MkMonth (Integer -> Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
a Integer
b Integer
c)

instance Ix Month where
    range :: (Month, Month) -> [Month]
range (MkMonth Integer
a, MkMonth Integer
b) = (Integer -> Month) -> [Integer] -> [Month]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Month
MkMonth ((Integer, Integer) -> [Integer]
forall a. Ix a => (a, a) -> [a]
range (Integer
a, Integer
b))
    index :: (Month, Month) -> Month -> MonthOfYear
index (MkMonth Integer
a, MkMonth Integer
b) (MkMonth Integer
c) = (Integer, Integer) -> Integer -> MonthOfYear
forall a. Ix a => (a, a) -> a -> MonthOfYear
index (Integer
a, Integer
b) Integer
c
    inRange :: (Month, Month) -> Month -> Bool
inRange (MkMonth Integer
a, MkMonth Integer
b) (MkMonth Integer
c) = (Integer, Integer) -> Integer -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Integer
a, Integer
b) Integer
c
    rangeSize :: (Month, Month) -> MonthOfYear
rangeSize (MkMonth Integer
a, MkMonth Integer
b) = (Integer, Integer) -> MonthOfYear
forall a. Ix a => (a, a) -> MonthOfYear
rangeSize (Integer
a, Integer
b)

-- | Show as @yyyy-mm@.
instance Show Month where
    show :: Month -> String
show (YearMonth Integer
y MonthOfYear
m) = Integer -> String
forall t. ShowPadded t => t -> String
show4 Integer
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ MonthOfYear -> String
forall t. ShowPadded t => t -> String
show2 MonthOfYear
m

-- | Read as @yyyy-mm@.
instance Read Month where
    readPrec :: ReadPrec Month
readPrec = do
        y <- ReadPrec Integer
forall a. Read a => ReadPrec a
readPrec
        _ <- lift $ char '-'
        m <- readPrec
        return $ YearMonth y m

instance DayPeriod Month where
    periodFirstDay :: Month -> Day
periodFirstDay (YearMonth Integer
y MonthOfYear
m) = Integer -> MonthOfYear -> MonthOfYear -> Day
YearMonthDay Integer
y MonthOfYear
m MonthOfYear
1
    periodLastDay :: Month -> Day
periodLastDay (YearMonth Integer
y MonthOfYear
m) = Integer -> MonthOfYear -> MonthOfYear -> Day
YearMonthDay Integer
y MonthOfYear
m MonthOfYear
31 -- clips to correct day
    dayPeriod :: Day -> Month
dayPeriod (YearMonthDay Integer
y MonthOfYear
my MonthOfYear
_) = Integer -> MonthOfYear -> Month
YearMonth Integer
y MonthOfYear
my

addMonths :: Integer -> Month -> Month
addMonths :: Integer -> Month -> Month
addMonths Integer
n (MkMonth Integer
a) = Integer -> Month
MkMonth (Integer -> Month) -> Integer -> Month
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n

diffMonths :: Month -> Month -> Integer
diffMonths :: Month -> Month -> Integer
diffMonths (MkMonth Integer
a) (MkMonth Integer
b) = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
b

-- | Bidirectional abstract constructor.
-- Invalid months of year will be clipped to the correct range.
pattern YearMonth :: Year -> MonthOfYear -> Month
pattern $mYearMonth :: forall {r}.
Month -> (Integer -> MonthOfYear -> r) -> ((# #) -> r) -> r
$bYearMonth :: Integer -> MonthOfYear -> Month
YearMonth y my <-
    MkMonth ((\Integer
m -> Integer -> Integer -> (Integer, Integer)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Integer
m Integer
12) -> (y, succ . fromInteger -> my))
    where
        YearMonth Integer
y MonthOfYear
my = Integer -> Month
MkMonth (Integer -> Month) -> Integer -> Month
forall a b. (a -> b) -> a -> b
$ (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ MonthOfYear -> Integer
forall a. Integral a => a -> Integer
toInteger (MonthOfYear -> MonthOfYear
forall a. Enum a => a -> a
pred (MonthOfYear -> MonthOfYear) -> MonthOfYear -> MonthOfYear
forall a b. (a -> b) -> a -> b
$ MonthOfYear -> MonthOfYear -> MonthOfYear -> MonthOfYear
forall t. Ord t => t -> t -> t -> t
clip MonthOfYear
1 MonthOfYear
12 MonthOfYear
my)

fromYearMonthValid :: Year -> MonthOfYear -> Maybe Month
fromYearMonthValid :: Integer -> MonthOfYear -> Maybe Month
fromYearMonthValid Integer
y MonthOfYear
my = do
    my' <- MonthOfYear -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid MonthOfYear
1 MonthOfYear
12 MonthOfYear
my
    return $ YearMonth y my'

{-# COMPLETE YearMonth #-}

-- | Bidirectional abstract constructor.
-- Invalid days of month will be clipped to the correct range.
pattern MonthDay :: Month -> DayOfMonth -> Day
pattern $mMonthDay :: forall {r}. Day -> (Month -> MonthOfYear -> r) -> ((# #) -> r) -> r
$bMonthDay :: Month -> MonthOfYear -> Day
MonthDay m dm <-
    (periodFromDay -> (m, dm))
    where
        MonthDay = Month -> MonthOfYear -> Day
forall p. DayPeriod p => p -> MonthOfYear -> Day
periodToDay

fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day
fromMonthDayValid :: Month -> MonthOfYear -> Maybe Day
fromMonthDayValid = Month -> MonthOfYear -> Maybe Day
forall p. DayPeriod p => p -> MonthOfYear -> Maybe Day
periodToDayValid

{-# COMPLETE MonthDay #-}