imp: journal: periodic txns need not start on an interval boundary

Eg, ~ monthly from 1/15 now works, instead of giving an error message.

hledger-lib/Hledger/Data/Dates.hs

@@ -165,20 +165,21 @@ spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian)) [ma,mb]
 spansSpan :: [DateSpan] -> DateSpan
 spansSpan spans = DateSpan (spanStart =<< headMay spans) (spanEnd =<< lastMay spans)
 
--- | Split a DateSpan into consecutive whole spans of the specified interval
+-- | Split a DateSpan into consecutive spans of the specified Interval.
--- which fully encompass the original span (and a little more when necessary).
+-- 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:
--- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan i $ DateSpan (Just $ fromGregorian y1 m1 d1) (Just $ fromGregorian y2 m2 d2)
+-- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ fromGregorian y1 m1 d1) (Just $ fromGregorian y2 m2 d2)
 -- >>> t NoInterval 2008 01 01 2009 01 01
 -- [DateSpan 2008]
 -- >>> t (Quarters 1) 2008 01 01 2009 01 01
 -- [DateSpan 2008Q1,DateSpan 2008Q2,DateSpan 2008Q3,DateSpan 2008Q4]
--- >>> splitSpan (Quarters 1) nulldatespan
+-- >>> splitSpan True (Quarters 1) nulldatespan
 -- [DateSpan ..]
 -- >>> t (Days 1) 2008 01 01 2008 01 01  -- an empty datespan
 -- []
@@ -203,24 +204,24 @@ spansSpan spans = DateSpan (spanStart =<< headMay spans) (spanEnd =<< lastMay sp
 -- >>> t (DayOfYear 11 29) 2011 12 01 2012 12 15
 -- [DateSpan 2011-11-29..2012-11-28,DateSpan 2012-11-29..2013-11-28]
 --
-splitSpan :: Interval -> DateSpan -> [DateSpan]
+splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan]
-splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
+splitSpan _ _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
-splitSpan _ ds | isEmptySpan ds = []
+splitSpan _ _ ds | isEmptySpan ds = []
-splitSpan _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds]
+splitSpan _ _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds]
-splitSpan NoInterval      ds = [ds]
+splitSpan _ NoInterval ds = [ds]
-splitSpan (Days n)        ds = splitspan startofday     addDays n                    ds
+splitSpan _ (Days n) ds = splitspan id addDays n                    ds
-splitSpan (Weeks n)       ds = splitspan startofweek    addDays (7*n)                ds
+splitSpan adjust (Weeks n)    ds = splitspan (if adjust then startofweek    else id) addDays (7*n)                ds
-splitSpan (Months n)      ds = splitspan startofmonth   addGregorianMonthsClip n     ds
+splitSpan adjust (Months n)   ds = splitspan (if adjust then startofmonth   else id) addGregorianMonthsClip n     ds
-splitSpan (Quarters n)    ds = splitspan startofquarter addGregorianMonthsClip (3*n) ds
+splitSpan adjust (Quarters n) ds = splitspan (if adjust then startofquarter else id) addGregorianMonthsClip (3*n) ds
-splitSpan (Years n)       ds = splitspan startofyear    addGregorianYearsClip n      ds
+splitSpan adjust (Years n)    ds = splitspan (if adjust then startofyear    else id) addGregorianYearsClip n      ds
-splitSpan (DayOfMonth n)  ds = splitspan (nthdayofmonthcontaining n)  addGregorianMonthsClip 1 ds
+splitSpan _ (DayOfMonth n)  ds = splitspan (nthdayofmonthcontaining n)  addGregorianMonthsClip 1 ds
-splitSpan (DayOfYear m n) ds = splitspan (nthdayofyearcontaining m n) addGregorianYearsClip 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 _ (WeekdayOfMonth n wd) ds = splitspan (nthweekdayofmonthcontaining n wd) advancemonths 1 ds
   where
     advancemonths 0 = id
     advancemonths w = advancetonthweekday n wd . startofmonth . addGregorianMonthsClip w
-splitSpan (DaysOfWeek [])         ds = [ds]
+splitSpan _ (DaysOfWeek [])         ds = [ds]
-splitSpan (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys
+splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys
   where
     (s, e) = dateSpanSplitLimits (nthdayofweekcontaining n) nextday ds
     bdrys = concatMap (flip map starts . addDays) [0,7..]
@@ -520,7 +521,6 @@ fixSmartDate refdate = fix
 prevday :: Day -> Day
 prevday = addDays (-1)
 nextday = addDays 1
-startofday = id
 
 thisweek = startofweek
 prevweek = startofweek . addDays (-7)
@@ -547,10 +547,11 @@ prevyear = startofyear . addGregorianYearsClip (-1)
 nextyear = startofyear . addGregorianYearsClip 1
 startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
 
--- Get the natural start for the given interval that falls on or before the given day.
+-- Get the natural start for the given interval that falls on or before the given day,
+-- when applicable. Works for Weeks, Months, Quarters, Years, eg.
 intervalBoundaryBefore :: Interval -> Day -> Day
-intervalBoundaryBefore int d =
+intervalBoundaryBefore i d =
-  case splitSpan int (DateSpan (Just d) (Just $ addDays 1 d)) of
+  case splitSpan True i (DateSpan (Just d) (Just $ addDays 1 d)) of
     (DateSpan (Just start) _:_) -> start
     _ -> d
 
@@ -1061,7 +1062,7 @@ nulldate = fromGregorian 0 1 1
 
 tests_Dates = testGroup "Dates"
   [ testCase "weekday" $ do
-      splitSpan (DaysOfWeek [1..5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08))
+      splitSpan False (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))
@@ -1073,7 +1074,7 @@ tests_Dates = testGroup "Dates"
             , (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))
