bal: support --value-at=p/t with multiperiod reports (#329)
This commit is contained in:
parent
74c381cc88
commit
8d7eacd73f
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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).
|
||||
--
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user