module Hledger.Data.Period (
periodAsDateSpan
,dateSpanAsPeriod
,simplifyPeriod
,isLastDayOfMonth
,isStandardPeriod
,showPeriod
,showPeriodMonthAbbrev
,periodStart
,periodEnd
,periodNext
,periodPrevious
,periodNextIn
,periodPreviousIn
,periodMoveTo
,periodGrow
,periodShrink
,mondayBefore
,yearMonthContainingWeekStarting
,quarterContainingMonth
,firstMonthOfQuarter
,startOfFirstWeekInMonth
)
where
import Data.Time.Calendar
import Data.Time.Calendar.MonthDay
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.WeekDate
import Data.Time.Format
import Text.Printf
import Hledger.Data.Types
periodAsDateSpan :: Period -> DateSpan
periodAsDateSpan :: Period -> DateSpan
periodAsDateSpan (DayPeriod d :: Day
d) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays 1 Day
d)
periodAsDateSpan (WeekPeriod b :: Day
b) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
b) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays 7 Day
b)
periodAsDateSpan (MonthPeriod y :: Integer
y m :: Month
m) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Month -> Day
fromGregorian Integer
y Month
m 1) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Month -> Day
fromGregorian Integer
y' Month
m' 1)
where
(y' :: Integer
y',m' :: Month
m') | Month
mMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==12 = (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1,1)
| Bool
otherwise = (Integer
y,Month
mMonth -> Month -> Month
forall a. Num a => a -> a -> a
+1)
periodAsDateSpan (QuarterPeriod y :: Integer
y q :: Month
q) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Month -> Day
fromGregorian Integer
y Month
m 1) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Month -> Day
fromGregorian Integer
y' Month
m' 1)
where
(y' :: Integer
y', q' :: Month
q') | Month
qMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==4 = (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1,1)
| Bool
otherwise = (Integer
y,Month
qMonth -> Month -> Month
forall a. Num a => a -> a -> a
+1)
quarterAsMonth :: a -> a
quarterAsMonth q :: a
q = (a
qa -> a -> a
forall a. Num a => a -> a -> a
-1) a -> a -> a
forall a. Num a => a -> a -> a
* 3 a -> a -> a
forall a. Num a => a -> a -> a
+ 1
m :: Month
m = Month -> Month
forall a. Num a => a -> a
quarterAsMonth Month
q
m' :: Month
m' = Month -> Month
forall a. Num a => a -> a
quarterAsMonth Month
q'
periodAsDateSpan (YearPeriod y :: Integer
y) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Month -> Day
fromGregorian Integer
y 1 1) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Month -> Day
fromGregorian (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1) 1 1)
periodAsDateSpan (PeriodBetween b :: Day
b e :: Day
e) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
b) (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
e)
periodAsDateSpan (PeriodFrom b :: Day
b) = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
b) Maybe Day
forall a. Maybe a
Nothing
periodAsDateSpan (PeriodTo e :: Day
e) = Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
e)
periodAsDateSpan (Period
PeriodAll) = Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing
dateSpanAsPeriod :: DateSpan -> Period
dateSpanAsPeriod :: DateSpan -> Period
dateSpanAsPeriod (DateSpan (Just b :: Day
b) (Just e :: Day
e)) = Period -> Period
simplifyPeriod (Period -> Period) -> Period -> Period
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Period
PeriodBetween Day
b Day
e
dateSpanAsPeriod (DateSpan (Just b :: Day
b) Nothing) = Day -> Period
PeriodFrom Day
b
dateSpanAsPeriod (DateSpan Nothing (Just e :: Day
e)) = Day -> Period
PeriodTo Day
e
dateSpanAsPeriod (DateSpan Nothing Nothing) = Period
PeriodAll
simplifyPeriod :: Period -> Period
simplifyPeriod :: Period -> Period
simplifyPeriod (PeriodBetween b :: Day
b e :: Day
e) =
case (Day -> (Integer, Month, Month)
toGregorian Day
b, Day -> (Integer, Month, Month)
toGregorian Day
e) of
((by :: Integer
by,1,1), (ey :: Integer
ey,1,1)) | Integer
byInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey -> Integer -> Period
YearPeriod Integer
by
((by :: Integer
by,1,1), (ey :: Integer
ey,4,1)) | Integer
byInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey -> Integer -> Month -> Period
QuarterPeriod Integer
by 1
((by :: Integer
by,4,1), (ey :: Integer
ey,7,1)) | Integer
byInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey -> Integer -> Month -> Period
QuarterPeriod Integer
by 2
((by :: Integer
by,7,1), (ey :: Integer
ey,10,1)) | Integer
byInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey -> Integer -> Month -> Period
QuarterPeriod Integer
by 3
((by :: Integer
by,10,1), (ey :: Integer
ey,1,1)) | Integer
byInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey -> Integer -> Month -> Period
QuarterPeriod Integer
by 4
((by :: Integer
by,bm :: Month
bm,1), (ey :: Integer
ey,em :: Month
em,1)) | Integer
byInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey Bool -> Bool -> Bool
&& Month
bmMonth -> Month -> Month
forall a. Num a => a -> a -> a
+1Month -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==Month
em -> Integer -> Month -> Period
MonthPeriod Integer
by Month
bm
((by :: Integer
by,12,1), (ey :: Integer
ey,1,1)) | Integer
byInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey -> Integer -> Month -> Period
MonthPeriod Integer
by 12
_ | let ((by :: Integer
by,bw :: Month
bw,bd :: Month
bd), (ey :: Integer
ey,ew :: Month
ew,ed :: Month
ed)) = (Day -> (Integer, Month, Month)
toWeekDate Day
b, Day -> (Integer, Month, Month)
toWeekDate (Integer -> Day -> Day
addDays (-1) Day
e))
in Integer
byInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey Bool -> Bool -> Bool
&& Month
bwMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==Month
ew Bool -> Bool -> Bool
&& Month
bdMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==1 Bool -> Bool -> Bool
&& Month
edMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==7 -> Day -> Period
WeekPeriod Day
b
((by :: Integer
by,bm :: Month
bm,bd :: Month
bd), (ey :: Integer
ey,em :: Month
em,ed :: Month
ed)) |
(Integer
byInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey Bool -> Bool -> Bool
&& Month
bmMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==Month
em Bool -> Bool -> Bool
&& Month
bdMonth -> Month -> Month
forall a. Num a => a -> a -> a
+1Month -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==Month
ed) Bool -> Bool -> Bool
||
(Integer
byInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey Bool -> Bool -> Bool
&& Month
bmMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==12 Bool -> Bool -> Bool
&& Month
emMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==1 Bool -> Bool -> Bool
&& Month
bdMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==31 Bool -> Bool -> Bool
&& Month
edMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==1) Bool -> Bool -> Bool
||
(Integer
byInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
ey Bool -> Bool -> Bool
&& Month
bmMonth -> Month -> Month
forall a. Num a => a -> a -> a
+1Month -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==Month
em Bool -> Bool -> Bool
&& Integer -> Month -> Month -> Bool
forall a a. (Eq a, Eq a, Num a, Num a) => Integer -> a -> a -> Bool
isLastDayOfMonth Integer
by Month
bm Month
bd Bool -> Bool -> Bool
&& Month
edMonth -> Month -> Bool
forall a. Eq a => a -> a -> Bool
==1)
-> Day -> Period
DayPeriod Day
b
_ -> Day -> Day -> Period
PeriodBetween Day
b Day
e
simplifyPeriod p :: Period
p = Period
p
isLastDayOfMonth :: Integer -> a -> a -> Bool
isLastDayOfMonth y :: Integer
y m :: a
m d :: a
d =
case a
m of
1 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==31
2 | Integer -> Bool
isLeapYear Integer
y -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==29
| Bool
otherwise -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==28
3 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==31
4 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==30
5 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==31
6 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==30
7 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==31
8 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==31
9 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==30
10 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==31
11 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==30
12 -> a
da -> a -> Bool
forall a. Eq a => a -> a -> Bool
==31
_ -> Bool
False
isStandardPeriod :: Period -> Bool
isStandardPeriod = Period -> Bool
isStandardPeriod' (Period -> Bool) -> (Period -> Period) -> Period -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Period -> Period
simplifyPeriod
where
isStandardPeriod' :: Period -> Bool
isStandardPeriod' (DayPeriod _) = Bool
True
isStandardPeriod' (WeekPeriod _) = Bool
True
isStandardPeriod' (MonthPeriod _ _) = Bool
True
isStandardPeriod' (QuarterPeriod _ _) = Bool
True
isStandardPeriod' (YearPeriod _) = Bool
True
isStandardPeriod' _ = Bool
False
showPeriod :: Period -> String
showPeriod (DayPeriod b :: Day
b) = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale "%F" Day
b
showPeriod (WeekPeriod b :: Day
b) = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale "%FW%V" Day
b
showPeriod (MonthPeriod y :: Integer
y m :: Month
m) = String -> Integer -> Month -> String
forall r. PrintfType r => String -> r
printf "%04d-%02d" Integer
y Month
m
showPeriod (QuarterPeriod y :: Integer
y q :: Month
q) = String -> Integer -> Month -> String
forall r. PrintfType r => String -> r
printf "%04dQ%d" Integer
y Month
q
showPeriod (YearPeriod y :: Integer
y) = String -> Integer -> String
forall r. PrintfType r => String -> r
printf "%04d" Integer
y
showPeriod (PeriodBetween b :: Day
b e :: Day
e) = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale "%F" Day
b
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale "..%F" (Integer -> Day -> Day
addDays (-1) Day
e)
showPeriod (PeriodFrom b :: Day
b) = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale "%F.." Day
b
showPeriod (PeriodTo e :: Day
e) = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale "..%F" (Integer -> Day -> Day
addDays (-1) Day
e)
showPeriod PeriodAll = ".."
showPeriodMonthAbbrev :: Period -> String
showPeriodMonthAbbrev (MonthPeriod _ m :: Month
m)
| Month
m Month -> Month -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Month
m Month -> Month -> Bool
forall a. Ord a => a -> a -> Bool
<= [(String, String)] -> Month
forall (t :: * -> *) a. Foldable t => t a -> Month
length [(String, String)]
monthnames = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ [(String, String)]
monthnames [(String, String)] -> Month -> (String, String)
forall a. [a] -> Month -> a
!! (Month
mMonth -> Month -> Month
forall a. Num a => a -> a -> a
-1)
where monthnames :: [(String, String)]
monthnames = TimeLocale -> [(String, String)]
months TimeLocale
defaultTimeLocale
showPeriodMonthAbbrev p :: Period
p = Period -> String
showPeriod Period
p
periodStart :: Period -> Maybe Day
periodStart :: Period -> Maybe Day
periodStart p :: Period
p = Maybe Day
mb
where
DateSpan mb :: Maybe Day
mb _ = Period -> DateSpan
periodAsDateSpan Period
p
periodEnd :: Period -> Maybe Day
periodEnd :: Period -> Maybe Day
periodEnd p :: Period
p = Maybe Day
me
where
DateSpan _ me :: Maybe Day
me = Period -> DateSpan
periodAsDateSpan Period
p
periodNext :: Period -> Period
periodNext :: Period -> Period
periodNext (DayPeriod b :: Day
b) = Day -> Period
DayPeriod (Integer -> Day -> Day
addDays 1 Day
b)
periodNext (WeekPeriod b :: Day
b) = Day -> Period
WeekPeriod (Integer -> Day -> Day
addDays 7 Day
b)
periodNext (MonthPeriod y :: Integer
y 12) = Integer -> Month -> Period
MonthPeriod (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1) 1
periodNext (MonthPeriod y :: Integer
y m :: Month
m) = Integer -> Month -> Period
MonthPeriod Integer
y (Month
mMonth -> Month -> Month
forall a. Num a => a -> a -> a
+1)
periodNext (QuarterPeriod y :: Integer
y 4) = Integer -> Month -> Period
QuarterPeriod (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1) 1
periodNext (QuarterPeriod y :: Integer
y q :: Month
q) = Integer -> Month -> Period
QuarterPeriod Integer
y (Month
qMonth -> Month -> Month
forall a. Num a => a -> a -> a
+1)
periodNext (YearPeriod y :: Integer
y) = Integer -> Period
YearPeriod (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1)
periodNext p :: Period
p = Period
p
periodPrevious :: Period -> Period
periodPrevious :: Period -> Period
periodPrevious (DayPeriod b :: Day
b) = Day -> Period
DayPeriod (Integer -> Day -> Day
addDays (-1) Day
b)
periodPrevious (WeekPeriod b :: Day
b) = Day -> Period
WeekPeriod (Integer -> Day -> Day
addDays (-7) Day
b)
periodPrevious (MonthPeriod y :: Integer
y 1) = Integer -> Month -> Period
MonthPeriod (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1) 12
periodPrevious (MonthPeriod y :: Integer
y m :: Month
m) = Integer -> Month -> Period
MonthPeriod Integer
y (Month
mMonth -> Month -> Month
forall a. Num a => a -> a -> a
-1)
periodPrevious (QuarterPeriod y :: Integer
y 1) = Integer -> Month -> Period
QuarterPeriod (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1) 4
periodPrevious (QuarterPeriod y :: Integer
y q :: Month
q) = Integer -> Month -> Period
QuarterPeriod Integer
y (Month
qMonth -> Month -> Month
forall a. Num a => a -> a -> a
-1)
periodPrevious (YearPeriod y :: Integer
y) = Integer -> Period
YearPeriod (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)
periodPrevious p :: Period
p = Period
p
periodNextIn :: DateSpan -> Period -> Period
periodNextIn :: DateSpan -> Period -> Period
periodNextIn (DateSpan _ (Just e :: Day
e)) p :: Period
p =
case Maybe Day
mb of
Just b :: Day
b -> if Day
b Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
e then Period
p' else Period
p
_ -> Period
p
where
p' :: Period
p' = Period -> Period
periodNext Period
p
mb :: Maybe Day
mb = Period -> Maybe Day
periodStart Period
p'
periodNextIn _ p :: Period
p = Period -> Period
periodNext Period
p
periodPreviousIn :: DateSpan -> Period -> Period
periodPreviousIn :: DateSpan -> Period -> Period
periodPreviousIn (DateSpan (Just b :: Day
b) _) p :: Period
p =
case Maybe Day
me of
Just e :: Day
e -> if Day
e Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
b then Period
p' else Period
p
_ -> Period
p
where
p' :: Period
p' = Period -> Period
periodPrevious Period
p
me :: Maybe Day
me = Period -> Maybe Day
periodEnd Period
p'
periodPreviousIn _ p :: Period
p = Period -> Period
periodPrevious Period
p
periodMoveTo :: Day -> Period -> Period
periodMoveTo :: Day -> Period -> Period
periodMoveTo d :: Day
d (DayPeriod _) = Day -> Period
DayPeriod Day
d
periodMoveTo d :: Day
d (WeekPeriod _) = Day -> Period
WeekPeriod (Day -> Period) -> Day -> Period
forall a b. (a -> b) -> a -> b
$ Day -> Day
mondayBefore Day
d
periodMoveTo d :: Day
d (MonthPeriod _ _) = Integer -> Month -> Period
MonthPeriod Integer
y Month
m where (y :: Integer
y,m :: Month
m,_) = Day -> (Integer, Month, Month)
toGregorian Day
d
periodMoveTo d :: Day
d (QuarterPeriod _ _) = Integer -> Month -> Period
QuarterPeriod Integer
y Month
q
where
(y :: Integer
y,m :: Month
m,_) = Day -> (Integer, Month, Month)
toGregorian Day
d
q :: Month
q = Month -> Month
forall a. Integral a => a -> a
quarterContainingMonth Month
m
periodMoveTo d :: Day
d (YearPeriod _) = Integer -> Period
YearPeriod Integer
y where (y :: Integer
y,_,_) = Day -> (Integer, Month, Month)
toGregorian Day
d
periodMoveTo _ p :: Period
p = Period
p
periodGrow :: Period -> Period
periodGrow :: Period -> Period
periodGrow (DayPeriod b :: Day
b) = Day -> Period
WeekPeriod (Day -> Period) -> Day -> Period
forall a b. (a -> b) -> a -> b
$ Day -> Day
mondayBefore Day
b
periodGrow (WeekPeriod b :: Day
b) = Integer -> Month -> Period
MonthPeriod Integer
y Month
m
where (y :: Integer
y,m :: Month
m) = Day -> (Integer, Month)
yearMonthContainingWeekStarting Day
b
periodGrow (MonthPeriod y :: Integer
y m :: Month
m) = Integer -> Month -> Period
QuarterPeriod Integer
y (Month -> Month
forall a. Integral a => a -> a
quarterContainingMonth Month
m)
periodGrow (QuarterPeriod y :: Integer
y _) = Integer -> Period
YearPeriod Integer
y
periodGrow (YearPeriod _) = Period
PeriodAll
periodGrow p :: Period
p = Period
p
periodShrink :: Day -> Period -> Period
periodShrink :: Day -> Period -> Period
periodShrink _ p :: Period
p@(DayPeriod _) = Period
p
periodShrink today :: Day
today (WeekPeriod b :: Day
b)
| Day
today Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
b Bool -> Bool -> Bool
&& Day -> Day -> Integer
diffDays Day
today Day
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 7 = Day -> Period
DayPeriod Day
today
| Month
m Month -> Month -> Bool
forall a. Eq a => a -> a -> Bool
/= Month
weekmonth = Day -> Period
DayPeriod (Day -> Period) -> Day -> Period
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Month -> Day
fromGregorian Integer
weekyear Month
weekmonth 1
| Bool
otherwise = Day -> Period
DayPeriod Day
b
where
(_,m :: Month
m,_) = Day -> (Integer, Month, Month)
toGregorian Day
b
(weekyear :: Integer
weekyear,weekmonth :: Month
weekmonth) = Day -> (Integer, Month)
yearMonthContainingWeekStarting Day
b
periodShrink today :: Day
today (MonthPeriod y :: Integer
y m :: Month
m)
| (Integer
y',Month
m') (Integer, Month) -> (Integer, Month) -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
y,Month
m) = Day -> Period
WeekPeriod (Day -> Period) -> Day -> Period
forall a b. (a -> b) -> a -> b
$ Day -> Day
mondayBefore Day
today
| Bool
otherwise = Day -> Period
WeekPeriod (Day -> Period) -> Day -> Period
forall a b. (a -> b) -> a -> b
$ Integer -> Month -> Day
startOfFirstWeekInMonth Integer
y Month
m
where (y' :: Integer
y',m' :: Month
m',_) = Day -> (Integer, Month, Month)
toGregorian Day
today
periodShrink today :: Day
today (QuarterPeriod y :: Integer
y q :: Month
q)
| Month -> Month
forall a. Integral a => a -> a
quarterContainingMonth Month
thismonth Month -> Month -> Bool
forall a. Eq a => a -> a -> Bool
== Month
q = Integer -> Month -> Period
MonthPeriod Integer
y Month
thismonth
| Bool
otherwise = Integer -> Month -> Period
MonthPeriod Integer
y (Month -> Month
forall a. Num a => a -> a
firstMonthOfQuarter Month
q)
where (_,thismonth :: Month
thismonth,_) = Day -> (Integer, Month, Month)
toGregorian Day
today
periodShrink today :: Day
today (YearPeriod y :: Integer
y)
| Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
thisyear = Integer -> Month -> Period
QuarterPeriod Integer
y Month
thisquarter
| Bool
otherwise = Integer -> Month -> Period
QuarterPeriod Integer
y 1
where
(thisyear :: Integer
thisyear,thismonth :: Month
thismonth,_) = Day -> (Integer, Month, Month)
toGregorian Day
today
thisquarter :: Month
thisquarter = Month -> Month
forall a. Integral a => a -> a
quarterContainingMonth Month
thismonth
periodShrink today :: Day
today _ = Integer -> Period
YearPeriod Integer
y
where (y :: Integer
y,_,_) = Day -> (Integer, Month, Month)
toGregorian Day
today
mondayBefore :: Day -> Day
mondayBefore d :: Day
d = Integer -> Day -> Day
addDays (1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Month -> Integer
forall a. Integral a => a -> Integer
toInteger Month
wd) Day
d
where
(_,_,wd :: Month
wd) = Day -> (Integer, Month, Month)
toWeekDate Day
d
yearMonthContainingWeekStarting :: Day -> (Integer, Month)
yearMonthContainingWeekStarting weekstart :: Day
weekstart = (Integer
y,Month
m)
where
thu :: Day
thu = Integer -> Day -> Day
addDays 3 Day
weekstart
(y :: Integer
y,yd :: Month
yd) = Day -> (Integer, Month)
toOrdinalDate Day
thu
(m :: Month
m,_) = Bool -> Month -> (Month, Month)
dayOfYearToMonthAndDay (Integer -> Bool
isLeapYear Integer
y) Month
yd
quarterContainingMonth :: a -> a
quarterContainingMonth m :: a
m = (a
ma -> a -> a
forall a. Num a => a -> a -> a
-1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` 3 a -> a -> a
forall a. Num a => a -> a -> a
+ 1
firstMonthOfQuarter :: a -> a
firstMonthOfQuarter q :: a
q = (a
qa -> a -> a
forall a. Num a => a -> a -> a
-1)a -> a -> a
forall a. Num a => a -> a -> a
*3 a -> a -> a
forall a. Num a => a -> a -> a
+ 1
startOfFirstWeekInMonth :: Integer -> Month -> Day
startOfFirstWeekInMonth y :: Integer
y m :: Month
m
| Month
monthstartday Month -> Month -> Bool
forall a. Ord a => a -> a -> Bool
<= 4 = Day
mon
| Bool
otherwise = Integer -> Day -> Day
addDays 7 Day
mon
where
monthstart :: Day
monthstart = Integer -> Month -> Month -> Day
fromGregorian Integer
y Month
m 1
mon :: Day
mon = Day -> Day
mondayBefore Day
monthstart
(_,_,monthstartday :: Month
monthstartday) = Day -> (Integer, Month, Month)
toWeekDate Day
monthstart