{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE PatternSynonyms    #-}
{-# LANGUAGE ViewPatterns       #-}
#endif
module Data.Time.Calendar.Month.Compat (
    Month(..), addMonths, diffMonths,
#if __GLASGOW_HASKELL__ >= 710
    pattern YearMonth,
#endif
    fromYearMonthValid,
#if __GLASGOW_HASKELL__ >= 710
    pattern MonthDay,
#endif
    fromMonthDayValid,
    -- * time-compat extras
    fromYearMonth,
    toYearMonth,
    fromMonthDay,
    toMonthDay,
) where

#if MIN_VERSION_time(1,11,0)
import Data.Time.Calendar
import Data.Time.Calendar.Month

-- | Part of @YearMonth@ pattern
fromYearMonth :: Year -> MonthOfYear -> Month
fromYearMonth = YearMonth

-- | Part of @YearMonth@ pattern
toYearMonth :: Month -> (Year, MonthOfYear)
toYearMonth (YearMonth y m) = (y, m)

-- | Part of 'MonthDay' pattern
fromMonthDay :: Month -> DayOfMonth -> Day
fromMonthDay = MonthDay

-- | Part of 'MonthDay' pattern
toMonthDay :: Day -> (Month,DayOfMonth)
toMonthDay (MonthDay m d) = (m, d)

#else

#if MIN_VERSION_time(1,9,0)
import Data.Time.Format.Internal
#else
import Data.Time.Format
#endif

import Data.Time.Calendar
import Data.Time.Calendar.Julian
import Data.Time.Calendar.Types
-- import Data.Time.Calendar.Days
import Data.Time.Calendar.Private
import Data.Data
import Data.Fixed
import Text.Read
import Text.ParserCombinators.ReadP
import Control.DeepSeq (NFData (..))
import Data.Ix (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
$cp1Ord :: Eq Month
Ord, Typeable Month
DataType
Constr
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. Int -> (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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Month -> c Month
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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. Int -> (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. Int -> (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)
$cMkMonth :: Constr
$tMonth :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Month -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Month -> u
gmapQ :: (forall d. Data d => d -> u) -> Month -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Month -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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 :: Int -> Month
toEnum = Integer -> Month
MkMonth (Integer -> Month) -> (Int -> Integer) -> Int -> Month
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Enum a => Int -> a
toEnum
    fromEnum :: Month -> Int
fromEnum (MkMonth Integer
a) = Integer -> Int
forall a. Enum a => a -> Int
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 -> Int
index (MkMonth Integer
a, MkMonth Integer
b) (MkMonth Integer
c) = (Integer, Integer) -> Integer -> Int
forall a. Ix a => (a, a) -> a -> Int
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) -> Int
rangeSize (MkMonth Integer
a, MkMonth Integer
b) = (Integer, Integer) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (Integer
a, Integer
b)

-- | Show as @yyyy-mm@.
instance Show Month where
    show :: Month -> String
show Month
ym = case Month -> (Integer, Int)
toYearMonth Month
ym of
        (Integer
y, Int
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]
++ Int -> String
forall t. ShowPadded t => t -> String
show2 Int
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
'-'
        Int
m <- ReadPrec Int
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 -> Int -> Month
fromYearMonth Integer
y Int
m

-------------------------------------------------------------------------------
-- ForematTime Month
-------------------------------------------------------------------------------

toSomeDay :: Month -> Day
toSomeDay :: Month -> Day
toSomeDay (MkMonth Integer
m) =
    let (Integer
y,Integer
my) = Integer -> Integer -> (Integer, Integer)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Integer
m Integer
12
    in Integer -> Int -> Int -> Day
fromGregorian Integer
y (Int -> Int
forall a. Enum a => a -> a
succ (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
my)) Int
1

#if MIN_VERSION_time(1,9,0)
#define FORMAT_OPTS fo
#elif MIN_VERSION_time(1,8,0)
#define FORMAT_OPTS tl mpo i
#else
#define FORMAT_OPTS tl mpo
#endif

#if MIN_VERSION_time(1,9,0)
#define FORMAT_ARG _arg
#else
#define FORMAT_ARG
#endif

instance FormatTime Month where
    -- Year Count
    formatCharacter :: Bool -> Char -> Maybe (FormatOptions -> Month -> String)
formatCharacter FORMAT_ARG 'Y' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'Y')
    formatCharacter FORMAT_ARG 'y' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'y')
    formatCharacter FORMAT_ARG 'c' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'c')
    -- Month of Year
    formatCharacter FORMAT_ARG 'B' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'B')
    formatCharacter FORMAT_ARG 'b' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'b')
    formatCharacter FORMAT_ARG 'h' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'h')
    formatCharacter FORMAT_ARG 'm' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'm')

    formatCharacter FORMAT_ARG _  = Nothing

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