+      splitSpan False (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
@@ -1082,7 +1083,7 @@ tests_Dates = testGroup "Dates"
 
   , testCase "match dayOfWeek" $ do
       let dayofweek n = splitspan (nthdayofweekcontaining n) (\w -> (if w == 0 then id else applyN (n-1) nextday . applyN (fromInteger w) nextweek)) 1
-          matchdow ds day = splitSpan (DaysOfWeek [day]) ds @?= dayofweek day ds
+          matchdow ds day = splitSpan False (DaysOfWeek [day]) ds @?= dayofweek day ds
           ys2021 = fromGregorian 2021 01 01
           ye2021 = fromGregorian 2021 12 31
           ys2022 = fromGregorian 2022 01 01

hledger-lib/Hledger/Data/PeriodicTransaction.hs

@@ -11,6 +11,7 @@ module Hledger.Data.PeriodicTransaction (
 )
 where
 
+import Data.Maybe (isNothing)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Text.Printf
@@ -20,7 +21,6 @@ import Hledger.Data.Dates
 import Hledger.Data.Amount
 import Hledger.Data.Posting (post, commentAddTagNextLine)
 import Hledger.Data.Transaction
-import Hledger.Utils
 
 -- $setup
 -- >>> :set -XOverloadedStrings
@@ -33,25 +33,19 @@ _ptgen str = do
   let
     t = T.pack str
     (i,s) = parsePeriodExpr' nulldate t
-  case checkPeriodicTransactionStartDate i s t of
+  mapM_ (T.putStr . showTransaction) $
-    Just e  -> error' e  -- PARTIAL:
+    runPeriodicTransaction
-    Nothing ->
+      nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
-      mapM_ (T.putStr . showTransaction) $
+      nulldatespan
-        runPeriodicTransaction
-          nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
-          nulldatespan
 
 _ptgenspan str spn = do
   let
     t = T.pack str
     (i,s) = parsePeriodExpr' nulldate t
-  case checkPeriodicTransactionStartDate i s t of
+  mapM_ (T.putStr . showTransaction) $
-    Just e  -> error' e  -- PARTIAL:
+    runPeriodicTransaction
-    Nothing ->
+      nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
-      mapM_ (T.putStr . showTransaction) $
+      spn
-        runPeriodicTransaction
-          nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
-          spn
 
 --deriving instance Show PeriodicTransaction
 -- for better pretty-printing:
@@ -192,22 +186,6 @@ instance Show PeriodicTransaction where
 --     a           $1.00
 -- <BLANKLINE>
 --
--- >>> _ptgen ""
--- *** Exception: Error: failed to parse...
--- ...
---
--- >>> _ptgen "weekly from 2017"
--- *** Exception: Error: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the Week
---
--- >>> _ptgen "monthly from 2017/5/4"
--- *** Exception: Error: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the Month
---
--- >>> _ptgen "every quarter from 2017/1/2"
--- *** Exception: Error: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the Quarter
---
--- >>> _ptgen "yearly from 2017/1/14"
--- *** Exception: Error: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year
---
 -- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03))
 -- []
 --
@@ -250,10 +228,13 @@ runPeriodicTransaction PeriodicTransaction{..} requestedspan =
           ,tpostings    = ptpostings
           }
     period = "~ " <> ptperiodexpr
-    -- All spans described by this periodic transaction, where spanStart is event date.
+    -- All the date spans described by this periodic transaction rule.
-    -- If transaction does not have start/end date, we set them to start/end of requested span,
+    alltxnspans = splitSpan adjust ptinterval span'
-    -- to avoid generating (infinitely) many events. 
+      where
-    alltxnspans = dbg3 "alltxnspans" $ ptinterval `splitSpan` (spanDefaultsFrom ptspan requestedspan)
+        -- If the PT does not specify  start or end dates, we take them from the requestedspan.
+        span' = ptspan `spanDefaultsFrom` requestedspan
+        -- Unless the PT specified a start date explicitly, we will adjust the start date to the previous interval boundary.
+        adjust = isNothing $ spanStart span'
 
 -- | Check that this date span begins at a boundary of this interval,
 -- or return an explanatory error message including the provided period expression

hledger-lib/Hledger/Read/JournalReader.hs

@@ -722,8 +722,6 @@ periodictransactionp = do
   -- first line
   char '~' <?> "periodic transaction"
   lift $ skipNonNewlineSpaces
-  -- a period expression
-  off <- getOffset
 
   -- if there's a default year in effect, use Y/1/1 as base for partial/relative dates
   today <- liftIO getCurrentDay
