ui: accounts: fix balances when there's only periodic txns

And clarify multiBalanceReport.
This commit is contained in:
Simon Michael 2018-10-17 13:10:49 -07:00
parent 89a0c7a308
commit 74611a7be1
3 changed files with 39 additions and 10 deletions

View File

@ -48,6 +48,7 @@ module Hledger.Data.Dates (
parsePeriodExpr, parsePeriodExpr,
parsePeriodExpr', parsePeriodExpr',
nulldatespan, nulldatespan,
emptydatespan,
failIfInvalidYear, failIfInvalidYear,
failIfInvalidMonth, failIfInvalidMonth,
failIfInvalidDay, failIfInvalidDay,
@ -1097,5 +1098,9 @@ mkdatespan b = DateSpan (Just $ parsedate b) . Just . parsedate
nulldatespan :: DateSpan nulldatespan :: DateSpan
nulldatespan = DateSpan Nothing Nothing nulldatespan = DateSpan Nothing Nothing
-- | A datespan of zero length, that matches no date.
emptydatespan :: DateSpan
emptydatespan = DateSpan (Just $ addDays 1 nulldate) (Just nulldate)
nulldate :: Day nulldate :: Day
nulldate = fromGregorian 0 1 1 nulldate = fromGregorian 0 1 1

View File

@ -93,15 +93,37 @@ multiBalanceReport opts q j =
depthless = dbg1 "depthless" . filterQuery (not . queryIsDepth) depthless = dbg1 "depthless" . filterQuery (not . queryIsDepth)
datelessq = dbg1 "datelessq" $ filterQuery (not . queryIsDateOrDate2) q datelessq = dbg1 "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
dateqcons = if date2_ opts then Date2 else Date dateqcons = if date2_ opts then Date2 else Date
precedingq = dbg1 "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)] -- The date span specified by -b/-e/-p options and query args if any.
requestedspan = dbg1 "requestedspan" $ queryDateSpan (date2_ opts) q -- span specified by -b/-e/-p options and query args requestedspan = dbg1 "requestedspan" $ queryDateSpan (date2_ opts) q
requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j -- if open-ended, close it using the journal's end dates -- If the requested span is open-ended, close it using the journal's end dates.
intervalspans = dbg1 "intervalspans" $ splitSpan (interval_ opts) requestedspan' -- interval spans enclosing it -- This can still be the null (open) span if the journal is empty.
reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) -- the requested span enlarged to a whole number of intervals requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j
(maybe Nothing spanEnd $ lastMay intervalspans) -- The list of interval spans enclosing the requested span.
newdatesq = dbg1 "newdateq" $ dateqcons reportspan -- This list can be empty if the journal was empty,
reportq = dbg1 "reportq" $ depthless $ And [datelessq, newdatesq] -- user's query enlarged to whole intervals and with no depth limit -- or if hledger-ui has added its special date:-tomorrow to the query
-- and all txns are in the future.
intervalspans = dbg1 "intervalspans" $ splitSpan (interval_ opts) requestedspan'
-- The requested span enlarged to enclose a whole number of intervals.
-- This can be the null span if there were no intervals.
reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans)
(maybe Nothing spanEnd $ lastMay intervalspans)
-- The user's query with no depth limit, and expanded to the report span
-- if there is one (otherwise any date queries are left as-is, which
-- handles the hledger-ui+future txns case above).
reportq = dbg1 "reportq" $ depthless $
if reportspan == nulldatespan
then q
else And [datelessq, reportspandatesq]
where
reportspandatesq = dbg1 "reportspandatesq" $ dateqcons reportspan
-- q projected back before the report start date, to calculate starting balances.
-- When there's no report start date, in case there are future txns (the hledger-ui case above),
-- we use emptydatespan to make sure they aren't counted as starting balance.
startbalq = dbg1 "startbalq" $ And [datelessq, dateqcons precedingspan]
where
precedingspan = case spanStart reportspan of
Just d -> DateSpan Nothing (Just d)
Nothing -> emptydatespan
ps :: [Posting] = ps :: [Posting] =
dbg1 "ps" $ dbg1 "ps" $
journalPostings $ journalPostings $
@ -139,7 +161,7 @@ multiBalanceReport opts q j =
-- starting balances and accounts from transactions before the report start date -- starting balances and accounts from transactions before the report start date
startacctbals = dbg1 "startacctbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems startacctbals = dbg1 "startacctbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems
where where
(startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport opts' precedingq j (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport opts' startbalq j
where where
opts' | tree_ opts = opts{no_elide_=True} opts' | tree_ opts = opts{no_elide_=True}
| otherwise = opts{accountlistmode_=ALFlat} | otherwise = opts{accountlistmode_=ALFlat}

View File

@ -82,6 +82,8 @@ asInit d reset ui@UIState{
uopts' = uopts{cliopts_=copts{reportopts_=ropts'}} uopts' = uopts{cliopts_=copts{reportopts_=ropts'}}
ropts' = ropts{accountlistmode_=if tree_ ropts then ALTree else ALFlat} ropts' = ropts{accountlistmode_=if tree_ ropts then ALTree else ALFlat}
-- Add a date:-tomorrow to the query to exclude future txns, by default.
-- XXX this necessitates special handling in multiBalanceReport, at least
pfq | presentorfuture_ uopts == PFFuture = Any pfq | presentorfuture_ uopts == PFFuture = Any
| otherwise = Date $ DateSpan Nothing (Just $ addDays 1 d) | otherwise = Date $ DateSpan Nothing (Just $ addDays 1 d)
q = And [queryFromOpts d ropts, pfq] q = And [queryFromOpts d ropts, pfq]