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

Merge LW's branch '1517-every-weekday', with some added SM doc edits.

hledger-lib/Hledger/Data.hs

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

hledger-lib/Hledger/Data/Dates.hs

@@ -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
+    | otherwise = splitspan' (repeat start) (repeat next) span
-    where
+
-      splitspan' start next (DateSpan (Just s) (Just e))
+splitspan' :: [Day -> Day] -> [Day -> Day] -> DateSpan -> [DateSpan]
-          | s >= e = []
+splitspan' (start:ss) (next:ns) (DateSpan (Just s) (Just e))
-          | otherwise = DateSpan (Just subs) (Just sube) : splitspan' start next (DateSpan (Just sube) (Just e))
+    | s >= e = []
-          where subs = start s
+    | otherwise = DateSpan (Just subs) (Just sube) : splitspan' ss ns (DateSpan (Just sube) (Just e))
-                sube = next subs
+    where subs = start s
-      splitspan' _ _ _ = error' "won't happen, avoids warnings"  -- PARTIAL:
+          sube = next subs
+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]
+
+  ]

hledger-lib/Hledger/Data/Types.hs

@@ -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

hledger/hledger.m4.md

@@ -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`), 

hledger/test/forecast.test

@@ -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