fix: show a week period beginning in the previous year correctly [#2304]

Eg the week beginning 2024-12-30 (which is week 1 of 2025 because the
thursday falls in 2025) was previously shown as 2024-W01, now 2025-W01.
This commit is contained in:
Simon Michael 2024-12-20 10:01:16 -10:00
parent e71e8a8711
commit c23087f124
2 changed files with 13 additions and 2 deletions

View File

@ -218,7 +218,7 @@ spansSpan spans = DateSpan (spanStartDate =<< headMay spans) (spanEndDate =<< la
-- >>> t (Months 2) 2008 01 01 2008 04 01
-- [DateSpan 2008-01-01..2008-02-29,DateSpan 2008-03-01..2008-04-30]
-- >>> t (Weeks 1) 2008 01 01 2008 01 15
-- [DateSpan 2007-W01,DateSpan 2008-W02,DateSpan 2008-W03]
-- [DateSpan 2008-W01,DateSpan 2008-W02,DateSpan 2008-W03]
-- >>> t (Weeks 2) 2008 01 01 2008 01 15
-- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27]
-- >>> t (MonthDay 2) 2008 01 01 2008 04 01
@ -252,6 +252,7 @@ splitSpan _ (DaysOfWeek []) ds = [ds]
splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys
where
(s, e) = dateSpanSplitLimits (nthdayofweekcontaining n) nextday ds
-- can't show this when debugging, it'll hang:
bdrys = concatMap (flip map starts . addDays) [0,7..]
-- The first representative of each weekday
starts = map (\d -> addDays (toInteger $ d - n) $ nthdayofweekcontaining n s) days

View File

@ -26,6 +26,7 @@ module Hledger.Data.Period (
,periodGrow
,periodShrink
,mondayBefore
,thursdayOfWeekContaining
,yearMonthContainingWeekStarting
,quarterContainingMonth
,firstMonthOfQuarter
@ -174,9 +175,14 @@ periodTextWidth = periodTextWidth' . simplifyPeriod
--
-- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))
-- "2016-W30"
-- >>> showPeriod (WeekPeriod (fromGregorian 2024 12 30))
-- "2025-W01"
showPeriod :: Period -> Text
showPeriod (DayPeriod b) = T.pack $ formatTime defaultTimeLocale "%F" b -- DATE
showPeriod (WeekPeriod b) = T.pack $ formatTime defaultTimeLocale "%0Y-W%V" b -- YYYY-Www
showPeriod (WeekPeriod b) = T.pack $ y <> "-W" <> w -- YYYY-Www
where
y = formatTime defaultTimeLocale "%0Y" $ thursdayOfWeekContaining b -- be careful at year boundary
w = formatTime defaultTimeLocale "%V" b
showPeriod (MonthPeriod y m) = T.pack $ printf "%04d-%02d" y m -- YYYY-MM
showPeriod (QuarterPeriod y q) = T.pack $ printf "%04dQ%d" y q -- YYYYQN
showPeriod (YearPeriod y) = T.pack $ printf "%04d" y -- YYYY
@ -190,6 +196,8 @@ showPeriod PeriodAll = ".."
-- an abbreviated form.
-- >>> showPeriodAbbrev (WeekPeriod (fromGregorian 2016 7 25))
-- "W30"
-- >>> showPeriodAbbrev (WeekPeriod (fromGregorian 2024 12 30))
-- "W01"
showPeriodAbbrev :: Period -> Text
showPeriodAbbrev (MonthPeriod _ m) -- Jan
| m > 0 && m <= length monthnames = T.pack . snd $ monthnames !! (m-1)
@ -325,6 +333,8 @@ mondayBefore d = addDays (1 - toInteger wd) d
where
(_,_,wd) = toWeekDate d
thursdayOfWeekContaining = (addDays 3).mondayBefore
yearMonthContainingWeekStarting weekstart = (y,m)
where
thu = addDays 3 weekstart