slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
hledger-lib/Hledger/Data/Dates.hs
View File

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

12
hledger-lib/Hledger/Data/Period.hs
View File

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