diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 3ebad0f46..4f515190d 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -92,7 +92,7 @@ module Hledger.Data.Journal ( samplejournal, samplejournalMaybeExplicit, tests_Journal -) +,journalLeafAccountNamesDeclared) where import Control.Applicative ((<|>)) @@ -313,6 +313,11 @@ journalAccountNamesImplied = expandAccountNames . journalAccountNamesUsed journalAccountNamesDeclared :: Journal -> [AccountName] journalAccountNamesDeclared = nubSort . map fst . jdeclaredaccounts +-- | Sorted unique account names declared by account directives in this journal, +-- which have no children. +journalLeafAccountNamesDeclared :: Journal -> [AccountName] +journalLeafAccountNamesDeclared = treeLeaves . accountNameTreeFrom . journalAccountNamesDeclared + -- | Sorted unique account names declared by account directives or posted to -- by transactions in this journal. journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index b3856d21e..a66efcb35 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-| @@ -26,7 +27,6 @@ module Hledger.Reports.MultiBalanceReport ( getPostingsByColumn, getPostings, startingPostings, - startingBalancesFromPostings, generateMultiBalanceReport, balanceReportTableAsText, @@ -122,8 +122,8 @@ multiBalanceReportWith rspec' j priceoracle = report -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. - startbals = dbg5 "startbals" . startingBalancesFromPostings rspec j priceoracle - $ startingPostings rspec j priceoracle reportspan + startbals = dbg5 "startbals" $ + startingBalances rspec j priceoracle $ startingPostings rspec j priceoracle reportspan -- Generate and postprocess the report, negating balances and taking percentages if needed report = dbg4 "multiBalanceReportWith" $ @@ -166,7 +166,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr -- Filter the column postings according to each subreport colps' = map (second $ filter (matchesPosting q)) colps -- We need to filter historical postings directly, rather than their accumulated balances. (#1698) - startbals' = startingBalancesFromPostings rspec j priceoracle $ filter (matchesPosting q) startps + startbals' = startingBalances rspec j priceoracle $ filter (matchesPosting q) startps ropts = cbcsubreportoptions $ _rsReportOpts rspec q = cbcsubreportquery j @@ -183,10 +183,12 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr cbr = CompoundPeriodicReport "" (map fst colps) subreports overalltotals --- | Calculate starting balances from postings, if needed for -H. -startingBalancesFromPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting] +-- XXX seems refactorable +-- | Calculate accounts' balances on the report start date, from these postings +-- which should be all postings before that data, and possibly also from account declarations. +startingBalances :: ReportSpec -> Journal -> PriceOracle -> [Posting] -> HashMap AccountName Account -startingBalancesFromPostings rspec j priceoracle ps = +startingBalances rspec j priceoracle ps = M.findWithDefault nullacct emptydatespan <$> calculateReportMatrix rspec j priceoracle mempty [(emptydatespan, ps)] @@ -261,24 +263,38 @@ getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle -- handles the hledger-ui+future txns case above). depthless = dbg3 "depthless" $ filterQuery (not . queryIsDepth) query --- | Given a set of postings, eg for a single report column, gather --- the accounts that have postings and calculate the change amount for --- each. Accounts and amounts will be depth-clipped appropriately if --- a depth limit is in effect. -acctChangesFromPostings :: ReportSpec -> [Posting] -> HashMap ClippedAccountName Account -acctChangesFromPostings ReportSpec{_rsQuery=query,_rsReportOpts=ropts} ps = - HM.fromList [(aname a, a) | a <- as] +-- | From set of postings, eg for a single report column, calculate the balance change in each account. +-- Accounts and amounts will be depth-clipped appropriately if a depth limit is in effect. +-- +-- When --declared is used, accounts which have been declared with an account directive +-- are also included, with a 0 balance change. But only leaf accounts, since non-leaf +-- empty declared accounts are less useful in reports. This is primarily for hledger-ui. +acctChanges :: ReportSpec -> Journal -> [Posting] -> HashMap ClippedAccountName Account +acctChanges ReportSpec{_rsQuery=query,_rsReportOpts=ReportOpts{accountlistmode_, declared_}} j ps = + HM.fromList [(aname a, a) | a <- accts] where - as = filterAccounts . drop 1 $ accountsFromPostings ps - filterAccounts = case accountlistmode_ ropts of - ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances - ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit. - filter ((0<) . anumpostings) - depthq = dbg3 "depthq" $ filterQuery queryIsDepth query + -- With --declared, add the query-matching declared accounts + -- (as dummy postings so they are processed like the rest). + -- This function is used for calculating both pre-start changes and column changes, + -- and the declared accounts are really only needed for the former, + -- but it's harmless to have them in the column changes as well. + ps' = ps ++ if declared_ then declaredacctps else [] + where + declaredacctps = + [nullposting{paccount=n} | n <- journalLeafAccountNamesDeclared j + , acctq `matchesAccount` n] + where acctq = dbg3 "acctq" $ filterQuery queryIsAcct query + + filterbydepth = case accountlistmode_ of + ALTree -> filter ((depthq `matchesAccount`) . aname) -- a tree - just exclude deeper accounts + ALFlat -> clipAccountsAndAggregate (queryDepth depthq) -- a list - aggregate deeper accounts at the depth limit + . filter ((0<) . anumpostings) -- and exclude empty parent accounts + where depthq = dbg3 "depthq" $ filterQuery queryIsDepth query + + accts = filterbydepth $ drop 1 $ accountsFromPostings ps' -- | Gather the account balance changes into a regular matrix, then -- accumulate and value amounts, as specified by the report options. --- -- Makes sure all report columns have an entry. calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle -> HashMap ClippedAccountName Account @@ -308,11 +324,12 @@ calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startb startingBalance = HM.lookupDefault nullacct name startbals valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance - -- Transpose to get each account's balance changes across all columns, then - -- pad with zeros - allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) - acctchanges = dbg5 "acctchanges" $ transposeMap colacctchanges - colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChangesFromPostings rspec) colps + -- In each column, get each account's balance changes + colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChanges rspec j) colps :: [(DateSpan, HashMap ClippedAccountName Account)] + -- Transpose it to get each account's balance changes across all columns + acctchanges = dbg5 "acctchanges" $ transposeMap colacctchanges :: HashMap AccountName (Map DateSpan Account) + -- Fill out the matrix with zeros in empty cells + allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a} diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 4ac2a8470..a64a577fb 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -148,12 +148,13 @@ data ReportOpts = ReportOpts { -- (Not a regexp, nor a full hledger query, for now.) ,accountlistmode_ :: AccountListMode ,drop_ :: Int + ,declared_ :: Bool -- ^ Include accounts declared but not yet posted to ? ,row_total_ :: Bool ,no_total_ :: Bool - ,show_costs_ :: Bool -- ^ Whether to show costs for reports which normally don't show them + ,show_costs_ :: Bool -- ^ Show costs for reports which normally don't show them ? ,sort_amount_ :: Bool ,percent_ :: Bool - ,invert_ :: Bool -- ^ if true, flip all amount signs in reports + ,invert_ :: Bool -- ^ Flip all amount signs in reports ? ,normalbalance_ :: Maybe NormalSign -- ^ This can be set when running balance reports on a set of accounts -- with the same normal balance type (eg all assets, or all incomes). @@ -197,6 +198,7 @@ defreportopts = ReportOpts , budgetpat_ = Nothing , accountlistmode_ = ALFlat , drop_ = 0 + , declared_ = False , row_total_ = False , no_total_ = False , show_costs_ = False @@ -250,6 +252,7 @@ rawOptsToReportOpts d rawopts = ,budgetpat_ = maybebudgetpatternopt rawopts ,accountlistmode_ = accountlistmodeopt rawopts ,drop_ = posintopt "drop" rawopts + ,declared_ = boolopt "declared" rawopts ,row_total_ = boolopt "row-total" rawopts ,no_total_ = boolopt "no-total" rawopts ,show_costs_ = boolopt "show-costs" rawopts diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 347d59a94..23839ce8f 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -59,6 +59,7 @@ import Hledger.Utils.Regex import Hledger.Utils.String import Hledger.Utils.Text import Hledger.Utils.Test +import Data.Tree (foldTree, Tree) -- tuples @@ -117,6 +118,11 @@ splitAtElement x l = split es = let (first,rest) = break (x==) es in first : splitAtElement x rest +-- trees + +treeLeaves :: Tree a -> [a] +treeLeaves = foldTree (\a bs -> (if null bs then (a:) else id) $ concat bs) + -- text -- time diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 8d3e6ef76..1fc79ef8c 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -308,6 +308,7 @@ balancemode = hledgerCommandMode ] ++ flattreeflags True ++ [flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "omit N leading account name parts (in flat mode)" + ,flagNone ["declared"] (setboolopt "declared") "include accounts which have been declared but not yet used" ,flagNone ["average","A"] (setboolopt "average") "show a row average column (in multicolumn reports)" ,flagNone ["related","r"] (setboolopt "related") "show postings' siblings instead" ,flagNone ["row-total","T"] (setboolopt "row-total") "show a row total column (in multicolumn reports)" diff --git a/hledger/Hledger/Cli/Commands/Balance.md b/hledger/Hledger/Cli/Commands/Balance.md index b48dfea7a..b7f4cb8eb 100644 --- a/hledger/Hledger/Cli/Commands/Balance.md +++ b/hledger/Hledger/Cli/Commands/Balance.md @@ -267,6 +267,19 @@ Here are some ways to handle that: [csv-mode]: https://elpa.gnu.org/packages/csv-mode.html [visidata]: https://www.visidata.org +### Showing declared accounts + +With `--declared`, +accounts which have been declared with an [account directive](#declaring-accounts) +will be included in the balance report, even if they have no transactions. +(Since they will have a zero balance, you will also need `-E/--empty` to see them.) + +More precisely, *leaf* declared accounts (with no subaccounts) will be included, +since those are usually the more useful in reports. + +The idea of this is to be able to see a useful "complete" balance report, +even when you don't have transactions in all of your declared accounts yet. + ### Commodity layout With `--layout`, you can control how amounts with more than one commodity are displayed: diff --git a/hledger/test/balance/balance.test b/hledger/test/balance/balance.test index 9a544aa1e..82b72198b 100644 --- a/hledger/test/balance/balance.test +++ b/hledger/test/balance/balance.test @@ -168,3 +168,32 @@ hledger -f - balance -N --output-format=csv --tree "Assets:Cash","$-1" >>>= 0 +# 9. --declared includes all declared leaf accounts, even if they have no postings. +# They are filtered, depth-clipped, and form trees like the others. +hledger -f - balance -NE --declared --tree --depth 2 a +<<< +account a +account a:aa +account a:ab +account a:ac:aca +account b +>>> + 0 a + 0 aa + 0 ab +>>>= 0 + +# 10. In list mode we can see that non-leaf declared accounts are excluded. +hledger -f - balance -NE --declared --flat +<<< +account a +account a:aa +account a:ab +account a:ac:aca +account b +>>> + 0 a:aa + 0 a:ab + 0 a:ac:aca + 0 b +>>>= 0