diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 8230ec39e..f3c964782 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/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 --- which fully encompass the original span (and a little more when necessary). +-- | Split a DateSpan into consecutive 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: --- >>> 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 _ (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 startofday addDays n ds -splitSpan (Weeks n) ds = splitspan startofweek addDays (7*n) ds -splitSpan (Months n) ds = splitspan startofmonth addGregorianMonthsClip n ds -splitSpan (Quarters n) ds = splitspan startofquarter addGregorianMonthsClip (3*n) ds -splitSpan (Years n) ds = splitspan startofyear addGregorianYearsClip n ds -splitSpan (DayOfMonth n) ds = splitspan (nthdayofmonthcontaining n) addGregorianMonthsClip 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 :: 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 n) ds = splitspan (nthdayofmonthcontaining n) addGregorianMonthsClip 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 where advancemonths 0 = id advancemonths w = advancetonthweekday n wd . startofmonth . addGregorianMonthsClip w -splitSpan (DaysOfWeek []) ds = [ds] -splitSpan (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys +splitSpan _ (DaysOfWeek []) ds = [ds] +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 = - case splitSpan int (DateSpan (Just d) (Just $ addDays 1 d)) of +intervalBoundaryBefore i d = + 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 diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index eb2c021f5..be661eea3 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/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 - Just e -> error' e -- PARTIAL: - Nothing -> - mapM_ (T.putStr . showTransaction) $ - runPeriodicTransaction - nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } - nulldatespan + mapM_ (T.putStr . showTransaction) $ + 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 - Just e -> error' e -- PARTIAL: - Nothing -> - mapM_ (T.putStr . showTransaction) $ - runPeriodicTransaction - nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } - spn + mapM_ (T.putStr . showTransaction) $ + 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 -- -- --- >>> _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. - -- If transaction does not have start/end date, we set them to start/end of requested span, - -- to avoid generating (infinitely) many events. - alltxnspans = dbg3 "alltxnspans" $ ptinterval `splitSpan` (spanDefaultsFrom ptspan requestedspan) + -- All the date spans described by this periodic transaction rule. + alltxnspans = splitSpan adjust ptinterval span' + where + -- 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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index d4120485a..758630391 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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 diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index fbdb7745f..01378170d 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/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) diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 8bd9de1be..326a281ae 100644 --- a/hledger/hledger.m4.md +++ b/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. -Eg `monthly from 2018/1/1` is valid, but `monthly from 2018/1/15` is not. + +The period expression is the same syntax used for specifying multi-period reports, +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, - when needed, so that they fall on subperiod boundaries. +- With a [report interval](#report-intervals) (see below), the report start date + 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: -eg `--weekly` starts on mondays, `--monthly` starts on the first of -the month, `--yearly` always starts on January 1st, etc. +Intervals specified by these flags will always start on their natural +boundaries: eg `--weekly` starts on mondays, `--monthly` starts on +first days of months, `--yearly` starts on January 1st, etc. -Certain more complex intervals, and more flexible boundary dates, can -be specified by `-p/--period`. These are described in [period -expressions](#period-expressions), below. +Intervals starting on other dates, and more complex intervals, can be +specified with the `-p/--period` option. These are described in +[period expressions](#period-expressions), below. -Report intervals can only be specified by the flags above, and not by -[query](#queries) arguments, currently. - -Report intervals have another effect: multi-period reports are always -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. +When you use a report interval (other than `--daily`), the overall +report period will be expanded to fill a whole number of subperiods, +(possibly overriding your requested report start or end dates). +This ensures first and last subperiods are comparable to the others. 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 - 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. +- Reports with the standard `--weekly`/`--monthly`/`--quarterly`/`--yearly` intervals will start on the first day of a week/month/quarter/year. - `--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.