1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveDataTypeable #-} 3#if __GLASGOW_HASKELL__ >= 710 4{-# LANGUAGE PatternSynonyms #-} 5{-# LANGUAGE ViewPatterns #-} 6#endif 7module Data.Time.Calendar.Quarter.Compat ( 8 QuarterOfYear(..), addQuarters, diffQuarters, 9 Quarter(..), 10#if __GLASGOW_HASKELL__ >= 710 11 pattern YearQuarter, 12#endif 13 monthOfYearQuarter, 14 monthQuarter, 15 dayQuarter, 16 -- * time-compat extras 17 fromYearQuarter, 18 toYearQuarter, 19) where 20 21#if MIN_VERSION_time(1,11,0) 22import Data.Time.Calendar (Year) 23import Data.Time.Calendar.Quarter 24 25-- | Part of @YearQuarter@ pattern 26fromYearQuarter :: Year -> QuarterOfYear -> Quarter 27fromYearQuarter = YearQuarter 28 29-- | Part of @YearQuarter@ pattern 30toYearQuarter :: Quarter -> (Year, QuarterOfYear) 31toYearQuarter (YearQuarter y m) = (y, m) 32 33#else 34 35import Data.Data (Data) 36import Data.Typeable (Typeable) 37import Text.Read (Read (..)) 38import Data.Fixed (mod', divMod') 39import Text.ParserCombinators.ReadPrec (lift) 40import Text.ParserCombinators.ReadP (char) 41import Control.DeepSeq (NFData (..)) 42import Data.Ix (Ix (..)) 43 44import Data.Time.Calendar 45import Data.Time.Calendar.Types 46import Data.Time.Calendar.Private 47import Data.Time.Calendar.Month.Compat 48 49-- | Quarters of each year. Each quarter corresponds to three months. 50data QuarterOfYear = Q1 | Q2 | Q3 | Q4 deriving (Eq, Ord, Data, Typeable, Read, Show) 51 52instance NFData QuarterOfYear where 53 rnf Q1 = () 54 rnf Q2 = () 55 rnf Q3 = () 56 rnf Q4 = () 57 58-- | maps Q1..Q4 to 1..4 59instance Enum QuarterOfYear where 60 toEnum i = 61 case mod' i 4 of 62 1 -> Q1 63 2 -> Q2 64 3 -> Q3 65 _ -> Q4 66 fromEnum Q1 = 1 67 fromEnum Q2 = 2 68 fromEnum Q3 = 3 69 fromEnum Q4 = 4 70 71instance Bounded QuarterOfYear where 72 minBound = Q1 73 maxBound = Q4 74 75-- | An absolute count of year quarters. 76-- Number is equal to @(year * 4) + (quarterOfYear - 1)@. 77newtype Quarter = MkQuarter Integer deriving (Eq, Ord, Data, Typeable) 78 79instance NFData Quarter where 80 rnf (MkQuarter m) = rnf m 81 82instance Enum Quarter where 83 succ (MkQuarter a) = MkQuarter (succ a) 84 pred (MkQuarter a) = MkQuarter (pred a) 85 toEnum = MkQuarter . toEnum 86 fromEnum (MkQuarter a) = fromEnum a 87 enumFrom (MkQuarter a) = fmap MkQuarter (enumFrom a) 88 enumFromThen (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromThen a b) 89 enumFromTo (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromTo a b) 90 enumFromThenTo (MkQuarter a) (MkQuarter b) (MkQuarter c) = 91 fmap MkQuarter (enumFromThenTo a b c) 92 93instance Ix Quarter where 94 range (MkQuarter a, MkQuarter b) = fmap MkQuarter (range (a, b)) 95 index (MkQuarter a, MkQuarter b) (MkQuarter c) = index (a, b) c 96 inRange (MkQuarter a, MkQuarter b) (MkQuarter c) = inRange (a, b) c 97 rangeSize (MkQuarter a, MkQuarter b) = rangeSize (a, b) 98 99-- | Show as @yyyy-Qn@. 100instance Show Quarter where 101 show q = case toYearQuarter q of 102 (y, qy) -> show4 y ++ "-" ++ show qy 103 104-- | Read as @yyyy-Qn@. 105instance Read Quarter where 106 readPrec = do 107 y <- readPrec 108 _ <- lift $ char '-' 109 m <- readPrec 110 return $ fromYearQuarter y m 111 112addQuarters :: Integer -> Quarter -> Quarter 113addQuarters n (MkQuarter a) = MkQuarter $ a + n 114 115diffQuarters :: Quarter -> Quarter -> Integer 116diffQuarters (MkQuarter a) (MkQuarter b) = a - b 117 118#if __GLASGOW_HASKELL__ >= 710 119-- | Bidirectional abstract constructor. 120pattern YearQuarter :: Year -> QuarterOfYear -> Quarter 121pattern YearQuarter y qy <- (toYearQuarter -> (y, qy)) 122 where YearQuarter y qy = fromYearQuarter y qy 123 124#if __GLASGOW_HASKELL__ >= 802 125{-# COMPLETE YearQuarter #-} 126#endif 127#endif 128 129monthOfYearQuarter :: MonthOfYear -> QuarterOfYear 130monthOfYearQuarter my | my <= 3 = Q1 131monthOfYearQuarter my | my <= 6 = Q2 132monthOfYearQuarter my | my <= 9 = Q3 133monthOfYearQuarter _ = Q4 134 135monthQuarter :: Month -> Quarter 136monthQuarter m = case toYearMonth m of 137 (y, my) -> fromYearQuarter y $ monthOfYearQuarter my 138 139dayQuarter :: Day -> Quarter 140dayQuarter d = case toMonthDay d of 141 (m, _) -> monthQuarter m 142 143-- | Part of @YearQuarter@ pattern 144fromYearQuarter :: Year -> QuarterOfYear -> Quarter 145fromYearQuarter y qy = MkQuarter $ y * 4 + toInteger (pred $ fromEnum qy) 146 147-- | Part of @YearQuarter@ pattern 148toYearQuarter :: Quarter -> (Year, QuarterOfYear) 149toYearQuarter (MkQuarter y) = case divMod' y 4 of 150 (y, qy) -> (y, toEnum (succ (fromInteger qy))) 151 152#endif 153