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

fix: three more interval start date cases; add tests; cleanup [#2218]

Browse Source
This commit is contained in:
Simon Michael 2024-09-04 14:59:14 +01:00
parent c8b6ca7b70
commit 038ebd8c7a
5 changed files with 226 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -188,14 +188,20 @@ spansSpan :: [DateSpan] -> DateSpan
spansSpan spans = DateSpan (spanStartDate =<< headMay spans) (spanEndDate =<< lastMay spans)
-- | Split a DateSpan into consecutive exact spans of the specified Interval.
-- If the first argument is true and the interval is Weeks, Months, Quarters or Years,
-- the start date will be adjusted backward if needed to nearest natural interval boundary
-- (a monday, first of month, first of quarter or first of year).
-- If no interval is specified, the original span is returned.
-- If the original span is the null date span, ie unbounded, the null date span is returned.
-- If the original span is empty, eg if the end date is <= the start date, no spans are returned.
--
-- ==== Examples:
-- ==== Date adjustment
-- Some intervals respect the "adjust" flag (years, quarters, months, weeks, every Nth weekday
-- of month seem to be the ones that need it). This will move the start date earlier, if needed,
-- to the previous natural interval boundary (first of year, first of quarter, first of month,
-- monday, previous Nth weekday of month). Related: #1982 #2218
--
-- The end date is always moved later if needed to the next natural interval boundary,
-- so that the last period is the same length as the others.
--
-- ==== Examples
-- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ Flex $ fromGregorian y1 m1 d1) (Just $ Flex $ fromGregorian y2 m2 d2)
-- >>> t NoInterval 2008 01 01 2009 01 01
-- [DateSpan 2008]
@ -221,27 +227,25 @@ spansSpan spans = DateSpan (spanStartDate =<< headMay spans) (spanEndDate =<< la
-- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09]
-- >>> t (DaysOfWeek [2]) 2011 01 01 2011 01 15
-- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17]
-- >>> t (DayOfYear 11 29) 2011 10 01 2011 10 15
-- [DateSpan 2010-11-29..2011-11-28]
-- >>> t (DayOfYear 11 29) 2011 12 01 2012 12 15
-- [DateSpan 2011-11-29..2012-11-28,DateSpan 2012-11-29..2013-11-28]
-- >>> t (DayOfYear 11 29) 2012 10 01 2013 10 15
-- [DateSpan 2012-11-29..2013-11-28]
--
splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan]
splitSpan _ _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
splitSpan _ _ ds | isEmptySpan ds = []
splitSpan _ _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds]
splitSpan _ NoInterval ds = [ds]
splitSpan _ (Days n) ds = splitspan id addDays n ds
splitSpan adjust (Weeks n) ds = splitspan (if adjust then startofweek else id) addDays (7*n) ds
splitSpan adjust (Months n) ds = splitspan (if adjust then startofmonth else id) addGregorianMonthsClip n ds
splitSpan adjust (Quarters n) ds = splitspan (if adjust then startofquarter else id) addGregorianMonthsClip (3*n) ds
splitSpan adjust (Years n) ds = splitspan (if adjust then startofyear else id) addGregorianYearsClip n ds
splitSpan _ (DayOfMonth dom) ds = splitspan (nextnthdayofmonth dom) (addGregorianMonthsToMonthday dom) 1 ds
splitSpan _ (DayOfYear m n) ds = splitspan (nthdayofyearcontaining m n) (addGregorianYearsClip) 1 ds
splitSpan _ (WeekdayOfMonth n wd) ds = splitspan (nthweekdayofmonthcontaining n wd) advancemonths 1 ds
splitSpan _ _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
splitSpan _ _ ds | isEmptySpan ds = []
splitSpan _ _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds]
splitSpan _ NoInterval ds = [ds]
splitSpan _ (Days n) ds = splitspan id addDays n ds
splitSpan adjust (Weeks n) ds = splitspan (if adjust then startofweek else id) addDays (7*n) ds
splitSpan adjust (Months n) ds = splitspan (if adjust then startofmonth else id) addGregorianMonthsClip n ds
splitSpan adjust (Quarters n) ds = splitspan (if adjust then startofquarter else id) addGregorianMonthsClip (3*n) ds
splitSpan adjust (Years n) ds = splitspan (if adjust then startofyear else id) addGregorianYearsClip n ds
splitSpan _ (DayOfMonth dom) ds = splitspan (nextnthdayofmonth dom) (addGregorianMonthsToMonthday dom) 1 ds
splitSpan _ (DayOfYear m n) ds = splitspan (nextmonthandday m n) (addGregorianYearsClip) 1 ds
splitSpan adjust (WeekdayOfMonth n wd) ds = splitspan (if adjust then prevNthWeekdayOfMonth n wd else nextNthWeekdayOfMonth n wd) advancemonths 1 ds
where
advancemonths 0 = id
advancemonths w = advancetonthweekday n wd . startofmonth . addGregorianMonthsClip w
advancemonths m = advanceToNthWeekday n wd . startofmonth . addGregorianMonthsClip m
splitSpan _ (DaysOfWeek []) ds = [ds]
splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys
where
@ -260,16 +264,18 @@ addGregorianMonthsToMonthday dom n d =
in fromGregorian y m dom
-- Split the given span into exact spans using the provided helper functions:
-- 1. The start function is applied to the span's start date to get the first sub-span's start date.
-- 2. The addInterval function is used to calculate the subsequent spans' start dates,
-- possibly with stride increased by the mult multiplier.
-- It should handle spans of varying length, eg when splitting on "every 31st of month",
-- it adjusts to 28/29/30 in short months but returns to 31 in the long months.
--
-- 1. The start function is used to adjust the provided span's start date to get the first sub-span's start date.
--
-- 2. The next function is used to calculate subsequent sub-spans' start dates, possibly with stride increased by a multiplier.
-- It should handle spans of varying length, eg when splitting on "every 31st of month",
-- it adjusts to 28/29/30 in short months but returns to 31 in the long months.
--
splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
splitspan start addInterval mult ds = spansFromBoundaries e bdrys
splitspan start next mult ds = spansFromBoundaries e bdrys
where
(s, e) = dateSpanSplitLimits start (addInterval (toInteger mult)) ds
bdrys = mapM (addInterval . toInteger) [0,mult..] $ start s
(s, e) = dateSpanSplitLimits start (next (toInteger mult)) ds
bdrys = mapM (next . toInteger) [0,mult..] $ start s
-- | Fill in missing start/end dates for calculating 'splitSpan'.
dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
@ -620,7 +626,7 @@ startofquarter day = fromGregorian y (firstmonthofquarter m) 1
firstmonthofquarter m2 = ((m2-1) `div` 3) * 3 + 1
thisyear = startofyear
prevyear = startofyear . addGregorianYearsClip (-1)
-- prevyear = startofyear . addGregorianYearsClip (-1)
nextyear = startofyear . addGregorianYearsClip 1
startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
@ -632,40 +638,32 @@ intervalBoundaryBefore i d =
(DateSpan (Just start) _:_) -> fromEFDay start
_ -> d
-- | For given date d find year-long interval that starts on given
-- MM/DD of year and covers it.
-- The given MM and DD should be basically valid (1-12 & 1-31),
-- or an error is raised.
-- | Find the next occurrence of the specified month and day of month, on or after the given date.
-- The month should be 1-12 and the day of month should be 1-31, or an error will be raised.
--
-- Examples: lets take 2017-11-22. Year-long intervals covering it that
-- starts before Nov 22 will start in 2017. However
-- intervals that start after Nov 23rd should start in 2016:
-- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nthdayofyearcontaining 11 21 wed22nd
-- 2017-11-21
-- >>> nthdayofyearcontaining 11 22 wed22nd
-- >>> nextmonthandday 11 21 wed22nd
-- 2018-11-21
-- >>> nextmonthandday 11 22 wed22nd
-- 2017-11-22
-- >>> nthdayofyearcontaining 11 23 wed22nd
-- 2016-11-23
-- >>> nthdayofyearcontaining 12 02 wed22nd
-- 2016-12-02
-- >>> nthdayofyearcontaining 12 31 wed22nd
-- 2016-12-31
-- >>> nthdayofyearcontaining 1 1 wed22nd
-- 2017-01-01
nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day
nthdayofyearcontaining m mdy date
-- >>> nextmonthandday 11 23 wed22nd
-- 2017-11-23
nextmonthandday :: Month -> MonthDay -> Day -> Day
nextmonthandday m n date
-- PARTIAL:
| not (validMonth m) = error' $ "nthdayofyearcontaining: invalid month "++show m
| not (validDay mdy) = error' $ "nthdayofyearcontaining: invalid day " ++show mdy
| mmddOfSameYear <= date = mmddOfSameYear
| otherwise = mmddOfPrevYear
where mmddOfSameYear = addDays (toInteger mdy-1) $ applyN (m-1) nextmonth s
mmddOfPrevYear = addDays (toInteger mdy-1) $ applyN (m-1) nextmonth $ prevyear s
s = startofyear date
| not (validMonth m) = error' $ "nextmonthandday: month should be 1..12, not "++show m
| not (validDay n) = error' $ "nextmonthandday: day should be 1..31, not " ++show n
| mdthisyear >= date = mdthisyear
| otherwise = mdnextyear
where
s = startofyear date
advancetomonth = applyN (m-1) nextmonth
advancetoday = addDays (toInteger n-1)
mdthisyear = advancetoday $ advancetomonth s
mdnextyear = advancetoday $ advancetomonth $ nextyear s
-- | Find the next occurence of the specified "nth day of month" that occurs on or after the given date.
-- The nth day of month should be in the range 1-31, or an error will be raised.
-- | Find the next occurrence of the specified day of month, on or after the given date.
-- The day of month should be 1-31, or an error will be raised.
--
-- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nextnthdayofmonth 21 wed22nd
@ -709,37 +707,66 @@ nthdayofweekcontaining n d | nthOfSameWeek <= d = nthOfSameWeek
nthOfPrevWeek = addDays (toInteger n-1) $ prevweek s
s = startofweek d
-- | For given date d find month-long interval that starts on nth weekday of month
-- and covers it.
--
-- Examples: 2017-11-22 is 3rd Wed of Nov. Month-long intervals that cover it and
-- start on 1st-4th Wed will start in Nov. However
-- intervals that start on 4th Thu or Fri or later should start in Oct:
-- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nthweekdayofmonthcontaining 1 3 wed22nd
-- 2017-11-01
-- >>> nthweekdayofmonthcontaining 3 2 wed22nd
-- 2017-11-21
-- >>> nthweekdayofmonthcontaining 4 3 wed22nd
-- 2017-11-22
-- >>> nthweekdayofmonthcontaining 4 4 wed22nd
-- 2017-10-26
-- >>> nthweekdayofmonthcontaining 4 5 wed22nd
-- 2017-10-27
nthweekdayofmonthcontaining :: Int -> WeekDay -> Day -> Day
nthweekdayofmonthcontaining n wd d | nthWeekdaySameMonth <= d = nthWeekdaySameMonth
| otherwise = nthWeekdayPrevMonth
where nthWeekdaySameMonth = advancetonthweekday n wd $ startofmonth d
nthWeekdayPrevMonth = advancetonthweekday n wd $ prevmonth d
-- -- | Find the next occurrence of some weekday, on or after the given date d.
-- --
-- -- >>> let wed22nd = fromGregorian 2017 11 22
-- -- >>> nextnthdayofweek 1 wed22nd
-- -- 2017-11-20
-- -- >>> nextnthdayofweek 2 wed22nd
-- -- 2017-11-21
-- -- >>> nextnthdayofweek 3 wed22nd
-- -- 2017-11-22
-- -- >>> nextnthdayofweek 4 wed22nd
-- -- 2017-11-16
-- -- >>> nextnthdayofweek 5 wed22nd
-- -- 2017-11-17
-- nextdayofweek :: WeekDay -> Day -> Day
-- nextdayofweek n d | nthOfSameWeek <= d = nthOfSameWeek
-- | otherwise = nthOfPrevWeek
-- where nthOfSameWeek = addDays (toInteger n-1) s
-- nthOfPrevWeek = addDays (toInteger n-1) $ prevweek s
-- s = startofweek d
-- | Advance to nth weekday wd after given start day s
-- | Find the next occurrence of some nth weekday of a month, on or after the given date d.
--
-- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> nextNthWeekdayOfMonth 3 3 wed22nd -- next third wednesday
-- 2017-12-20
-- >>> nextNthWeekdayOfMonth 4 3 wed22nd -- next fourth wednesday
-- 2017-11-22
-- >>> nextNthWeekdayOfMonth 5 3 wed22nd -- next fifth wednesday
-- 2017-11-29
nextNthWeekdayOfMonth :: Int -> WeekDay -> Day -> Day
nextNthWeekdayOfMonth n wd d
| nthweekdaythismonth >= d = nthweekdaythismonth
| otherwise = nthweekdaynextmonth
where
nthweekdaythismonth = advanceToNthWeekday n wd $ startofmonth d
nthweekdaynextmonth = advanceToNthWeekday n wd $ nextmonth d
-- | Find the previous occurrence of some nth weekday of a month, on or before the given date d.
--
-- >>> let wed22nd = fromGregorian 2017 11 22
-- >>> prevNthWeekdayOfMonth 4 3 wed22nd
-- 2017-11-22
-- >>> prevNthWeekdayOfMonth 5 2 wed22nd
-- 2017-10-31
prevNthWeekdayOfMonth :: Int -> WeekDay -> Day -> Day
prevNthWeekdayOfMonth n wd d
| nthweekdaythismonth <= d = nthweekdaythismonth
| otherwise = nthweekdayprevmonth
where
nthweekdaythismonth = advanceToNthWeekday n wd $ startofmonth d
nthweekdayprevmonth = advanceToNthWeekday n wd $ prevmonth d
-- | Advance to the nth occurrence of the given weekday, on or after the given date.
-- Can call error.
advancetonthweekday :: Int -> WeekDay -> Day -> Day
advancetonthweekday n wd s =
advanceToNthWeekday :: Int -> WeekDay -> Day -> Day
advanceToNthWeekday n wd s =
-- PARTIAL:
maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s
where
err = error' "advancetonthweekday: should not happen"
err = error' "advanceToNthWeekday: should not happen"
addWeeks k = addDays (7 * toInteger k)
firstMatch p = headMay . dropWhile (not . p)
firstweekday = addDays (toInteger wd-1) . startofweek

