{-# 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,
fromYearMonth,
toYearMonth,
fromMonthDay,
toMonthDay,
) where
#if MIN_VERSION_time(1,11,0)
import Data.Time.Calendar
import Data.Time.Calendar.Month
fromYearMonth :: Year -> MonthOfYear -> Month
fromYearMonth = YearMonth
toYearMonth :: Month -> (Year, MonthOfYear)
toYearMonth (YearMonth y m) = (y, m)
fromMonthDay :: Month -> DayOfMonth -> Day
fromMonthDay = MonthDay
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.Private
import Data.Data
import Data.Fixed
import Text.Read
import Text.ParserCombinators.ReadP
import Control.DeepSeq (NFData (..))
import Data.Ix (Ix (..))
import Data.Hashable (Hashable (..))
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 Hashable Month where
hashWithSalt :: Int -> Month -> Int
hashWithSalt Int
salt (MkMonth Integer
x) = Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Integer
x
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)
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
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
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
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')
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'
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)
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
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
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)
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
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