{-# 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 m :: Integer
m) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
m
instance Hashable Month where
hashWithSalt :: Int -> Month -> Int
hashWithSalt salt :: Int
salt (MkMonth x :: 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 a :: Integer
a) = Integer -> Month
MkMonth (Integer -> Integer
forall a. Enum a => a -> a
succ Integer
a)
pred :: Month -> Month
pred (MkMonth a :: 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 a :: Integer
a) = Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
a
enumFrom :: Month -> [Month]
enumFrom (MkMonth a :: 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 a :: Integer
a) (MkMonth b :: 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 a :: Integer
a) (MkMonth b :: 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 a :: Integer
a) (MkMonth b :: Integer
b) (MkMonth c :: 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 a :: Integer
a, MkMonth b :: 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 a :: Integer
a, MkMonth b :: Integer
b) (MkMonth c :: 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 a :: Integer
a, MkMonth b :: Integer
b) (MkMonth c :: 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 a :: Integer
a, MkMonth b :: 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 ym :: Month
ym = case Month -> (Integer, Int)
toYearMonth Month
ym of
(y :: Integer
y, m :: Int
m) -> Integer -> String
forall t. ShowPadded t => t -> String
show4 Integer
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" 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 '-'
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 m :: Integer
m) =
let (y :: Integer
y,my :: Integer
my) = Integer -> Integer -> (Integer, Integer)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Integer
m 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)) 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 n :: Integer
n (MkMonth a :: 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 a :: Integer
a) (MkMonth b :: 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 y :: Integer
y my :: Int
my = do
Int
my' <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid 1 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 y :: Integer
y my :: 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
* 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 1 12 Int
my)
toYearMonth :: Month -> (Year, MonthOfYear)
toYearMonth :: Month -> (Integer, Int)
toYearMonth (MkMonth m :: Integer
m) = case Integer -> Integer -> (Integer, Integer)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Integer
m 12 of
(y :: Integer
y, my :: 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 y :: Integer
y my :: 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 d :: Day
d = case Day -> (Integer, Int, Int)
toGregorian Day
d of
(y :: Integer
y, my :: Int
my, dm :: Int
dm) -> (Integer -> Int -> Month
fromYearMonth Integer
y Int
my, Int
dm)
fromMonthDay :: Month -> DayOfMonth -> Day
fromMonthDay :: Month -> Int -> Day
fromMonthDay m :: Month
m dm :: Int
dm = case Month -> (Integer, Int)
toYearMonth Month
m of
(y :: Integer
y, my :: Int
my) -> Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
my Int
dm
fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day
fromMonthDayValid :: Month -> Int -> Maybe Day
fromMonthDayValid m :: Month
m dm :: Int
dm = case Month -> (Integer, Int)
toYearMonth Month
m of
(y :: Integer
y, my :: 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 y :: Integer
y my :: Int
my) dm :: Int
dm = Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
my Int
dm
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE MonthDay #-}
#endif
#endif
#endif