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

feat: periodexpr: support weekday, weekendday, multiple weekdays (#1632, Lawrence Wu)

Browse Source 
Merge LW's branch '1517-every-weekday', with some added SM doc edits.
This commit is contained in:
Simon Michael 2021-08-20 17:02:58 -10:00
commit 780c50672c
5 changed files with 170 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
hledger-lib/Hledger/Data.hs
View File

@ -54,6 +54,7 @@ import Hledger.Utils.Test
tests_Data = tests "Data" [
tests_AccountName
,tests_Amount
,tests_Dates
,tests_Journal
,tests_Ledger
,tests_Posting

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

@ -73,6 +73,8 @@ module Hledger.Data.Dates (
yearp,
daysInSpan,
maybePeriod,
tests_Dates
)
where
@ -193,7 +195,7 @@ spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Noth
-- [DateSpan 2007-12-02..2008-01-01,DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01]
-- >>> t (WeekdayOfMonth 2 4) 2011 01 01 2011 02 15
-- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09]
-- >>> t (DayOfWeek 2) 2011 01 01 2011 01 15
-- >>> 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]
@ -211,7 +213,19 @@ splitSpan (Quarters n) s = splitspan startofquarter (applyN n nextquarter) s
splitSpan (Years n) s = splitspan startofyear (applyN n nextyear) s
splitSpan (DayOfMonth n) s = splitspan (nthdayofmonthcontaining n) (nthdayofmonth n . nextmonth) s
splitSpan (WeekdayOfMonth n wd) s = splitspan (nthweekdayofmonthcontaining n wd) (advancetonthweekday n wd . nextmonth) s
splitSpan (DayOfWeek n) s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s
splitSpan (DaysOfWeek []) s = [s] -- shouldn't happen in parser but for completeness
splitSpan (DaysOfWeek days@(n:_)) ds
| DateSpan Nothing (Just e) <- ds = split (DateSpan (Just $ start e) (Just $ nextday $ start e))
| DateSpan (Just s) Nothing <- ds = split (DateSpan (Just $ start s) (Just $ nextday $ start s))
| DateSpan (Just s) (Just e) <- ds =
if s == e then [ds] else split (DateSpan (Just $ start s) (Just e))
where
start = nthdayofweekcontaining n
wheel = (\x -> zipWith (-) (tail x) x) . concat . zipWith fmap (fmap (+) [0,7..]) . repeat $ days
split = splitspan' (repeat startofday) (fmap (flip applyN nextday) wheel)
splitSpan (DayOfYear m n) s = splitspan (nthdayofyearcontaining m n) (applyN (n-1) nextday . applyN (m-1) nextmonth . nextyear) s
-- splitSpan (WeekOfYear n) s = splitspan startofweek (applyN n nextweek) s
-- splitSpan (MonthOfYear n) s = splitspan startofmonth (applyN n nextmonth) s
@ -226,14 +240,15 @@ splitspan start next (DateSpan Nothing (Just e)) = splitspan start next (DateSpa
splitspan start next (DateSpan (Just s) Nothing) = splitspan start next (DateSpan (Just $ start s) (Just $ next $ start s))
splitspan start next span@(DateSpan (Just s) (Just e))
| s == e = [span]
| otherwise = splitspan' start next span
where
splitspan' start next (DateSpan (Just s) (Just e))
| otherwise = splitspan' (repeat start) (repeat next) span
splitspan' :: [Day -> Day] -> [Day -> Day] -> DateSpan -> [DateSpan]
splitspan' (start:ss) (next:ns) (DateSpan (Just s) (Just e))
| s >= e = []
| otherwise = DateSpan (Just subs) (Just sube) : splitspan' start next (DateSpan (Just sube) (Just e))
| otherwise = DateSpan (Just subs) (Just sube) : splitspan' ss ns (DateSpan (Just sube) (Just e))
where subs = start s
sube = next subs
splitspan' _ _ _ = error' "won't happen, avoids warnings" -- PARTIAL:
splitspan' _ _ _ = error' "won't happen, avoids warnings" -- PARTIAL:
-- | Count the days in a DateSpan, or if it is open-ended return Nothing.
daysInSpan :: DateSpan -> Maybe Integer
@ -824,6 +839,9 @@ weekday = do
[] -> Fail.fail $ "weekday: should not happen: attempted to find " <>
show wday <> " in " <> show (weekdays ++ weekdayabbrevs)
weekdaysp :: TextParser m [Int]
weekdaysp = fmap head . groupBy (==) . sort <$> sepBy1 weekday (string' ",")
-- | Parse a period expression, specifying a date span and optionally
-- a reporting interval. Requires a reference "today" date for
-- resolving any relative start/end dates (only; it is not needed for
@ -867,9 +885,9 @@ weekday = do
-- >>> p "every 1st monday of month to 2009"
-- Right (WeekdayOfMonth 1 1,DateSpan ..2008-12-31)
-- >>> p "every tue"
-- Right (DayOfWeek 2,DateSpan ..)
-- Right (DaysOfWeek [2],DateSpan ..)
-- >>> p "every 2nd day of week"
-- Right (DayOfWeek 2,DateSpan ..)
-- Right (DaysOfWeek [2],DateSpan ..)
-- >>> p "every 2nd day of month"
-- Right (DayOfMonth 2,DateSpan ..)
-- >>> p "every 2nd day"
@ -898,7 +916,6 @@ intervalanddateperiodexprp rdate = do
reportingintervalp :: TextParser m Interval
reportingintervalp = choice'
[ tryinterval "day" "daily" Days
, tryinterval "week" "weekly" Weeks
, tryinterval "month" "monthly" Months
, tryinterval "quarter" "quarterly" Quarters
, tryinterval "year" "yearly" Years
@ -906,13 +923,20 @@ reportingintervalp = choice'
, Weeks 2 <$ string' "fortnightly"
, Months 2 <$ string' "bimonthly"
, string' "every" *> skipNonNewlineSpaces *> choice'
[ DayOfWeek <$> (nth <* skipNonNewlineSpaces <* string' "day" <* of_ "week")
[ DaysOfWeek . pure <$> (nth <* skipNonNewlineSpaces <* string' "day" <* of_ "week")
, DayOfMonth <$> (nth <* skipNonNewlineSpaces <* string' "day" <* optOf_ "month")
, liftA2 WeekdayOfMonth nth $ skipNonNewlineSpaces *> weekday <* optOf_ "month"
, uncurry DayOfYear <$> (md <* optOf_ "year")
, DayOfWeek <$> weekday
, DaysOfWeek <$> weekdaysp
, DaysOfWeek [1..5] <$ string' "weekday"
, DaysOfWeek [6..7] <$ string' "weekendday"
, d_o_y <* optOf_ "year"
]
-- NB: the ordering is important here since the parse for `every weekday`
-- would match the `tryinterval` first and then error on `d`. Perhaps it
-- would be clearer to factor some of this into the `every` choice or other
-- left-factorings.
, tryinterval "week" "weekly" Weeks
]
where
of_ period =
@ -1009,3 +1033,45 @@ emptydatespan = DateSpan (Just $ addDays 1 nulldate) (Just nulldate)
nulldate :: Day
nulldate = fromGregorian 0 1 1
-- tests
tests_Dates = tests "Dates"
[ test "weekday" $ do
splitSpan (DaysOfWeek [1..5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08))
@?= [ (DateSpan (Just $ fromGregorian 2021 06 28) (Just $ fromGregorian 2021 06 29))
, (DateSpan (Just $ fromGregorian 2021 06 29) (Just $ fromGregorian 2021 06 30))
, (DateSpan (Just $ fromGregorian 2021 06 30) (Just $ fromGregorian 2021 07 01))
, (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 02))
, (DateSpan (Just $ fromGregorian 2021 07 02) (Just $ fromGregorian 2021 07 05))
-- next week
, (DateSpan (Just $ fromGregorian 2021 07 05) (Just $ fromGregorian 2021 07 06))
, (DateSpan (Just $ fromGregorian 2021 07 06) (Just $ fromGregorian 2021 07 07))
, (DateSpan (Just $ fromGregorian 2021 07 07) (Just $ fromGregorian 2021 07 08))
]
splitSpan (DaysOfWeek [1, 5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08))
@?= [ (DateSpan (Just $ fromGregorian 2021 06 28) (Just $ fromGregorian 2021 07 02))
, (DateSpan (Just $ fromGregorian 2021 07 02) (Just $ fromGregorian 2021 07 05))
-- next week
, (DateSpan (Just $ fromGregorian 2021 07 05) (Just $ fromGregorian 2021 07 09))
]
, test "match dayOfWeek" $ do
let dayofweek n s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s
match ds day = dayofweek day ds == splitSpan (DaysOfWeek [day]) ds @?= True
ys2021 = fromGregorian 2021 01 01
ye2021 = fromGregorian 2021 12 31
ys2022 = fromGregorian 2022 01 01
mapM_ (match (DateSpan (Just ys2021) (Just ye2021))) [1..7]
mapM_ (match (DateSpan (Just ys2021) (Just ys2022))) [1..7]
mapM_ (match (DateSpan (Just ye2021) (Just ys2022))) [1..7]
mapM_ (match (DateSpan (Just ye2021) Nothing)) [1..7]
mapM_ (match (DateSpan (Just ys2022) Nothing)) [1..7]
mapM_ (match (DateSpan Nothing (Just ye2021))) [1..7]
mapM_ (match (DateSpan Nothing (Just ys2022))) [1..7]
]

2
hledger-lib/Hledger/Data/Types.hs
View File

@ -121,7 +121,7 @@ data Interval =
| Years Int
| DayOfMonth Int
| WeekdayOfMonth Int Int
| DayOfWeek Int
| DaysOfWeek [Int]
| DayOfYear Int Int -- Month, Day
-- WeekOfYear Int
-- MonthOfYear Int

33
hledger/hledger.m4.md
View File

@ -710,6 +710,39 @@ Group postings from the start of wednesday to end of the following tuesday (N is
$ hledger register checking -p "every 3rd day of week"
```
### Periods or dates ?
Report intervals like the above are most often used with `-p|--period`,
to divide reports into multiple subperiods -
each generated date marks a subperiod boundary.
Here, the periods between the dates are what's important.
But report intervals can also be used
with `--forecast` to generate future transactions,
or with `balance --budget` to generate budget goal-setting transactions.
For these, the dates themselves are what matters.
### Events on multiple weekdays
The `every WEEKDAYNAME` form has a special variant with multiple day names, comma-separated.
Eg: `every mon,thu,sat`.
Also, `weekday` and `weekendday` are shorthand for `mon,tue,wed,thu,fri` and `sat,sun`
respectively.
This form is mainly intended for use with `--forecast`, to generate
[periodic transactions](#periodic-transactions) on arbitrary days of the week.
It may be less useful with `-p`, since it divides each week into subperiods
of unequal length. (Because gaps between periods are not allowed;
if you'd like to change this, see [#1632](https://github.com/simonmichael/hledger/pull/1632).)
Examples:
| | |
|------------------------------|----------------------------------------------------------------------------------------|
| `-p "every mon,wed,fri"` | dates will be Mon, Wed, Fri; <br>periods will be Mon-Tue, Wed-Thu, Fri-Sun |
| `-p "every weekday"` | dates will be Mon, Tue, Wed, Thu, Fri; <br>periods will be Mon, Tue, Wed, Thu, Fri-Sun |
| `-p "every weekendday"` | dates will be Sat, Sun; <br>periods will be Sat, Sun-Fri |
# DEPTH
With the `--depth NUM` option (short form: `-NUM`),

54
hledger/test/forecast.test
View File

@ -268,3 +268,57 @@ hledger -f - print -x --forecast -e 2021-11
>>>2
>>>=0
# 13. Generated forecast for weekday transactions
hledger -f - reg --forecast -b "2021-09-01" -e "2021-09-15" --forecast -w 100
<<<
2021-08-01
(a) 0
~ every weekday
income:client1 -10 USD
assets:receivables:contractor1
>>>
2021-09-01 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-02 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-03 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-06 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-07 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-08 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-09 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-10 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-13 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-14 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
>>>2
>>>=0
# 14. Generated forecast for weekend transactions
hledger -f - reg --forecast -b "2021-09-01" -e "2021-09-15" --forecast -w 100
<<<
2021-08-01
(a) 0
~ every weekendday
income:client1 -10 USD
assets:receivables:contractor1
>>>
2021-09-04 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-05 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-11 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
2021-09-12 income:client1 -10 USD -10 USD
assets:receivables:contractor1 10 USD 0
>>>2
>>>=0