@@ -750,11 +748,6 @@ periodictransactionp = do
         <> "\na double space is required between period expression and description/comment"
     pure pexp
 
-  -- In periodic transactions, the period expression has an additional constraint:
-  case checkPeriodicTransactionStartDate interval spn periodtxt of
-    Just e -> customFailure $ parseErrorAt off e
-    Nothing -> pure ()
-
   status <- lift statusp <?> "cleared status"
   code <- lift codep <?> "transaction code"
   description <- lift $ T.strip <$> descriptionp

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -685,7 +685,10 @@ reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
     -- This list can be empty if the journal was empty,
     -- or if hledger-ui has added its special date:-tomorrow to the query
     -- and all txns are in the future.
-    intervalspans  = dbg3 "intervalspans" $ splitSpan (interval_ ropts) requestedspan'
+    intervalspans  = dbg3 "intervalspans" $ splitSpan adjust (interval_ ropts) requestedspan'
+      where
+        -- When calculating report periods, we will always adjust the start date back to the nearest interval boundary.
+        adjust = True  -- isNothing $ spanStart requestedspan
     -- The requested span enlarged to enclose a whole number of intervals.
     -- This can be the null span if there were no intervals.
     reportspan = dbg3 "reportspan" $ DateSpan (spanStart =<< headMay intervalspans)

hledger/hledger.m4.md

@@ -2397,13 +2397,20 @@ with the date replaced by a tilde (`~`) followed by a
 [period expression](#period-expressions)
 (mnemonic: `~` looks like a recurring sine wave.):
 ```journal
+# every first of month
 ~ monthly
     expenses:rent          $2000
     assets:bank:checking
+
+# every 15th of month in 2023's first quarter:
+~ monthly from 2023-04-15 to 2023-06-16
+    expenses:utilities          $400
+    assets:bank:checking
 ```
-There is an additional constraint on the period expression:
+
-the start date must fall on a natural boundary of the interval.
+The period expression is the same syntax used for specifying multi-period reports,
-Eg `monthly from 2018/1/1` is valid, but `monthly from 2018/1/15` is not.
+just interpreted differently; there, it specifies report periods; 
+here it specifies recurrence dates (the periods' start dates).
 
 ### Periodic rules and relative dates
 
@@ -4376,8 +4383,8 @@ Some notes:
   start/end dates from options and that from `date:` queries.
   That is, `date:2019-01 date:2019 -p'2000 to 2030'` yields January 2019, the
   smallest common time span.
-- A [report interval](#report-intervals) (see below) will adjust start/end dates,
+- With a [report interval](#report-intervals) (see below), the report start date
-  when needed, so that they fall on subperiod boundaries.
+  will be adjusted back to the nearest subperiod boundary, if needed.
 
 Examples:
 
@@ -4445,32 +4452,24 @@ their corresponding flag:
 - `-Q/--quarterly`
 - `-Y/--yearly`
 
-These standard intervals always start on natural interval boundaries:
+Intervals specified by these flags will always start on their natural
-eg `--weekly` starts on mondays, `--monthly` starts on the first of
+boundaries: eg `--weekly` starts on mondays, `--monthly` starts on
-the month, `--yearly` always starts on January 1st, etc.
+first days of months, `--yearly` starts on January 1st, etc.
 
-Certain more complex intervals, and more flexible boundary dates, can
+Intervals starting on other dates, and more complex intervals, can be
-be specified by `-p/--period`. These are described in [period
+specified with the `-p/--period` option. These are described in
-expressions](#period-expressions), below.
+[period expressions](#period-expressions), below.
 
-Report intervals can only be specified by the flags above, and not by
+When you use a report interval (other than `--daily`), the overall
-[query](#queries) arguments, currently.
+report period will be expanded to fill a whole number of subperiods,
-
+(possibly overriding your requested report start or end dates).
-Report intervals have another effect: multi-period reports are always
+This ensures first and last subperiods are comparable to the others.
-expanded to fill a whole number of subperiods. So if you use a report
-interval (other than `--daily`), and you have specified a start or end
-date, you may notice those dates being overridden (ie, the report
-starts earlier than your requested start date, or ends later than your
-requested end date). This is done to ensure "full" first and last
-subperiods, so that all subperiods' numbers are comparable.
 
 To summarise:
 
-- In multiperiod reports, all subperiods are forced to be the same length, to simplify reporting.
+- Reports with the standard `--weekly`/`--monthly`/`--quarterly`/`--yearly` intervals will start on the first day of a week/month/quarter/year. 
-- Reports with the standard `--weekly`/`--monthly`/`--quarterly`/`--yearly`  intervals
-  are required to start on the first day of a week/month/quarter/year. 
-  We'd like more flexibility here but it isn't supported yet.
 - `--period` (below) can specify more complex intervals, starting on any date.
+- In multiperiod reports, all subperiods will be the same length.
 
 ## Period expressions
 
@@ -4625,7 +4624,7 @@ $ hledger register checking -p "every 3rd day of week"
 
 ### Periods or dates ?
 
-Report intervals like the above are most often used with `-p|--period`,
+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.