slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

bal: support --value-at=p/t with multiperiod reports (#329)

Browse Source
This commit is contained in:
Simon Michael 2019-05-05 09:30:01 -07:00
parent 74c381cc88
commit 8d7eacd73f
6 changed files with 65 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
hledger-lib/Hledger/Reports/MultiBalanceReports.hs
View File

@ -85,7 +85,6 @@ type ClippedAccountName = AccountName
multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
multiBalanceReport ropts@ReportOpts{..} q j = multiBalanceReport ropts@ReportOpts{..} q j =
(if invert_ then mbrNegate else id) $ (if invert_ then mbrNegate else id) $
(if value_ then mbrValue ropts j else id) $
MultiBalanceReport (displayspans, sorteditems, totalsrow) MultiBalanceReport (displayspans, sorteditems, totalsrow)
where where
symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q 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 | empty_ = dbg1 "displayspan (-E)" reportspan -- all the requested intervals
| otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals | otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals
matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts ropts) ps matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts ropts) ps
-- Group postings into their columns. -- Group postings into their columns, with the column end dates.
psPerSpan :: [[Posting]] = psPerSpan :: [([Posting], Maybe Day)] =
dbg1 "psPerSpan" 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. -- 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)]] = postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg1 "postedAcctBalChangesPerSpan" $ 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 where
postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)] postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]
postingAcctBals ps = [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as] 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, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg)
| (a,changes) <- acctBalChanges | (a,changes) <- acctBalChanges
, let displayedBals = case balancetype_ of , let displayedBals = case balancetype_ of
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes -- XXX need to value per period
CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes CumulativeChange -> drop 1 $ scanl (+) 0 changes
_ -> changes _ -> changes
, let rowtot = sum displayedBals , let rowtot = sum displayedBals
, let rowavg = averageMixedAmounts displayedBals , let rowavg = averageMixedAmounts displayedBals
@ -274,43 +298,6 @@ multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing
multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) 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, -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport,
-- in order to support --historical. Does not support tree-mode boring parent eliding. -- 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 -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts

15
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -323,11 +323,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
else else
if multiperiod then do -- multi period balance report if multiperiod then do -- multi period balance report
-- With --value-at=transaction, convert all amounts to value before summing them. let report = multiBalanceReport ropts (queryFromOpts d ropts) j
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'
render = case format of render = case format of
"csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts "csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
"html" -> (++ "\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml 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 writeOutput opts $ render report
else do -- single period simple balance report else do -- single period simple balance report
-- With --value-at=transaction, convert all amounts to value before summing them. let report
let j' | value_at_ == AtTransaction = journalValueAtTransactionDate ropts j
| otherwise = j
report
| balancetype_ `elem` [HistoricalBalance, CumulativeChange] | balancetype_ `elem` [HistoricalBalance, CumulativeChange]
= let ropts' | flat_ ropts = ropts = let ropts' | flat_ ropts = ropts
| otherwise = ropts{accountlistmode_=ALTree} | 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) -- 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 render = case format of
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
"html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO "html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO

10
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -25,7 +25,7 @@ import Text.Tabular as T
import Hledger import Hledger
import Hledger.Cli.Commands.Balance import Hledger.Cli.Commands.Balance
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (journalValueAtTransactionDate, writeOutput) import Hledger.Cli.Utils (writeOutput)
-- | Description of a compound balance report command, -- | Description of a compound balance report command,
-- from which we generate the command's cmdargs mode and IO action. -- 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 :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport
compoundBalanceSubreport ropts@ReportOpts{..} userq j subreportqfn subreportnormalsign = r' compoundBalanceSubreport ropts@ReportOpts{..} userq j subreportqfn subreportnormalsign = r'
where 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 -- force --empty to ensure same columns in all sections
ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign } ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign }
-- run the report -- run the report
q = And [subreportqfn j', userq] q = And [subreportqfn j, userq]
r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j' 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 -- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts
-- in this report -- in this report
r' | empty_ = r r' | empty_ = r

19
hledger/Hledger/Cli/Utils.hs
View File

@ -14,7 +14,6 @@ module Hledger.Cli.Utils
writeOutput, writeOutput,
journalTransform, journalTransform,
journalAddForecast, journalAddForecast,
journalValueAtTransactionDate,
journalReload, journalReload,
journalReloadIfChanged, journalReloadIfChanged,
journalFileIsNewer, journalFileIsNewer,
@ -121,24 +120,6 @@ anonymise j
where where
anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash 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. -- | 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). -- These transactions are added to the in-memory Journal (but not the on-disk file).
-- --

5
hledger/hledger_options.m4.md
View File

@ -612,9 +612,10 @@ Here are the ones currently supported
| register | Y | Y | Y | | register | Y | Y | Y |
| register,&nbsp;multiperiod | Y | Y | Y | | register,&nbsp;multiperiod | Y | Y | Y |
| balance | Y | Y | Y | | balance | Y | Y | Y |
| balance,&nbsp;multiperiod | - | Y | Y | | balance,&nbsp;multiperiod | Y | Y | Y |
| balance,&nbsp;multiperiod,&nbsp;-T/-A | - | - | Y | | balance,&nbsp;multiperiod,&nbsp;-T/-A | Y | Y | Y |
| register/balance,&nbsp;multiperiod,&nbsp;-T/-A,&nbsp;-H | ? | ? | ? | | register/balance,&nbsp;multiperiod,&nbsp;-T/-A,&nbsp;-H | ? | ? | ? |
| balance,&nbsp;--budget | ? | ? | ? |
## Combining -B and -V ## Combining -B and -V

43
tests/journal/market-prices.test
View File

@ -299,15 +299,13 @@ $ hledger -f- bal -V
# 29. multicolumn balance report valued at transaction # 29. multicolumn balance report valued at transaction
$ hledger -f- bal -MTA --value-at=transaction $ hledger -f- bal -MTA --value-at=transaction
>2 /not yet supported/ Balance changes in 2000q1:
>=1
# Balance changes in 2000q1: || Jan Feb Mar Total Average
# ===++=================================
# || Jan Feb Mar Total Average a || 1 B 2 B 3 B 6 B 2 B
# ===++================================= ---++---------------------------------
# a || 1 B 2 B 3 B 6 B 2 B || 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 # 30. multicolumn balance report valued at period end
$ hledger -f- bal -M --value-at=period $ 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 # 31. multicolumn balance report valued at period end with -T or -A
$ hledger -f- bal -M --value-at=period -TA $ 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: Balance changes in 2000q1:
|| Jan Feb Mar || Jan Feb Mar Total Average
===++=============== ===++=================================
a || 5 B 5 B 5 B a || 5 B 2 B 3 B 10 B 3 B
---++--------------- ---++---------------------------------
|| 5 B 5 B 5 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) # 33. multicolumn balance report valued today (with today >= 2000-04-01)
$ hledger -f- bal -M --value-at=now $ hledger -f- bal -M --value-at=now