imp: journal: periodic txns need not start on an interval boundary
Eg, ~ monthly from 1/15 now works, instead of giving an error message.
This commit is contained in:
Simon Michael
parent
0c74744626
commit
5537a251f3
@ -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
|
||||
|
||||
@ -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,9 +33,6 @@ _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] }
|
||||
@ -45,9 +42,6 @@ _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] }
|
||||
@ -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.
|
||||
-- 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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user