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