{-# LANGUAGE Safe #-}
#if __GLASGOW_HASKELL__ < 802
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-incomplete-uni-patterns #-}
#endif

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

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

-- | 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
/= :: Month -> Month -> Bool
$c/= :: Month -> Month -> Bool
== :: Month -> Month -> Bool
$c== :: 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
min :: Month -> Month -> Month
$cmin :: Month -> Month -> Month
max :: Month -> Month -> Month
$cmax :: Month -> Month -> Month
>= :: Month -> Month -> Bool
$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
compare :: Month -> Month -> Ordering
$ccompare :: Month -> Month -> Ordering
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 -> DataType
Month -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Month -> m Month
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Month -> m Month
gmapQi :: forall u. MonthOfYear -> (forall d. Data d => d -> u) -> Month -> u
$cgmapQi :: forall u. MonthOfYear -> (forall d. Data d => d -> u) -> Month -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Month -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Month -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Month -> r
gmapT :: (forall b. Data b => b -> b) -> Month -> Month
$cgmapT :: (forall b. Data b => b -> b) -> Month -> Month
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Month)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Month)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Month)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Month)
dataTypeOf :: Month -> DataType
$cdataTypeOf :: Month -> DataType
toConstr :: Month -> Constr
$ctoConstr :: Month -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Month
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Month
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Month -> c Month
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Month -> c 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 (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 (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 (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 (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 (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
        Integer
y <- ReadPrec Integer
forall a. Read a => ReadPrec a
readPrec
        Char
_ <- ReadP Char -> ReadPrec Char
forall a. ReadP a -> ReadPrec a
lift (ReadP Char -> ReadPrec Char) -> ReadP Char -> ReadPrec Char
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'-'
        MonthOfYear
m <- ReadPrec MonthOfYear
forall a. Read a => ReadPrec a
readPrec
        Month -> ReadPrec Month
forall (m :: * -> *) a. Monad m => a -> m a
return (Month -> ReadPrec Month) -> Month -> ReadPrec Month
forall a b. (a -> b) -> a -> b
$ Integer -> MonthOfYear -> Month
YearMonth Integer
y MonthOfYear
m

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
    MonthOfYear
my' <- MonthOfYear -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
forall t. Ord t => t -> t -> t -> Maybe t
clipValid MonthOfYear
1 MonthOfYear
12 MonthOfYear
my
    Month -> Maybe Month
forall (m :: * -> *) a. Monad m => a -> m a
return (Month -> Maybe Month) -> Month -> Maybe Month
forall a b. (a -> b) -> a -> b
$ Integer -> MonthOfYear -> Month
YearMonth Integer
y MonthOfYear
my'

#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE YearMonth #-}
#endif

toMonthDay :: Day -> (Month,DayOfMonth)
toMonthDay :: Day -> (Month, MonthOfYear)
toMonthDay (YearMonthDay Integer
y MonthOfYear
my MonthOfYear
dm) = (Integer -> MonthOfYear -> Month
YearMonth Integer
y MonthOfYear
my, MonthOfYear
dm)

-- | 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 <- (toMonthDay -> (m,dm)) where
    MonthDay (YearMonth Integer
y MonthOfYear
my) MonthOfYear
dm = Integer -> MonthOfYear -> MonthOfYear -> Day
YearMonthDay Integer
y MonthOfYear
my MonthOfYear
dm

fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day
fromMonthDayValid :: Month -> MonthOfYear -> Maybe Day
fromMonthDayValid (YearMonth Integer
y MonthOfYear
my) MonthOfYear
dm = Integer -> MonthOfYear -> MonthOfYear -> Maybe Day
fromGregorianValid Integer
y MonthOfYear
my MonthOfYear
dm

#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE MonthDay #-}
#endif