From 8d7eacd73f7b080c98889fe42cd4b2441611a028 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 5 May 2019 09:30:01 -0700 Subject: [PATCH] bal: support --value-at=p/t with multiperiod reports (#329) --- .../Hledger/Reports/MultiBalanceReports.hs | 75 ++++++++----------- hledger/Hledger/Cli/Commands/Balance.hs | 15 +--- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 10 +-- hledger/Hledger/Cli/Utils.hs | 19 ----- hledger/hledger_options.m4.md | 5 +- tests/journal/market-prices.test | 43 ++++++----- 6 files changed, 65 insertions(+), 102 deletions(-) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 8b0f52525..b840ed78e 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -85,7 +85,6 @@ type ClippedAccountName = AccountName multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport multiBalanceReport ropts@ReportOpts{..} q j = (if invert_ then mbrNegate else id) $ - (if value_ then mbrValue ropts j else id) $ MultiBalanceReport (displayspans, sorteditems, totalsrow) where symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q @@ -139,14 +138,39 @@ multiBalanceReport ropts@ReportOpts{..} q j = | empty_ = dbg1 "displayspan (-E)" reportspan -- all the requested intervals | otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts ropts) ps - -- Group postings into their columns. - psPerSpan :: [[Posting]] = + -- Group postings into their columns, with the column end dates. + psPerSpan :: [([Posting], Maybe Day)] = dbg1 "psPerSpan" - [filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps | s <- displayspans] + [(filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps, spanEnd s) | s <- displayspans] + -- Check if we'll be doing valuation. Here's how it's done in the various cases: + -- balance -M --value-at + -- transaction: convert each posting to value before calculating table cell amounts (balance change or ending balance) ? + -- period: convert each table cell amount (balance change or ending balance) to its value at period end + -- date: convert each table cell amount to its value at date + mvalueat = if value_ then Just value_at_ else Nothing + today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_ + -- If --value-at=transaction is in effect, convert the postings to value before summing. + maybeValuedPsPerSpan :: [([Posting], Maybe Day)] = + case mvalueat of + Just AtTransaction -> [([postingValueAtDate j (postingDate p) p | p <- ps], periodend) | (ps,periodend) <- psPerSpan] + _ -> psPerSpan -- In each column, calculate the change in each account that has postings. + -- And if --value-at is in effect (except --value-at=transaction), convert these change amounts to value. postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = dbg1 "postedAcctBalChangesPerSpan" $ - map postingAcctBals psPerSpan + [postingAcctBals valuedps + | (ps,periodend) <- maybeValuedPsPerSpan + , let periodlastday = maybe + (error' "multiBalanceReport: expected a subperiod end date") -- XXX shouldn't happen + (addDays (-1)) + periodend + , let valuedps = + case mvalueat of + Just AtPeriod -> [postingValueAtDate j periodlastday p | p <- ps] + Just AtNow -> [postingValueAtDate j today p | p <- ps] + Just (AtDate d) -> [postingValueAtDate j d p | p <- ps] + _ -> ps + ] where postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)] postingAcctBals ps = [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as] @@ -192,8 +216,8 @@ multiBalanceReport ropts@ReportOpts{..} q j = [(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg) | (a,changes) <- acctBalChanges , let displayedBals = case balancetype_ of - HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes - CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes + HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes -- XXX need to value per period + CumulativeChange -> drop 1 $ scanl (+) 0 changes _ -> changes , let rowtot = sum displayedBals , let rowavg = averageMixedAmounts displayedBals @@ -274,43 +298,6 @@ multiBalanceReportSpan :: MultiBalanceReport -> DateSpan multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) --- | Convert all the posting amounts in a MultiBalanceReport to their --- default valuation commodities. This means using the Journal's most --- recent applicable market prices before the valuation date. --- The valuation date is set with --value-at and can be: --- each posting's date, --- or the last day in the report subperiod, --- or today's date (gives an error if today_ is not set in ReportOpts), --- or a specified date. -mbrValue :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -mbrValue ReportOpts{..} Journal{..} (MultiBalanceReport (spans, rows, (coltotals, rowtotaltotal, rowavgtotal))) = - MultiBalanceReport ( - spans - ,[(acct, acct', depth, map (uncurry val) $ zip ends rowamts, val end rowtotal, val end rowavg) - | (acct, acct', depth, rowamts, rowtotal, rowavg) <- rows] - ,(map (uncurry val) $ zip ends coltotals - ,val end rowtotaltotal - ,val end rowavgtotal) - ) - where - ends = map (addDays (-1) . fromMaybe (error' "mbrValue: expected all report periods to have an end date") . spanEnd) spans -- XXX shouldn't happen - end = lastDef (error' "mbrValue: expected at least one report subperiod") ends -- XXX shouldn't happen - val periodend amt = mixedAmountValue prices valuationdate amt - where - -- prices are in parse order - sort into date then parse order, - -- & reversed for quick lookup of the latest price. - prices = reverse $ sortOn mpdate jmarketprices - valuationdate = case value_at_ of - AtTransaction -> - error' "sorry, --value-at=transaction with balance reports is not yet supported" - AtPeriod | average_ || row_total_ -> - error' "sorry, --value-at=period with -T or -A in periodic balance reports is not yet supported" - AtPeriod -> periodend - AtNow -> case today_ of - Just d -> d - Nothing -> error' "mbrValue: ReportOpts today_ is unset so could not satisfy --value-at=now" - AtDate d -> d - -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport, -- in order to support --historical. Does not support tree-mode boring parent eliding. -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 73dfbf8e1..898edffb9 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -323,11 +323,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do else if multiperiod then do -- multi period balance report - -- With --value-at=transaction, convert all amounts to value before summing them. - let j' | value_at_ == AtTransaction = - error' "sorry, --value-at=transaction with balance reports is not yet supported" -- journalValueAtTransactionDate ropts j - | otherwise = j - report = multiBalanceReport ropts (queryFromOpts d ropts) j' + let report = multiBalanceReport ropts (queryFromOpts d ropts) j render = case format of "csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts "html" -> (++ "\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts @@ -335,16 +331,13 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do writeOutput opts $ render report else do -- single period simple balance report - -- With --value-at=transaction, convert all amounts to value before summing them. - let j' | value_at_ == AtTransaction = journalValueAtTransactionDate ropts j - | otherwise = j - report + let report | balancetype_ `elem` [HistoricalBalance, CumulativeChange] = let ropts' | flat_ ropts = ropts | otherwise = ropts{accountlistmode_=ALTree} - in balanceReportFromMultiBalanceReport ropts' (queryFromOpts d ropts) j' + in balanceReportFromMultiBalanceReport ropts' (queryFromOpts d ropts) j -- for historical balances we must use balanceReportFromMultiBalanceReport (also forces --no-elide) - | otherwise = balanceReport ropts (queryFromOpts d ropts) j' -- simple Ledger-style balance report + | otherwise = balanceReport ropts (queryFromOpts d ropts) j -- simple Ledger-style balance report render = case format of "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r "html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 9e8f26cc4..4f57b3181 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -25,7 +25,7 @@ import Text.Tabular as T import Hledger import Hledger.Cli.Commands.Balance import Hledger.Cli.CliOptions -import Hledger.Cli.Utils (journalValueAtTransactionDate, writeOutput) +import Hledger.Cli.Utils (writeOutput) -- | Description of a compound balance report command, -- from which we generate the command's cmdargs mode and IO action. @@ -209,15 +209,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport compoundBalanceSubreport ropts@ReportOpts{..} userq j subreportqfn subreportnormalsign = r' where - -- With --value-at=transaction and a periodic report, convert all amounts to value before summing them. - j' | value_at_ == AtTransaction && interval_ /= NoInterval = journalValueAtTransactionDate ropts j - | otherwise = j - -- force --empty to ensure same columns in all sections ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign } -- run the report - q = And [subreportqfn j', userq] - r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j' + q = And [subreportqfn j, userq] + r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j -- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts -- in this report r' | empty_ = r diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 08f6aba22..8f113bde2 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -14,7 +14,6 @@ module Hledger.Cli.Utils writeOutput, journalTransform, journalAddForecast, - journalValueAtTransactionDate, journalReload, journalReloadIfChanged, journalFileIsNewer, @@ -121,24 +120,6 @@ anonymise j where anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash --- journalApplyValue and friends are here not in Hledger.Data.Journal --- because they use ReportOpts. - --- | Convert all the journal's posting amounts to their market value --- as of each posting's date. Needed when converting some periodic --- reports to value, when --value-at=transaction (only). --- See eg Register.hs. -journalValueAtTransactionDate :: ReportOpts -> Journal -> Journal -journalValueAtTransactionDate ReportOpts{..} j@Journal{..} - | value_at_ /= AtTransaction = j - | otherwise = j{jtxns = map txnvalue jtxns} - where - txnvalue t@Transaction{..} = t{tpostings=map postingvalue tpostings} - postingvalue p@Posting{..} = p{pamount=mixedAmountValue prices (postingDate p) pamount} - -- prices are in parse order - sort into date then parse order, - -- reversed for quick lookup of the latest price. - prices = reverse $ sortOn mpdate jmarketprices - -- | Generate periodic transactions from all periodic transaction rules in the journal. -- These transactions are added to the in-memory Journal (but not the on-disk file). -- diff --git a/hledger/hledger_options.m4.md b/hledger/hledger_options.m4.md index a174f459e..cf1b64ffe 100644 --- a/hledger/hledger_options.m4.md +++ b/hledger/hledger_options.m4.md @@ -612,9 +612,10 @@ Here are the ones currently supported | register | Y | Y | Y | | register, multiperiod | Y | Y | Y | | balance | Y | Y | Y | -| balance, multiperiod | - | Y | Y | -| balance, multiperiod, -T/-A | - | - | Y | +| balance, multiperiod | Y | Y | Y | +| balance, multiperiod, -T/-A | Y | Y | Y | | register/balance, multiperiod, -T/-A, -H | ? | ? | ? | +| balance, --budget | ? | ? | ? | ## Combining -B and -V diff --git a/tests/journal/market-prices.test b/tests/journal/market-prices.test index 07cbfe348..4aa471a17 100644 --- a/tests/journal/market-prices.test +++ b/tests/journal/market-prices.test @@ -299,15 +299,13 @@ $ hledger -f- bal -V # 29. multicolumn balance report valued at transaction $ hledger -f- bal -MTA --value-at=transaction ->2 /not yet supported/ ->=1 -# Balance changes in 2000q1: -# -# || Jan Feb Mar Total Average -# ===++================================= -# a || 1 B 2 B 3 B 6 B 2 B -# ---++--------------------------------- -# || 1 B 2 B 3 B 6 B 2 B +Balance changes in 2000q1: + + || Jan Feb Mar Total Average +===++================================= + a || 1 B 2 B 3 B 6 B 2 B +---++--------------------------------- + || 1 B 2 B 3 B 6 B 2 B # 30. multicolumn balance report valued at period end $ hledger -f- bal -M --value-at=period @@ -321,18 +319,25 @@ Balance changes in 2000q1: # 31. multicolumn balance report valued at period end with -T or -A $ hledger -f- bal -M --value-at=period -TA ->2 /not yet supported/ ->=1 - -# 32. multicolumn balance report valued at other date -$ hledger -f- bal -M --value-at=2000-01-15 Balance changes in 2000q1: - || Jan Feb Mar -===++=============== - a || 5 B 5 B 5 B ----++--------------- - || 5 B 5 B 5 B + || Jan Feb Mar Total Average +===++================================= + a || 5 B 2 B 3 B 10 B 3 B +---++--------------------------------- + || 5 B 2 B 3 B 10 B 3 B +# >2 /not yet supported/ +# >=1 + +# 32. multicolumn balance report valued at other date +$ hledger -f- bal -MTA --value-at=2000-01-15 +Balance changes in 2000q1: + + || Jan Feb Mar Total Average +===++================================= + a || 5 B 5 B 5 B 15 B 5 B +---++--------------------------------- + || 5 B 5 B 5 B 15 B 5 B # 33. multicolumn balance report valued today (with today >= 2000-04-01) $ hledger -f- bal -M --value-at=now