fromYearMonthValid :: Year -> MonthOfYear -> Maybe Month
fromYearMonthValid :: Integer -> Int -> Maybe Month
fromYearMonthValid Integer
y Int
my = do
    Int
my' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
1 Int
12 Int
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 -> Int -> Month
fromYearMonth Integer
y Int
my'

-- | Part of @YearMonth@ pattern
fromYearMonth :: Year -> MonthOfYear -> Month
fromYearMonth :: Integer -> Int -> Month
fromYearMonth Integer
y Int
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
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 Int
12 Int
my)

-- | Part of @YearMonth@ pattern
toYearMonth :: Month -> (Year, MonthOfYear)
toYearMonth :: Month -> (Integer, Int)
toYearMonth (MkMonth Integer
m) = case Integer -> Integer -> (Integer, Integer)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Integer
m Integer
12 of
    (Integer
y, Integer
my) -> (Integer
y, Int -> Int
forall a. Enum a => a -> a
succ (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
my))

#if __GLASGOW_HASKELL__ >= 710
-- | Bidirectional abstract constructor.
-- Invalid months of year will be clipped to the correct range.
pattern YearMonth :: Year -> MonthOfYear -> Month
pattern $bYearMonth :: Integer -> Int -> Month
$mYearMonth :: forall r. Month -> (Integer -> Int -> r) -> (Void# -> r) -> r
YearMonth y my <- (toYearMonth -> (y, my))
  where YearMonth Integer
y Int
my = Integer -> Int -> Month
fromYearMonth Integer
y Int
my

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

-- | Part of 'MonthDay' pattern
toMonthDay :: Day -> (Month,DayOfMonth)
toMonthDay :: Day -> (Month, Int)
toMonthDay Day
d = case Day -> (Integer, Int, Int)
toGregorian Day
d of 
    (Integer
y, Int
my, Int
dm) -> (Integer -> Int -> Month
fromYearMonth Integer
y Int
my, Int
dm)

-- | Part of 'MonthDay' pattern
fromMonthDay :: Month -> DayOfMonth -> Day
fromMonthDay :: Month -> Int -> Day
fromMonthDay Month
m Int
dm = case Month -> (Integer, Int)
toYearMonth Month
m of
    (Integer
y, Int
my) -> Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
my Int
dm

fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day
fromMonthDayValid :: Month -> Int -> Maybe Day
fromMonthDayValid Month
m Int
dm = case Month -> (Integer, Int)
toYearMonth Month
m of
    (Integer
y, Int
my) -> Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
my Int
dm

#if __GLASGOW_HASKELL__ >= 710
-- | Bidirectional abstract constructor.
-- Invalid days of month will be clipped to the correct range.
pattern MonthDay :: Month -> DayOfMonth -> Day
pattern $bMonthDay :: Month -> Int -> Day
$mMonthDay :: forall r. Day -> (Month -> Int -> r) -> (Void# -> r) -> r
MonthDay m dm <- (toMonthDay -> (m,dm)) where
    MonthDay (YearMonth Integer
y Int
my) Int
dm = Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
my Int
dm


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

#endif