8
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

@ -142,10 +142,6 @@ instance Show PeriodicTransaction where
-- <BLANKLINE>
--
-- >>> _ptgen "every 2nd Thursday of month from 2017/1 to 2017/4"
-- 2016-12-08
-- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4
-- a $1.00
-- <BLANKLINE>
-- 2017-01-12
-- ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4
-- a $1.00
@ -160,10 +156,6 @@ instance Show PeriodicTransaction where
-- <BLANKLINE>
--
-- >>> _ptgen "every nov 29th from 2017 to 2019"
-- 2016-11-29
-- ; generated-transaction: ~ every nov 29th from 2017 to 2019
-- a $1.00
-- <BLANKLINE>
-- 2017-11-29
-- ; generated-transaction: ~ every nov 29th from 2017 to 2019
-- a $1.00

4
hledger/hledger.m4.md
View File

@ -4822,7 +4822,7 @@ Monthly on a custom day:
- `every Nth day [of month]` (`31st day` will be adjusted to each month's last day)
- `every Nth WEEKDAYNAME [of month]`
Yearly on a custom day:
Yearly on a custom month and day:
- `every MM/DD [of year]` (month number and day of month number)
- `every MONTHNAME DDth [of year]` (full or three-letter english month name, case insensitive, and day of month number)
@ -5210,7 +5210,7 @@ $ hledger print --forecast --today=2023/4/21
expenses:rent $1000
```
Here there are no ordinary transactions, so the forecasted transactions begin on the first occurence after today's date.
Here there are no ordinary transactions, so the forecasted transactions begin on the first occurrence after today's date.
(You won't normally use `--today`; it's just to make these examples reproducible.)
## Forecast reports

2
hledger/test/cli/date-options.test
View File

@ -78,7 +78,7 @@ $ hledger -f- reg date:2019-01-01-2019-02-01
$ hledger -f- reg date:2019-01-2019-02
2019-01-01 (a) 2 2
# ** 0. A "every Nth day (of month)" periodic rule will generate occurences only after the start date. (#2218)
# ** 0. A "every Nth day (of month)" periodic rule will generate occurrences only after the start date. (#2218)
<
~ every 31st day from 2024-07 to 2024-09
(a) 1

111
hledger/test/register/intervals.test
View File

@ -136,3 +136,114 @@ $ hledger -f- register --monthly
$ hledger -f- register -p monthly
2019-01 a 2 2
2019-02 a 1 3
# ** Date adjustment/clipping, with various intervals, of periodic reports and periodic transactions.
# With periodic reports generally:
# Start dates should be within the specified report period.
# If start date is unspecifed, it should be the inferred start date adjusted to a natural boundary.
# The end date should be adjusted so that the last period has equal length.
# With periodic transactions generally:
# All occurrences should be within the specified report period.
# If start date is unspecifed, it should be the inferred start date adjusted to a natural boundary.
# The end date should be adjusted so that the gap before last occurrence has equal length. (?)
# ** 13. every Nth day of month from DATE.
<
2024-01-02
(monthly1/02) 1
2024-01-10
(monthly1/10) 1
2024-02-20
(monthly2/20) 1
2024-02-24
(monthly2/24) 1
$ hledger -f- reg monthly -p 'every 5th day of month from 2024/1/5 to 2024/2/14'
2024-01-05..2024-02-04 monthly1/10 1 1
2024-02-05..2024-03-04 monthly2/20 1 2
monthly2/24 1 3
# ** 14. every Nth day of month from DATE, periodic transactions. #2218, fixed in 1.40.
<
~ every 31st day from 2024-07 to 2024-09
(a) 1
$ hledger -f- reg --forecast=2024
2024-07-31 (a) 1 1
2024-08-31 (a) 1 2
# ** 15. every M/D from DATE. Fixed in 1.40.
<
2023-01-10
(yearly2023/1/10) 1
2024-01-10
(yearly2024/1/10) 1
2025-01-10
(yearly2025/1/10) 1
2026-01-10
(yearly2026/1/10) 1
$ hledger -f- reg yearly -p 'every 1/20 from 2024 to 2026'
2024-01-20..2025-01-19 yearly2025/1/10 1 1
2025-01-20..2026-01-19 yearly2026/1/10 1 2
# ** 16. every M/D from DATE, periodic transactions. Fixed in 1.40.
<
~ every 14th February from 2024 to 2026
(yearly) 1
$ hledger -f- reg yearly --forecast=2022-2027
2024-02-14 (yearly) 1 1
2025-02-14 (yearly) 1 2
# ** 17. every Nth WEEKDAY, inferred start date.
# The start date is adjusted to 2023/12/11, encompassing the 2024/1/1 posting.
<
2024-01-01
(mondays2024/01/01) 1
2024-01-08
(mondays2024/01/08) 1
2024-01-15
(mondays2024/01/15) 1
2024-02-05
(mondays2024/02/05) 1
2024-02-12
(mondays2024/02/12) 1
2024-02-19
(mondays2024/02/19) 1
$ hledger -f- reg mondays -p 'every 2nd monday'
2023-12-11..2024-01-07 mondays2024/01/01 1 1
2024-01-08..2024-02-11 mondays2024/01/08 1 2
mondays2024/01/15 1 3
mondays2024/02/05 1 4
2024-02-12..2024-03-10 mondays2024/02/12 1 5
mondays2024/02/19 1 6
# ** 18. every Nth WEEKDAY from DATE. Fixed in 1.40.
$ hledger -f- reg mondays -p 'every 2nd monday from 2024/1/5 to 2024/2'
2024-01-08..2024-02-11 mondays2024/01/08 1 1
mondays2024/01/15 1 2
mondays2024/02/05 1 3
# ** 19. every Nth WEEKDAY from DATE, periodic transactions.
<
~ every 2nd monday from 2024/1/5 to 2024/3
(mondays) 1
$ hledger -f- reg mondays --forecast=2024
2024-01-08 (mondays) 1 1
2024-02-12 (mondays) 1 2