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

Merge pull request #1256 from Xitian9/balanceReport

Browse Source 
SMorgan: 
This PR aims to accomplish two major goals:

-    Get boring parent ellision working for multiBalanceReport
-    Remove the special BalanceReport code, and just use multiBalanceReport

I believe it does both, with the following additional benefits:

    A refactor of multiBalanceReportWith, to make the structure easier to follow, and with a clearer division of responsibilities
    All decisions for how an account name is to be displayed are now made in multiBalanceReport, rather than scattered around the code base
    Some miscellaneous improvements in account name rendering, including --drop now working with MultiBalanceReports, and addressing some of #373

Algorithmic changes:

-    Using HashMap AccountName (Map DateSpan Account) instead of [[MixedAmount]] is new. I admit I didn't profile this change (though given the nubs and lookups, I thought it was appropriate), so I'm glad it produces a speedup.
-    Producing the starting balances no longer calls the whole balanceReport, just the first few functions to get what it needs.
-    displayedAccounts is completely rewritten. Perhaps one subtle thing to note is that in tree mode it no longer excludes nodes with zero inclusive balance unless they also have zero exclusive balance.

SMichael: 
I'll mark the passing of the old multiBalanceReport, into which I poured many an hour :). It is in a way the heart (brain ?) of hledger - the key feature of ledgerlikes (balance report) and a key improvement introduced by hledger (tabular multiperiod balance reports). You have split that 300-line though well documented function into modular parts, which could be a little harder to understand in detail but are easier to understand in the large and more amenable to further refactoring. Then you fixed some old limitations (boring parent eliding in multi period balance reports, --drop with tree mode reports), allowing us to drop the old balanceReport and focus on just the new multiBalanceReport. And for representing the tabular data you replaced the semantically correct but inefficient list of lists with a map of maps, speeding up many-columned balance reports significantly (~40%). Last and not least you made it really easy to review. Thanks @Xitian9, great work.
This commit is contained in:
Simon Michael 2020-06-23 06:42:22 -07:00 committed by GitHub
commit e0fab4f882
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 584 additions and 516 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

175
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -11,18 +11,12 @@ module Hledger.Reports.BalanceReport (
BalanceReportItem, BalanceReportItem,
balanceReport, balanceReport,
flatShowsExclusiveBalance, flatShowsExclusiveBalance,
sortAccountItemsLike,
unifyMixedAmount,
perdivide,
-- * Tests -- * Tests
tests_BalanceReport tests_BalanceReport
) )
where where
import Data.List
import Data.Ord
import Data.Maybe
import Data.Time.Calendar import Data.Time.Calendar
import Hledger.Data import Hledger.Data
@ -30,6 +24,7 @@ import Hledger.Read (mamountp')
import Hledger.Query import Hledger.Query
import Hledger.Utils import Hledger.Utils
import Hledger.Reports.ReportOptions import Hledger.Reports.ReportOptions
import Hledger.Reports.MultiBalanceReport (balanceReportFromMultiBalanceReport)
-- | A simple balance report. It has: -- | A simple balance report. It has:
@ -66,166 +61,8 @@ flatShowsExclusiveBalance = True
-- This is like PeriodChangeReport with a single column (but more mature, -- This is like PeriodChangeReport with a single column (but more mature,
-- eg this can do hierarchical display). -- eg this can do hierarchical display).
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReport ropts@ReportOpts{..} q j = balanceReport = balanceReportFromMultiBalanceReport
(if invert_ then brNegate else id) $
(mappedsorteditems, mappedtotal)
where
-- dbg = const id -- exclude from debug output
dbg s = let p = "balanceReport" in Hledger.Utils.dbg4 (p++" "++s) -- add prefix in debug output
dbg' s = let p = "balanceReport" in Hledger.Utils.dbg5 (p++" "++s) -- add prefix in debug output
-- Get all the summed accounts & balances, according to the query, as an account tree.
-- If doing cost valuation, amounts will be converted to cost first.
accttree = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts ropts j
-- For other kinds of valuation, convert the summed amounts to value,
-- per hledger_options.m4.md "Effect of --value on reports".
valuedaccttree = mapAccounts avalue accttree
where
avalue a@Account{..} = a{aebalance=maybevalue aebalance, aibalance=maybevalue aibalance}
where
maybevalue = maybe id applyvaluation value_
where
applyvaluation = mixedAmountApplyValuation priceoracle styles periodlast mreportlast today multiperiod
where
priceoracle = journalPriceOracle infer_value_ j
styles = journalCommodityStyles j
periodlast = fromMaybe
(error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay ropts j
mreportlast = reportPeriodLastDay ropts
today = fromMaybe (error' "balanceReport: could not pick a valuation date, ReportOpts today_ is unset") today_
multiperiod = interval_ /= NoInterval
-- Modify this tree for display - depth limit, boring parents, zeroes - and convert to a list.
displayaccts :: [Account]
| queryDepth q == 0 =
dbg' "displayaccts" $
take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts valuedaccttree
| flat_ ropts = dbg' "displayaccts" $
filterzeros $
filterempty $
drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts valuedaccttree
| otherwise = dbg' "displayaccts" $
filter (not.aboring) $
drop 1 $ flattenAccounts $
markboring $
prunezeros $
sortAccountTreeByAmount (fromMaybe NormallyPositive normalbalance_) $
clipAccounts (queryDepth q) valuedaccttree
where
balance = if flat_ ropts then aebalance else aibalance
filterzeros = if empty_ then id else filter (not . mixedAmountLooksZero . balance)
filterempty = filter (\a -> anumpostings a > 0 || not (mixedAmountLooksZero (balance a)))
prunezeros = if empty_ then id else fromMaybe nullacct . pruneAccounts (mixedAmountLooksZero . balance)
markboring = if no_elide_ then id else markBoringParentAccounts
-- Make a report row for each account.
items = dbg "items" $ map (balanceReportItem ropts q) displayaccts
-- Sort report rows (except sorting by amount in tree mode, which was done above).
sorteditems
| sort_amount_ && tree_ ropts = items
| sort_amount_ = sortFlatBRByAmount items
| otherwise = sortBRByAccountDeclaration items
where
-- Sort the report rows, representing a flat account list, by row total.
sortFlatBRByAmount :: [BalanceReportItem] -> [BalanceReportItem]
sortFlatBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fourth4))
where
maybeflip = if normalbalance_ == Just NormallyNegative then id else flip
-- Sort the report rows by account declaration order then account name.
sortBRByAccountDeclaration :: [BalanceReportItem] -> [BalanceReportItem]
sortBRByAccountDeclaration rows = sortedrows
where
anamesandrows = [(first4 r, r) | r <- rows]
anames = map fst anamesandrows
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
sortedrows = sortAccountItemsLike sortedanames anamesandrows
-- Calculate the grand total.
total | not (flat_ ropts) = dbg "total" $ sum [amt | (_,_,indent,amt) <- items, indent == 0]
| otherwise = dbg "total" $
if flatShowsExclusiveBalance
then sum $ map fourth4 items
else sum $ map aebalance $ clipAccountsAndAggregate 1 displayaccts
-- Calculate percentages if needed.
mappedtotal | percent_ = dbg "mappedtotal" $ total `perdivide` total
| otherwise = total
mappedsorteditems | percent_ =
dbg "mappedsorteditems" $
map (\(fname, sname, indent, amount) -> (fname, sname, indent, amount `perdivide` total)) sorteditems
| otherwise = sorteditems
-- | A sorting helper: sort a list of things (eg report rows) keyed by account name
-- to match the provided ordering of those same account names.
sortAccountItemsLike :: [AccountName] -> [(AccountName, b)] -> [b]
sortAccountItemsLike sortedas items =
concatMap (\a -> maybe [] (:[]) $ lookup a items) sortedas
-- | In an account tree with zero-balance leaves removed, mark the
-- elidable parent accounts (those with one subaccount and no balance
-- of their own).
markBoringParentAccounts :: Account -> Account
markBoringParentAccounts = tieAccountParents . mapAccounts mark
where
mark a | length (asubs a) == 1 && mixedAmountLooksZero (aebalance a) = a{aboring=True}
| otherwise = a
balanceReportItem :: ReportOpts -> Query -> Account -> BalanceReportItem
balanceReportItem opts q a
| flat_ opts = (name, name, 0, (if flatShowsExclusiveBalance then aebalance else aibalance) a)
| otherwise = (name, elidedname, indent, aibalance a)
where
name | queryDepth q > 0 = aname a
| otherwise = "..."
elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])
adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring parents
indent = length $ filter (not.aboring) parents
-- parents exclude the tree's root node
parents = case parentAccounts a of [] -> []
as -> init as
-- -- the above using the newer multi balance report code:
-- balanceReport' opts q j = (items, total)
-- where
-- MultiBalanceReport (_,mbrrows,mbrtotals) = PeriodChangeReport opts q j
-- items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]
-- total = headDef 0 mbrtotals
-- | Flip the sign of all amounts in a BalanceReport.
brNegate :: BalanceReport -> BalanceReport
brNegate (is, tot) = (map brItemNegate is, -tot)
where
brItemNegate (a, a', d, amt) = (a, a', d, -amt)
-- | Helper to unify a MixedAmount to a single commodity value.
-- Like normaliseMixedAmount, this consolidates amounts of the same commodity
-- and discards zero amounts; but this one insists on simplifying to
-- a single commodity, and will throw a program-terminating error if
-- this is not possible.
unifyMixedAmount :: MixedAmount -> Amount
unifyMixedAmount mixedAmount = foldl combine (num 0) (amounts mixedAmount)
where
combine amount result =
if amountIsZero amount
then result
else if amountIsZero result
then amount
else if acommodity amount == acommodity result
then amount + result
else error' "Cannot calculate percentages for accounts with multiple commodities. (Hint: Try --cost, -V or similar flags.)"
-- | Helper to calculate the percentage from two mixed. Keeps the sign of the first argument.
-- Uses unifyMixedAmount to unify each argument and then divides them.
perdivide :: MixedAmount -> MixedAmount -> MixedAmount
perdivide a b =
let a' = unifyMixedAmount a
b' = unifyMixedAmount b
in if amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b'
then mixed [per $ if aquantity b' == 0 then 0 else (aquantity a' / abs (aquantity b') * 100)]
else error' "Cannot calculate percentages if accounts have different commodities. (Hint: Try --cost, -V or similar flags.)"
-- tests -- tests
@ -259,13 +96,13 @@ tests_BalanceReport = tests "BalanceReport" [
let (eitems, etotal) = r let (eitems, etotal) = r
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
(map showw eitems) @?= (map showw aitems) (map showw aitems) @?= (map showw eitems)
(showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal) (showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal)
in in
tests "balanceReport" [ tests "balanceReport" [
test "no args, null journal" $ test "no args, null journal" $
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) (defreportopts, nulljournal) `gives` ([], Mixed [])
,test "no args, sample journal" $ ,test "no args, sample journal" $
(defreportopts, samplejournal) `gives` (defreportopts, samplejournal) `gives`
@ -303,7 +140,7 @@ tests_BalanceReport = tests "BalanceReport" [
,test "with date:" $ ,test "with date:" $
(defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`
([], ([],
Mixed [nullamt]) Mixed [])
,test "with date2:" $ ,test "with date2:" $
(defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives` (defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives`
@ -345,7 +182,7 @@ tests_BalanceReport = tests "BalanceReport" [
,test "with period on an unpopulated period" $ ,test "with period on an unpopulated period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives` (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives`
([],Mixed [nullamt]) ([],Mixed [])

54
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -37,7 +37,6 @@ import Hledger.Utils
--import Hledger.Read (mamountp') --import Hledger.Read (mamountp')
import Hledger.Reports.ReportOptions import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes import Hledger.Reports.ReportTypes
import Hledger.Reports.BalanceReport (sortAccountItemsLike)
import Hledger.Reports.MultiBalanceReport import Hledger.Reports.MultiBalanceReport
@ -47,8 +46,8 @@ type BudgetAverage = Average
-- | A budget report tracks expected and actual changes per account and subperiod. -- | A budget report tracks expected and actual changes per account and subperiod.
type BudgetCell = (Maybe Change, Maybe BudgetGoal) type BudgetCell = (Maybe Change, Maybe BudgetGoal)
type BudgetReport = PeriodicReport AccountName BudgetCell type BudgetReport = PeriodicReport DisplayName BudgetCell
type BudgetReportRow = PeriodicReportRow AccountName BudgetCell type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
-- | Calculate budget goals from all periodic transactions, -- | Calculate budget goals from all periodic transactions,
-- actual balance changes from the regular transactions, -- actual balance changes from the regular transactions,
@ -72,9 +71,9 @@ budgetReport ropts' assrt reportspan d j =
actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j
budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j
actualreport@(PeriodicReport actualspans _ _) = actualreport@(PeriodicReport actualspans _ _) =
dbg1 "actualreport" $ multiBalanceReport d ropts actualj dbg1 "actualreport" $ multiBalanceReport d ropts{empty_=True} actualj
budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) = budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =
dbg1 "budgetgoalreport" $ multiBalanceReport d (ropts{empty_=True}) budgetj dbg1 "budgetgoalreport" $ multiBalanceReport d ropts{empty_=True} budgetj
budgetgoalreport' budgetgoalreport'
-- If no interval is specified: -- If no interval is specified:
-- budgetgoalreport's span might be shorter actualreport's due to periodic txns; -- budgetgoalreport's span might be shorter actualreport's due to periodic txns;
@ -99,9 +98,9 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte
sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow]
sortTreeBURByActualAmount rows = sortedrows sortTreeBURByActualAmount rows = sortedrows
where where
anamesandrows = [(prrName r, r) | r <- rows] anamesandrows = [(prrFullName r, r) | r <- rows]
anames = map fst anamesandrows anames = map fst anamesandrows
atotals = [(a, tot) | PeriodicReportRow a _ _ (tot,_) _ <- rows] atotals = [(displayFull a, tot) | PeriodicReportRow a _ (tot,_) _ <- rows]
accounttree = accountTree "root" anames accounttree = accountTree "root" anames
accounttreewithbals = mapAccounts setibalance accounttree accounttreewithbals = mapAccounts setibalance accounttree
where where
@ -124,8 +123,8 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte
-- <unbudgeted> remains at the top. -- <unbudgeted> remains at the top.
sortByAccountDeclaration rows = sortedrows sortByAccountDeclaration rows = sortedrows
where where
(unbudgetedrow,rows') = partition ((=="<unbudgeted>") . prrName) rows (unbudgetedrow,rows') = partition ((==unbudgetedAccountName) . prrFullName) rows
anamesandrows = [(prrName r, r) | r <- rows'] anamesandrows = [(prrFullName r, r) | r <- rows']
anames = map fst anamesandrows anames = map fst anamesandrows
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows
@ -189,17 +188,17 @@ budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j }
-- --
combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport
combineBudgetAndActual combineBudgetAndActual
(PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ _ budgettots budgetgrandtot budgetgrandavg)) (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg))
(PeriodicReport actualperiods actualrows (PeriodicReportRow _ _ actualtots actualgrandtot actualgrandavg)) = (PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) =
PeriodicReport periods rows totalrow PeriodicReport periods rows totalrow
where where
periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods
-- first, combine any corresponding budget goals with actual changes -- first, combine any corresponding budget goals with actual changes
rows1 = rows1 =
[ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal
| PeriodicReportRow acct treeindent actualamts actualtot actualavg <- actualrows | PeriodicReportRow acct actualamts actualtot actualavg <- actualrows
, let mbudgetgoals = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) , let mbudgetgoals = Map.lookup (displayFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
, let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal] , let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]
, let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal , let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal
, let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage , let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage
@ -211,14 +210,14 @@ combineBudgetAndActual
] ]
where where
budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
Map.fromList [ (acct, (amts, tot, avg)) Map.fromList [ (displayFull acct, (amts, tot, avg))
| PeriodicReportRow acct _ amts tot avg <- budgetrows ] | PeriodicReportRow acct amts tot avg <- budgetrows ]
-- next, make rows for budget goals with no actual changes -- next, make rows for budget goals with no actual changes
rows2 = rows2 =
[ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal
| PeriodicReportRow acct treeindent budgetgoals budgettot budgetavg <- budgetrows | PeriodicReportRow acct budgetgoals budgettot budgetavg <- budgetrows
, acct `notElem` map prrName rows1 , displayFull acct `notElem` map prrFullName rows1
, let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal
, let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell] , let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell]
, let totamtandgoal = (Nothing, Just budgettot) , let totamtandgoal = (Nothing, Just budgettot)
@ -230,10 +229,10 @@ combineBudgetAndActual
-- TODO: respect --sort-amount -- TODO: respect --sort-amount
-- TODO: add --sort-budget to sort by budget goal amount -- TODO: add --sort-budget to sort by budget goal amount
rows :: [BudgetReportRow] = rows :: [BudgetReportRow] =
sortOn prrName $ rows1 ++ rows2 sortOn prrFullName $ rows1 ++ rows2
-- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
totalrow = PeriodicReportRow () 0 totalrow = PeriodicReportRow ()
[ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ]
( Just actualgrandtot, Just budgetgrandtot ) ( Just actualgrandtot, Just budgetgrandtot )
( Just actualgrandavg, Just budgetgrandavg ) ( Just actualgrandavg, Just budgetgrandavg )
@ -311,7 +310,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount) budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
budgetReportAsTable budgetReportAsTable
ropts ropts
(PeriodicReport periods rows (PeriodicReportRow _ _ coltots grandtot grandavg)) = (PeriodicReport periods rows (PeriodicReportRow _ coltots grandtot grandavg)) =
addtotalrow $ addtotalrow $
Table Table
(T.Group NoLine $ map Header accts) (T.Group NoLine $ map Header accts)
@ -322,10 +321,13 @@ budgetReportAsTable
++ [" Total" | row_total_ ropts] ++ [" Total" | row_total_ ropts]
++ ["Average" | average_ ropts] ++ ["Average" | average_ ropts]
accts = map renderacct rows accts = map renderacct rows
renderacct (PeriodicReportRow a i _ _ _) -- FIXME. Have to check explicitly for which to render here, since
| tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack (accountLeafName a) -- budgetReport sets accountlistmode to ALTree. Find a principled way to do
| otherwise = T.unpack $ maybeAccountNameDrop ropts a -- this.
rowvals (PeriodicReportRow _ _ as rowtot rowavg) = renderacct row
| tree_ ropts = replicate ((prrDepth row - 1)*2) ' ' ++ T.unpack (prrDisplayName row)
| otherwise = T.unpack . maybeAccountNameDrop ropts $ prrFullName row
rowvals (PeriodicReportRow _ as rowtot rowavg) =
as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts] as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts]
addtotalrow addtotalrow
| no_total_ ropts = id | no_total_ ropts = id

605
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -1,4 +1,8 @@
{-# LANGUAGE FlexibleInstances, RecordWildCards, ScopedTypeVariables, OverloadedStrings, DeriveGeneric #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-| {-|
Multi-column balance reports, used by the balance command. Multi-column balance reports, used by the balance command.
@ -14,16 +18,23 @@ module Hledger.Reports.MultiBalanceReport (
balanceReportFromMultiBalanceReport, balanceReportFromMultiBalanceReport,
tableAsText, tableAsText,
sortAccountItemsLike,
-- -- * Tests -- -- * Tests
tests_MultiBalanceReport tests_MultiBalanceReport
) )
where where
import Data.List import Data.List
import Data.List.Extra (nubSort) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Time.Calendar import Data.Time.Calendar
import Safe import Safe
import Text.Tabular as T import Text.Tabular as T
@ -35,7 +46,6 @@ import Hledger.Utils
import Hledger.Read (mamountp') import Hledger.Read (mamountp')
import Hledger.Reports.ReportOptions import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes import Hledger.Reports.ReportTypes
import Hledger.Reports.BalanceReport
-- | A multi balance report is a kind of periodic report, where the amounts -- | A multi balance report is a kind of periodic report, where the amounts
@ -45,9 +55,7 @@ import Hledger.Reports.BalanceReport
-- --
-- 2. a list of rows, each containing: -- 2. a list of rows, each containing:
-- --
-- * the full account name -- * the full account name, display name, and display depth
--
-- * the account's depth
-- --
-- * A list of amounts, one for each column. -- * A list of amounts, one for each column.
-- --
@ -58,8 +66,8 @@ import Hledger.Reports.BalanceReport
-- 3. the column totals, and the overall grand total (or zero for -- 3. the column totals, and the overall grand total (or zero for
-- cumulative/historical reports) and grand average. -- cumulative/historical reports) and grand average.
type MultiBalanceReport = PeriodicReport AccountName MixedAmount type MultiBalanceReport = PeriodicReport DisplayName MixedAmount
type MultiBalanceReportRow = PeriodicReportRow AccountName MixedAmount type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount
-- type alias just to remind us which AccountNames might be depth-clipped, below. -- type alias just to remind us which AccountNames might be depth-clipped, below.
type ClippedAccountName = AccountName type ClippedAccountName = AccountName
@ -85,207 +93,304 @@ multiBalanceReport today ropts j =
-- once for efficiency, passing it to each report by calling this -- once for efficiency, passing it to each report by calling this
-- function directly. -- function directly.
multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = multiBalanceReportWith ropts q j priceoracle = report
(if invert_ then prNegate else id) $
PeriodicReport colspans mappedsortedrows mappedtotalsrow
where where
-- add a prefix to this function's debug output -- Queries, report/column dates.
dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg3 (p++" "++s) ropts' = dbg "ropts'" $ setDefaultAccountListMode ALFlat ropts
dbg' s = let p = "multiBalanceReport" in Hledger.Utils.dbg4 (p++" "++s) reportspan = dbg "reportspan" $ calculateReportSpan ropts' q j
dbg'' s = let p = "multiBalanceReport" in Hledger.Utils.dbg5 (p++" "++s) reportq = dbg "reportq" $ makeReportQuery ropts' reportspan q
-- dbg = const id -- exclude this function from debug output
---------------------------------------------------------------------- -- The matched accounts with a starting balance. All of these should appear
-- 1. Queries, report/column dates. -- in the report, even if they have no postings during the report period.
startbals = dbg' "startbals" $ startingBalances ropts' reportq j reportspan
symq = dbg "symq" $ filterQuery queryIsSym $ dbg "requested q" q -- Postings matching the query within the report period.
depthq = dbg "depthq" $ filterQuery queryIsDepth q ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts' reportq j
depth = queryDepth depthq days = map snd ps
depthless = dbg "depthless" . filterQuery (not . queryIsDepth)
datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) q -- The date spans to be included as report columns.
dateqcons = if date2_ then Date2 else Date colspans = dbg "colspans" $ calculateColSpans ropts' reportspan days
-- Group postings into their columns.
colps = dbg'' "colps" $ calculateColumns colspans ps
-- Each account's balance changes across all columns.
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts' q colspans startbals colps
-- Process changes into normal, cumulative, or historical amounts, plus value them
accumvalued = dbg'' "accumvalued" $ accumValueAmounts ropts' j priceoracle colspans startbals acctchanges
-- All account names that will be displayed, possibly depth-clipped.
displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts' q accumvalued
-- All the rows of the report.
rows = dbg'' "rows" $ buildReportRows ropts' accumvalued
-- Sorted report rows.
sortedrows = dbg' "sortedrows" $ sortRows ropts' j rows
-- Calculate column totals
totalsrow = dbg' "totalsrow" $ calculateTotalsRow ropts' displayaccts sortedrows
-- Postprocess the report, negating balances and taking percentages if needed
report = dbg' "report" . postprocessReport ropts' displayaccts $
PeriodicReport colspans sortedrows totalsrow
-- | Calculate the span of the report to be generated.
setDefaultAccountListMode :: AccountListMode -> ReportOpts -> ReportOpts
setDefaultAccountListMode def ropts = ropts{accountlistmode_=mode}
where
mode = case accountlistmode_ ropts of
ALDefault -> def
a -> a
-- | Calculate the span of the report to be generated.
calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan
calculateReportSpan ropts q j = reportspan
where
-- The date span specified by -b/-e/-p options and query args if any. -- The date span specified by -b/-e/-p options and query args if any.
requestedspan = dbg "requestedspan" $ queryDateSpan date2_ q requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) q
-- If the requested span is 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.
-- This can still be the null (open) span if the journal is empty. -- This can still be the null (open) span if the journal is empty.
requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan date2_ j requestedspan' = dbg "requestedspan'" $
requestedspan `spanDefaultsFrom` journalDateSpan (date2_ ropts) j
-- The list of interval spans enclosing the requested span. -- The list of interval spans enclosing the requested span.
-- This list can be empty if the journal was empty, -- This list can be empty if the journal was empty,
-- or if hledger-ui has added its special date:-tomorrow to the query -- or if hledger-ui has added its special date:-tomorrow to the query
-- and all txns are in the future. -- and all txns are in the future.
intervalspans = dbg "intervalspans" $ splitSpan interval_ requestedspan' intervalspans = dbg "intervalspans" $ splitSpan (interval_ ropts) requestedspan'
-- The requested span enlarged to enclose a whole number of intervals. -- The requested span enlarged to enclose a whole number of intervals.
-- This can be the null span if there were no intervals. -- This can be the null span if there were no intervals.
reportspan = dbg "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) reportspan = DateSpan (spanStart =<< headMay intervalspans)
(maybe Nothing spanEnd $ lastMay intervalspans) (spanEnd =<< lastMay intervalspans)
mreportstart = spanStart reportspan
-- The user's query with no depth limit, and expanded to the report span -- | Remove any date queries and insert queries from the report span.
-- if there is one (otherwise any date queries are left as-is, which -- The user's query expanded to the report span
-- handles the hledger-ui+future txns case above). -- if there is one (otherwise any date queries are left as-is, which
reportq = dbg "reportq" $ depthless $ -- handles the hledger-ui+future txns case above).
if reportspan == nulldatespan makeReportQuery :: ReportOpts -> DateSpan -> Query -> Query
then q makeReportQuery ropts reportspan q
else And [datelessq, reportspandatesq] | reportspan == nulldatespan = q
| otherwise = And [dateless q, reportspandatesq]
where where
reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan
-- The date spans to be included as report columns. dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2)
colspans :: [DateSpan] = dbg "colspans" $ splitSpan interval_ displayspan dateqcons = if date2_ ropts then Date2 else Date
where
displayspan
| empty_ = dbg "displayspan (-E)" reportspan -- all the requested intervals
| otherwise = dbg "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals
matchedspan = dbg "matchedspan" . daysSpan $ map snd ps
-- If doing cost valuation, convert amounts to cost. -- | Calculate starting balances, if needed for -H
j' = journalSelectingAmountFromOpts ropts j --
-- Balances at report start date, from all earlier postings which otherwise match the query.
-- These balances are unvalued.
-- TODO: Do we want to check whether to bother calculating these? isHistorical
-- and startDate is not nothing, otherwise mempty? This currently gives a
-- failure with some totals which are supposed to be 0 being blank.
startingBalances :: ReportOpts -> Query -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ropts q j reportspan = acctchanges
where
acctchanges = acctChangesFromPostings ropts' startbalq . map fst $
getPostings ropts' startbalq j
----------------------------------------------------------------------
-- 2. Calculate starting balances, if needed for -H
-- Balances at report start date, from all earlier postings which otherwise match the query.
-- These balances are unvalued except maybe converted to cost.
startbals :: [(AccountName, MixedAmount)] = dbg' "startbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems
where
(startbalanceitems,_) = dbg'' "starting balance report" $ balanceReport ropts''{value_=Nothing, percent_=False} startbalq j'
where
ropts' | tree_ ropts = ropts{no_elide_=True}
| otherwise = ropts{accountlistmode_=ALFlat}
ropts'' = ropts'{period_ = precedingperiod}
where
precedingperiod = dateSpanAsPeriod $ spanIntersect (DateSpan Nothing mreportstart) $ periodAsDateSpan period_
-- q projected back before the report start date. -- q projected back before the report start date.
-- When there's no report start date, in case there are future txns (the hledger-ui case above), -- 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. -- we use emptydatespan to make sure they aren't counted as starting balance.
startbalq = dbg'' "startbalq" $ And [datelessq, dateqcons precedingspan] startbalq = dbg'' "startbalq" $ And [datelessq, precedingspanq]
where datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
precedingspan = case mreportstart of
Just d -> DateSpan Nothing (Just d)
Nothing -> emptydatespan
-- 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.
startaccts = dbg'' "startaccts" $ map fst startbals
-- Helpers to look up an account's starting balance.
startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startbals
---------------------------------------------------------------------- ropts' | tree_ ropts = ropts{no_elide_=True, period_=precedingperiod}
-- 3. Gather postings for each column. | otherwise = ropts{accountlistmode_=ALFlat, period_=precedingperiod}
-- Postings matching the query within the report period. precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
ps :: [(Posting, Day)] = periodAsDateSpan $ period_ ropts
dbg'' "ps" $ precedingspan = DateSpan Nothing $ spanStart reportspan
map postingWithDate $ precedingspanq = (if date2_ ropts then Date2 else Date) $ case precedingspan of
journalPostings $ DateSpan Nothing Nothing -> emptydatespan
filterJournalAmounts symq $ -- remove amount parts excluded by cur: a -> a
filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
j'
where
postingWithDate p = case whichDateFromOpts ropts of
PrimaryDate -> (p, postingDate p)
SecondaryDate -> (p, postingDate2 p)
-- Group postings into their columns, with the column end dates. -- | Gather postings matching the query within the report period.
colps :: [([Posting], Maybe Day)] = getPostings :: ReportOpts -> Query -> Journal -> [(Posting, Day)]
dbg'' "colps" getPostings ropts q =
[ (posts, end) | (DateSpan _ end, posts) <- M.toList colMap ] map (\p -> (p, date p)) .
journalPostings .
filterJournalAmounts symq . -- remove amount parts excluded by cur:
filterJournalPostings reportq -- remove postings not matched by (adjusted) query
where
symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" q
-- 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 = dbg "reportq" $ depthless q
depthless = dbg "depthless" . filterQuery (not . queryIsDepth)
date = case whichDateFromOpts ropts of
PrimaryDate -> postingDate
SecondaryDate -> postingDate2
-- | Calculate the DateSpans to be used for the columns of the report.
calculateColSpans :: ReportOpts -> DateSpan -> [Day] -> [DateSpan]
calculateColSpans ropts reportspan days =
splitSpan (interval_ ropts) displayspan
where
displayspan
| empty_ ropts = dbg "displayspan (-E)" reportspan -- all the requested intervals
| otherwise = dbg "displayspan" $ reportspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals
matchedspan = dbg "matchedspan" $ daysSpan days
-- | Group postings into their columns.
calculateColumns :: [DateSpan] -> [(Posting, Day)] -> Map DateSpan [Posting]
calculateColumns colspans = foldr addPosting emptyMap
where where
colMap = foldr addPosting emptyMap ps
addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d
emptyMap = M.fromList . zip colspans $ repeat [] emptyMap = M.fromList . zip colspans $ repeat []
---------------------------------------------------------------------- -- | Calculate account balance changes in each column.
-- 4. Calculate account balance changes in each column. --
-- In each column, gather the accounts that have postings and their change amount.
-- In each column, gather the accounts that have postings and their change amount. acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings :: [Posting] -> [(ClippedAccountName, MixedAmount)] acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as]
acctChangesFromPostings ps = [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as]
where where
as = depthLimit $ as = filterAccounts . drop 1 $ accountsFromPostings ps
(if tree_ ropts then id else filter ((>0).anumpostings)) $ filterAccounts
drop 1 $ accountsFromPostings ps | tree_ ropts = filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
depthLimit | otherwise = clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
| tree_ ropts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances filter ((0<) . anumpostings)
| otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit depthq = dbg "depthq" $ filterQuery queryIsDepth q
colacctchanges :: [[(ClippedAccountName, MixedAmount)]] =
dbg'' "colacctchanges" $ map (acctChangesFromPostings . fst) colps
---------------------------------------------------------------------- -- | Gather the account balance changes into a regular matrix including the accounts
-- 5. Gather the account balance changes into a regular matrix including the accounts -- from all columns
-- from all columns (and with -H, accounts with starting balances), adding zeroes where needed. calculateAccountChanges :: ReportOpts -> Query -> [DateSpan]
-> HashMap ClippedAccountName Account
-- All account names that will be displayed, possibly depth-clipped. -> Map DateSpan [Posting]
displayaccts :: [ClippedAccountName] = -> HashMap ClippedAccountName (Map DateSpan Account)
dbg'' "displayaccts" $ calculateAccountChanges ropts q colspans startbals colps
(if tree_ ropts then expandAccountNames else id) $ | queryDepth q == 0 = acctchanges <> elided
nub $ map (clipOrEllipsifyAccountName depth) $ | otherwise = acctchanges
if empty_ || balancetype_ == HistoricalBalance
then nubSort $ startaccts ++ allpostedaccts
else allpostedaccts
where where
allpostedaccts :: [AccountName] =
dbg'' "allpostedaccts" . sort . accountNamesFromPostings $ map fst ps
-- Each column's balance changes for each account, adding zeroes where needed.
colallacctchanges :: [[(ClippedAccountName, MixedAmount)]] =
dbg'' "colallacctchanges"
[ sortOn fst $ unionBy (\(a,_) (a',_) -> a == a') postedacctchanges zeroes
| postedacctchanges <- colacctchanges ]
where zeroes = [(a, nullmixedamt) | a <- displayaccts]
-- Transpose to get each account's balance changes across all columns. -- Transpose to get each account's balance changes across all columns.
acctchanges :: [(ClippedAccountName, [MixedAmount])] = acctchanges = transposeMap colacctchanges <> (mempty <$ startbals)
dbg'' "acctchanges"
[(a, map snd abs) | abs@((a,_):_) <- transpose colallacctchanges] -- never null, or used when null...
---------------------------------------------------------------------- colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) =
-- 6. Build the report rows. dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts q) colps
elided = HM.singleton "..." $ M.fromList [(span, nullacct) | span <- colspans]
-- | Accumulate and value amounts, as specified by the report options.
--
-- Makes sure all report columns have an entry.
accumValueAmounts :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
-> HashMap ClippedAccountName Account
-> HashMap ClippedAccountName (Map DateSpan Account)
-> HashMap ClippedAccountName [Account]
accumValueAmounts ropts j priceoracle colspans startbals = HM.mapWithKey processRow
where
-- Must accumulate before valuing, since valuation can change without any
-- postings
processRow name col = zipWith valueAcct spans $ rowbals name amts
where (spans, amts) = unzip . M.toList $ col <> zeros
-- One row per account, with account name info, row amounts, row total and row average.
rows :: [MultiBalanceReportRow] =
dbg'' "rows" $
[ PeriodicReportRow a (accountNameLevel a) valuedrowbals rowtot rowavg
| (a,changes) <- dbg'' "acctchanges" acctchanges
-- The row amounts to be displayed: per-period changes, -- The row amounts to be displayed: per-period changes,
-- zero-based cumulative totals, or -- zero-based cumulative totals, or
-- starting-balance-based historical balances. -- starting-balance-based historical balances.
, let rowbals = dbg'' "rowbals" $ case balancetype_ of rowbals name changes = dbg'' "rowbals" $ case balancetype_ ropts of
PeriodChange -> changes PeriodChange -> changes
CumulativeChange -> drop 1 $ scanl (+) 0 changes CumulativeChange -> drop 1 $ scanl sumAcct nullacct changes
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes HistoricalBalance -> drop 1 $ scanl sumAcct (startingBalanceFor name) changes
-- Add the values of two accounts. Should be right-biased, since it's used
-- in scanl, so other properties (such as anumpostings) stay in the right place
sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
a{aibalance = i1 + i2, aebalance = e1 + e2}
-- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports". -- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
, let valuedrowbals = dbg'' "valuedrowbals" $ [avalue periodlastday amt | (amt,periodlastday) <- zip rowbals lastdays] valueAcct (DateSpan _ (Just end)) acct =
-- The total and average for the row. acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)}
-- These are always simply the sum/average of the displayed row amounts. where value = avalue (addDays (-1) end)
-- Total for a cumulative/historical report is always zero. valueAcct _ _ = error' "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen
, let rowtot = if balancetype_==PeriodChange then sum valuedrowbals else 0
, let rowavg = averageMixedAmounts valuedrowbals avalue periodlast = maybe id
, empty_ || depth == 0 || any (not . mixedAmountLooksZero) valuedrowbals (mixedAmountApplyValuation priceoracle styles periodlast mreportlast today multiperiod) $
] value_ ropts
where
avalue periodlast =
maybe id (mixedAmountApplyValuation priceoracle styles periodlast mreportlast today multiperiod) value_
where where
-- Some things needed if doing valuation. -- Some things needed if doing valuation.
styles = journalCommodityStyles j styles = journalCommodityStyles j
mreportlast = reportPeriodLastDay ropts mreportlast = reportPeriodLastDay ropts
today = fromMaybe (error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") today_ -- XXX shouldn't happen today = fromMaybe (error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- XXX shouldn't happen
multiperiod = interval_ /= NoInterval multiperiod = interval_ ropts /= NoInterval
-- The last day of each column's subperiod.
lastdays =
map ((maybe
(error' "multiBalanceReport: expected all spans to have an end date") -- XXX should not happen
(addDays (-1)))
. spanEnd) colspans
---------------------------------------------------------------------- startingBalanceFor a = HM.lookupDefault nullacct a startbals
-- 7. Sort the report rows.
-- Sort the rows by amount or by account declaration order. This is a bit tricky. zeros = M.fromList [(span, nullacct) | span <- colspans]
-- TODO: is it always ok to sort report rows after report has been generated, as a separate step ?
sortedrows :: [MultiBalanceReportRow] = -- | Build the report rows.
dbg' "sortedrows" $ --
sortrows rows -- One row per account, with account name info, row amounts, row total and row average.
buildReportRows :: ReportOpts -> HashMap AccountName [Account] -> [MultiBalanceReportRow]
buildReportRows ropts acctvalues =
[ PeriodicReportRow (flatDisplayName a) rowbals rowtot rowavg
| (a,accts) <- HM.toList acctvalues
, let rowbals = map balance accts
-- The total and average for the row.
-- These are always simply the sum/average of the displayed row amounts.
-- Total for a cumulative/historical report is always zero.
, let rowtot = if balancetype_ ropts == PeriodChange then sum rowbals else 0
, let rowavg = averageMixedAmounts rowbals
]
where balance = if tree_ ropts then aibalance else aebalance
-- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth
displayedAccounts :: ReportOpts -> Query
-> HashMap AccountName [Account]
-> HashMap AccountName DisplayName
displayedAccounts ropts q valuedaccts
| depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 0
| otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
where where
sortrows -- Accounts which are to be displayed
| sort_amount_ && accountlistmode_ == ALTree = sortTreeMBRByAmount displayedAccts = HM.filterWithKey keep valuedaccts
| sort_amount_ = sortFlatMBRByAmount where
keep name amts = isInteresting name amts || name `HM.member` interestingParents
isDisplayed = (`HM.member` displayedAccts)
displayedName name
| flat_ ropts = DisplayName name droppedName 0
| otherwise = DisplayName name leaf d
where
leaf = accountNameFromComponents . reverse . map accountLeafName $
droppedName : takeWhile (not . isDisplayed) parents
d | no_elide_ ropts = accountNameLevel droppedName
| otherwise = accountNameLevel droppedName - length boringParents
boringParents = filter (not . isDisplayed) parents
parents = parentAccountNames droppedName
droppedName = accountNameDrop (drop_ ropts) name
-- Accounts interesting for their own sake
isInteresting name amts =
d <= depth -- Throw out anything too deep
&& (empty_ ropts || depth == 0 || not (isZeroRow balance amts)) -- Boring because has only zero entries
where
d = accountNameLevel name
balance = if tree_ ropts && d == depth then aibalance else aebalance
-- Accounts interesting because they are a fork for interesting subaccounts
interestingParents = dbg'' "interestingParents" $ HM.filterWithKey keepParent tallies
where
keepParent name subaccts
| flat_ ropts = False
| no_elide_ ropts = subaccts > 0 && accountNameLevel name > drop_ ropts
| otherwise = subaccts > 1 && accountNameLevel name > drop_ ropts
tallies = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
isZeroRow balance = all (mixedAmountLooksZero . balance)
depth = queryDepth q
-- | Sort the rows by amount or by account declaration order. This is a bit tricky.
-- TODO: is it always ok to sort report rows after report has been generated, as a separate step ?
sortRows :: ReportOpts -> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortRows ropts j
| sort_amount_ ropts && accountlistmode_ ropts == ALTree = sortTreeMBRByAmount
| sort_amount_ ropts = sortFlatMBRByAmount
| otherwise = sortMBRByAccountDeclaration | otherwise = sortMBRByAccountDeclaration
where where
-- Sort the report rows, representing a tree of accounts, by row total at each level. -- Sort the report rows, representing a tree of accounts, by row total at each level.
@ -293,92 +398,154 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortTreeMBRByAmount rows = sortedrows sortTreeMBRByAmount rows = sortedrows
where where
anamesandrows = [(prrName r, r) | r <- rows] anamesandrows = [(prrFullName r, r) | r <- rows]
anames = map fst anamesandrows anames = map fst anamesandrows
atotals = [(prrName r, prrTotal r) | r <- rows] atotals = [(prrFullName r, prrTotal r) | r <- rows]
accounttree = accountTree "root" anames accounttree = accountTree "root" anames
accounttreewithbals = mapAccounts setibalance accounttree accounttreewithbals = mapAccounts setibalance accounttree
where where
-- should not happen, but it's dangerous; TODO -- should not happen, but it's dangerous; TODO
setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals} setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals}
sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive normalbalance_) accounttreewithbals sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals
sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
sortedrows = sortAccountItemsLike sortedanames anamesandrows sortedrows = sortAccountItemsLike sortedanames anamesandrows
-- Sort the report rows, representing a flat account list, by row total. -- Sort the report rows, representing a flat account list, by row total.
sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . prrTotal)) sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . prrTotal))
where where
maybeflip = if normalbalance_ == Just NormallyNegative then id else flip maybeflip = if normalbalance_ ropts == Just NormallyNegative then id else flip
-- Sort the report rows by account declaration order then account name. -- Sort the report rows by account declaration order then account name.
sortMBRByAccountDeclaration rows = sortedrows sortMBRByAccountDeclaration rows = sortedrows
where where
anamesandrows = [(prrName r, r) | r <- rows] anamesandrows = [(prrFullName r, r) | r <- rows]
anames = map fst anamesandrows anames = map fst anamesandrows
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
sortedrows = sortAccountItemsLike sortedanames anamesandrows sortedrows = sortAccountItemsLike sortedanames anamesandrows
---------------------------------------------------------------------- -- | Build the report totals row.
-- 8. Build the report totals row. --
-- Calculate the column totals. These are always the sum of column amounts.
calculateTotalsRow :: ReportOpts -> HashMap ClippedAccountName DisplayName
-> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount
calculateTotalsRow ropts displayaccts rows =
PeriodicReportRow () coltotals grandtotal grandaverage
where
highestlevelaccts = HM.filterWithKey (\a _ -> isHighest a) displayaccts
where isHighest = not . any (`HM.member` displayaccts) . init . expandAccountName
-- Calculate the column totals. These are always the sum of column amounts.
highestlevelaccts = [a | a <- displayaccts, not $ any (`elem` displayaccts) $ init $ expandAccountName a]
colamts = transpose . map prrAmounts $ filter isHighest rows colamts = transpose . map prrAmounts $ filter isHighest rows
where isHighest row = not (tree_ ropts) || prrName row `elem` highestlevelaccts where isHighest row = not (tree_ ropts) || prrFullName row `HM.member` highestlevelaccts
coltotals :: [MixedAmount] =
dbg'' "coltotals" $ map sum colamts -- TODO: If colamts is null, then this is empty. Do we want it to be a full
-- column of zeros?
coltotals :: [MixedAmount] = dbg'' "coltotals" $ map sum colamts
-- Calculate the grand total and average. These are always the sum/average -- Calculate the grand total and average. These are always the sum/average
-- of the column totals. -- of the column totals.
[grandtotal,grandaverage] = grandtotal = if balancetype_ ropts == PeriodChange then sum coltotals else 0
let amts = map ($ map sum colamts) grandaverage = averageMixedAmounts coltotals
[if balancetype_==PeriodChange then sum else const 0
,averageMixedAmounts -- | Map the report rows to percentages and negate if needed
] postprocessReport :: ReportOpts -> HashMap AccountName DisplayName
in amts -> MultiBalanceReport -> MultiBalanceReport
-- Totals row. postprocessReport ropts displaynames =
totalsrow :: PeriodicReportRow () MixedAmount = maybeInvert . maybePercent . setNames
dbg' "totalsrow" $ PeriodicReportRow () 0 coltotals grandtotal grandaverage where
setNames = prMapMaybeName $ (`HM.lookup` displaynames) . displayFull
maybeInvert = if invert_ ropts then prNegate else id
maybePercent = if percent_ ropts then prPercent else id
prPercent (PeriodicReport spans rows totalrow) =
PeriodicReport spans (map percentRow rows) (percentRow totalrow)
where
percentRow (PeriodicReportRow name rowvals rowtotal rowavg) =
PeriodicReportRow name
(zipWith perdivide rowvals $ prrAmounts totalrow)
(perdivide rowtotal $ prrTotal totalrow)
(perdivide rowavg $ prrAverage totalrow)
----------------------------------------------------------------------
-- 9. Map the report rows to percentages if needed
-- It is not correct to do this before step 6 due to the total and average columns.
-- This is not done in step 6, since the report totals are calculated in 8.
-- Perform the divisions to obtain percentages
mappedsortedrows :: [MultiBalanceReportRow] =
if not percent_ then sortedrows
else dbg'' "mappedsortedrows"
[ PeriodicReportRow aname alevel
(zipWith perdivide rowvals coltotals)
(rowtotal `perdivide` grandtotal)
(rowavg `perdivide` grandaverage)
| PeriodicReportRow aname alevel rowvals rowtotal rowavg <- sortedrows
]
mappedtotalsrow :: PeriodicReportRow () MixedAmount
| percent_ = dbg'' "mappedtotalsrow" $ PeriodicReportRow () 0
(map (\t -> perdivide t t) coltotals)
(perdivide grandtotal grandtotal)
(perdivide grandaverage grandaverage)
| otherwise = totalsrow
-- | 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
-- (see ReportOpts and CompoundBalanceCommand). -- (see ReportOpts and CompoundBalanceCommand).
balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal
balanceReportFromMultiBalanceReport opts q j = (rows', total) -> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
balanceReportFromMultiBalanceReport ropts q j = (rows', total)
where where
PeriodicReport _ rows (PeriodicReportRow _ _ totals _ _) = PeriodicReport _ rows (PeriodicReportRow _ totals _ _) =
multiBalanceReportWith opts q j (journalPriceOracle (infer_value_ opts) j) multiBalanceReportWith ropts' q j (journalPriceOracle (infer_value_ ropts) j)
rows' = [( a rows' = [( displayFull a
, if flat_ opts then a else accountLeafName a -- BalanceReport expects full account name here with --flat , displayName a
, if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths , if tree_ ropts' then displayDepth a - 1 else 0 -- BalanceReport uses 0-based account depths
, headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does , headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does
) | PeriodicReportRow a d amts _ _ <- rows] ) | PeriodicReportRow a amts _ _ <- rows]
total = headDef nullmixedamt totals total = headDef nullmixedamt totals
ropts' = setDefaultAccountListMode ALTree ropts
-- | Transpose a Map of HashMaps to a HashMap of Maps.
--
-- Makes sure that all DateSpans are present in all rows.
transposeMap :: Map DateSpan (HashMap AccountName a)
-> HashMap AccountName (Map DateSpan a)
transposeMap xs = M.foldrWithKey addSpan mempty xs
where
addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap
addAcctSpan span acct a = HM.alter f acct
where f = Just . M.insert span a . fromMaybe mempty
-- | A sorting helper: sort a list of things (eg report rows) keyed by account name
-- to match the provided ordering of those same account names.
sortAccountItemsLike :: [AccountName] -> [(AccountName, b)] -> [b]
sortAccountItemsLike sortedas items = mapMaybe (`lookup` items) sortedas
-- | Given a list of account names, find all forking parent accounts, i.e.
-- those which fork between different branches
subaccountTallies :: [AccountName] -> HashMap AccountName Int
subaccountTallies as = foldr incrementParent mempty allaccts
where
allaccts = expandAccountNames as
incrementParent a = HM.insertWith (+) (parentAccountName a) 1
-- | Helper to unify a MixedAmount to a single commodity value.
-- Like normaliseMixedAmount, this consolidates amounts of the same commodity
-- and discards zero amounts; but this one insists on simplifying to
-- a single commodity, and will throw a program-terminating error if
-- this is not possible.
unifyMixedAmount :: MixedAmount -> Amount
unifyMixedAmount mixedAmount = foldl combine (num 0) (amounts mixedAmount)
where
combine amount result =
if amountIsZero amount
then result
else if amountIsZero result
then amount
else if acommodity amount == acommodity result
then amount + result
else error' "Cannot calculate percentages for accounts with multiple commodities. (Hint: Try --cost, -V or similar flags.)"
-- | Helper to calculate the percentage from two mixed. Keeps the sign of the first argument.
-- Uses unifyMixedAmount to unify each argument and then divides them.
perdivide :: MixedAmount -> MixedAmount -> MixedAmount
perdivide a b =
let a' = unifyMixedAmount a
b' = unifyMixedAmount b
in if amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b'
then mixed [per $ if aquantity b' == 0 then 0 else (aquantity a' / abs (aquantity b') * 100)]
else error' "Cannot calculate percentages if accounts have different commodities. (Hint: Try --cost, -V or similar flags.)"
-- Local debug helper
-- add a prefix to this function's debug output
dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg3 (p++" "++s)
dbg' s = let p = "multiBalanceReport" in Hledger.Utils.dbg4 (p++" "++s)
dbg'' s = let p = "multiBalanceReport" in Hledger.Utils.dbg5 (p++" "++s)
-- dbg = const id -- exclude this function from debug output
-- common rendering helper, XXX here for now -- common rendering helper, XXX here for now
tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell = tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
unlines unlines
@ -402,8 +569,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
(opts,journal) `gives` r = do (opts,journal) `gives` r = do
let (eitems, etotal) = r let (eitems, etotal) = r
(PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal (PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal
showw (PeriodicReportRow acct indent lAmt amt amt') showw (PeriodicReportRow a lAmt amt amt')
= (acct, accountLeafName acct, indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') = (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
(map showw aitems) @?= (map showw eitems) (map showw aitems) @?= (map showw eitems)
showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals
in in
@ -414,8 +581,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
,test "with -H on a populated period" $ ,test "with -H on a populated period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
( (
[ PeriodicReportRow "assets:bank:checking" 3 [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}]) [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}])
, PeriodicReportRow "income:salary" 2 [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}]) , PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}])
], ],
Mixed [nullamt]) Mixed [nullamt])

69
hledger-lib/Hledger/Reports/ReportTypes.hs
View File

@ -17,10 +17,22 @@ module Hledger.Reports.ReportTypes
, periodicReportSpan , periodicReportSpan
, prNegate , prNegate
, prNormaliseSign , prNormaliseSign
, prMapName
, prMapMaybeName
, DisplayName(..)
, flatDisplayName
, treeDisplayName
, prrFullName
, prrDisplayName
, prrDepth
) where ) where
import Data.Aeson import Data.Aeson
import Data.Decimal import Data.Decimal
import Data.Maybe (mapMaybe)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Hledger.Data import Hledger.Data
@ -72,7 +84,6 @@ data PeriodicReport a b =
data PeriodicReportRow a b = data PeriodicReportRow a b =
PeriodicReportRow PeriodicReportRow
{ prrName :: a -- An account name. { prrName :: a -- An account name.
, prrDepth :: Int -- Indent level for displaying this account name in tree mode. 0, 1, 2...
, prrAmounts :: [b] -- The data value for each subperiod. , prrAmounts :: [b] -- The data value for each subperiod.
, prrTotal :: b -- The total of this row's values. , prrTotal :: b -- The total of this row's values.
, prrAverage :: b -- The average of this row's values. , prrAverage :: b -- The average of this row's values.
@ -94,5 +105,57 @@ prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b
prNegate (PeriodicReport colspans rows totalsrow) = prNegate (PeriodicReport colspans rows totalsrow) =
PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow) PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow)
where where
rowNegate (PeriodicReportRow name indent amts tot avg) = rowNegate (PeriodicReportRow name amts tot avg) =
PeriodicReportRow name indent (map negate amts) (-tot) (-avg) PeriodicReportRow name (map negate amts) (-tot) (-avg)
-- | Map a function over the row names.
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
prMapName f report = report{prRows = map (prrMapName f) $ prRows report}
-- | Map a function over the row names, possibly discarding some.
prMapMaybeName :: (a -> Maybe b) -> PeriodicReport a c -> PeriodicReport b c
prMapMaybeName f report = report{prRows = mapMaybe (prrMapMaybeName f) $ prRows report}
-- | Map a function over the row names of the PeriodicReportRow.
prrMapName :: (a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c
prrMapName f row = row{prrName = f $ prrName row}
-- | Map maybe a function over the row names of the PeriodicReportRow.
prrMapMaybeName :: (a -> Maybe b) -> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c)
prrMapMaybeName f row = case f $ prrName row of
Nothing -> Nothing
Just a -> Just row{prrName = a}
-- | A full name, display name, and depth for an account.
data DisplayName = DisplayName
{ displayFull :: AccountName
, displayName :: AccountName
, displayDepth :: Int
} deriving (Show, Eq, Ord)
instance ToJSON DisplayName where
toJSON = toJSON . displayFull
toEncoding = toEncoding . displayFull
-- | Construct a flat display name, where the full name is also displayed at
-- depth 0
flatDisplayName :: AccountName -> DisplayName
flatDisplayName a = DisplayName a a 0
-- | Construct a tree display name, where only the leaf is displayed at its
-- given depth
treeDisplayName :: AccountName -> DisplayName
treeDisplayName a = DisplayName a (accountLeafName a) (accountNameLevel a)
-- | Get the full, canonical, name of a PeriodicReportRow tagged by a
-- DisplayName.
prrFullName :: PeriodicReportRow DisplayName a -> AccountName
prrFullName = displayFull . prrName
-- | Get the display name of a PeriodicReportRow tagged by a DisplayName.
prrDisplayName :: PeriodicReportRow DisplayName a -> AccountName
prrDisplayName = displayName . prrName
-- | Get the display depth of a PeriodicReportRow tagged by a DisplayName.
prrDepth :: PeriodicReportRow DisplayName a -> Int
prrDepth = displayDepth . prrName

7
hledger-lib/hledger-lib.cabal
View File

@ -1,10 +1,10 @@
cabal-version: 1.12 cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.33.0. -- This file has been generated from package.yaml by hpack version 0.33.1.
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: c30491f8c77b1d38a1992455cc9c340cbcb17e95ec5c07085f9987b289747ba1 -- hash: dd7c200231996bc96dfb65f042843355e9f7db7002d68c953ada6e89cedd5cc5
name: hledger-lib name: hledger-lib
version: 1.18.99 version: 1.18.99
@ -149,6 +149,7 @@ library
, timeit , timeit
, transformers >=0.2 , transformers >=0.2
, uglymemo , uglymemo
, unordered-containers >=0.2
, utf8-string >=0.3.5 , utf8-string >=0.3.5
default-language: Haskell2010 default-language: Haskell2010
@ -202,6 +203,7 @@ test-suite doctest
, timeit , timeit
, transformers >=0.2 , transformers >=0.2
, uglymemo , uglymemo
, unordered-containers >=0.2
, utf8-string >=0.3.5 , utf8-string >=0.3.5
if (impl(ghc < 8.2)) if (impl(ghc < 8.2))
buildable: False buildable: False
@ -257,6 +259,7 @@ test-suite unittest
, timeit , timeit
, transformers >=0.2 , transformers >=0.2
, uglymemo , uglymemo
, unordered-containers >=0.2
, utf8-string >=0.3.5 , utf8-string >=0.3.5
buildable: True buildable: True
default-language: Haskell2010 default-language: Haskell2010

1
hledger-lib/package.yaml
View File

@ -82,6 +82,7 @@ dependencies:
- time >=1.5 - time >=1.5
- timeit - timeit
- transformers >=0.2 - transformers >=0.2
- unordered-containers >=0.2
- uglymemo - uglymemo
- utf8-string >=0.3.5 - utf8-string >=0.3.5
- extra >=1.6.3 - extra >=1.6.3

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

@ -314,7 +314,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
if budget then do -- single or multi period budget report if budget then do -- single or multi period budget report
reportspan <- reportSpan j ropts reportspan <- reportSpan j ropts
let budgetreport = dbg1 "budgetreport" $ budgetReport ropts assrt reportspan d j let budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan d j
where where
assrt = not $ ignore_assertions_ $ inputopts_ opts assrt = not $ ignore_assertions_ $ inputopts_ opts
render = case fmt of render = case fmt of
@ -335,13 +335,7 @@ 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
let report let report = balanceReport ropts (queryFromOpts d ropts) j -- simple Ledger-style balance report
| balancetype_ `elem` [HistoricalBalance, CumulativeChange]
= let ropts' | flat_ ropts = ropts
| otherwise = ropts{accountlistmode_=ALTree}
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
render = case fmt of render = case fmt of
"txt" -> balanceReportAsText "txt" -> balanceReportAsText
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
@ -355,7 +349,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv opts (items, total) = balanceReportAsCsv opts (items, total) =
["account","balance"] : ["account","balance"] :
[[T.unpack (maybeAccountNameDrop opts a), showMixedAmountOneLineWithoutPrice b] | (a, _, _, b) <- items] [[T.unpack a, showMixedAmountOneLineWithoutPrice b] | (a, _, _, b) <- items]
++ ++
if no_total_ opts if no_total_ opts
then [] then []
@ -404,7 +398,7 @@ This implementation turned out to be a bit convoluted but implements the followi
balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String] balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String]
balanceReportItemAsText opts fmt (_, accountName, depth, amt) = balanceReportItemAsText opts fmt (_, accountName, depth, amt) =
renderBalanceReportItem opts fmt ( renderBalanceReportItem opts fmt (
maybeAccountNameDrop opts accountName, accountName,
depth, depth,
normaliseMixedAmountSquashPricesForDisplay amt normaliseMixedAmountSquashPricesForDisplay amt
) )
@ -463,18 +457,18 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
-- and will include the final totals row unless --no-total is set. -- and will include the final totals row unless --no-total is set.
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
(PeriodicReport colspans items (PeriodicReportRow _ _ coltotals tot avg)) = (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
maybetranspose $ maybetranspose $
("Account" : map showDateSpan colspans ("Account" : map showDateSpan colspans
++ ["Total" | row_total_] ++ ["Total" | row_total_]
++ ["Average" | average_] ++ ["Average" | average_]
) : ) :
[T.unpack (maybeAccountNameDrop opts a) : [T.unpack (displayFull a) :
map showMixedAmountOneLineWithoutPrice map showMixedAmountOneLineWithoutPrice
(amts (amts
++ [rowtot | row_total_] ++ [rowtot | row_total_]
++ [rowavg | average_]) ++ [rowavg | average_])
| PeriodicReportRow a _ amts rowtot rowavg <- items] | PeriodicReportRow a amts rowtot rowavg <- items]
++ ++
if no_total_ opts if no_total_ opts
then [] then []
@ -603,7 +597,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
-- | Build a 'Table' from a multi-column balance report. -- | Build a 'Table' from a multi-column balance report.
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
(PeriodicReport colspans items (PeriodicReportRow _ _ coltotals tot avg)) = (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
maybetranspose $ maybetranspose $
addtotalrow $ addtotalrow $
Table Table
@ -619,10 +613,9 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
++ [" Total" | totalscolumn] ++ [" Total" | totalscolumn]
++ ["Average" | average_] ++ ["Average" | average_]
accts = map renderacct items accts = map renderacct items
renderacct (PeriodicReportRow a i _ _ _) renderacct row =
| tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack (accountLeafName a) replicate ((prrDepth row - 1) * 2) ' ' ++ T.unpack (prrDisplayName row)
| otherwise = T.unpack $ maybeAccountNameDrop opts a rowvals (PeriodicReportRow _ as rowtot rowavg) = as
rowvals (PeriodicReportRow _ _ as rowtot rowavg) = as
++ [rowtot | totalscolumn] ++ [rowtot | totalscolumn]
++ [rowavg | average_] ++ [rowavg | average_]
addtotalrow | no_total_ opts = id addtotalrow | no_total_ opts = id

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

@ -271,12 +271,12 @@ compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn s
where where
nonzeroaccounts = nonzeroaccounts =
dbg5 "nonzeroaccounts" $ dbg5 "nonzeroaccounts" $
mapMaybe (\(PeriodicReportRow act _ amts _ _) -> mapMaybe (\(PeriodicReportRow act amts _ _) ->
if not (all mixedAmountLooksZero amts) then Just act else Nothing) rows if not (all mixedAmountLooksZero amts) then Just (displayFull act) else Nothing) rows
rows' = filter (not . emptyRow) rows rows' = filter (not . emptyRow) rows
where where
emptyRow (PeriodicReportRow act _ amts _ _) = emptyRow (PeriodicReportRow act amts _ _) =
all mixedAmountLooksZero amts && not (any (act `isAccountNamePrefixOf`) nonzeroaccounts) all mixedAmountLooksZero amts && not (any (displayFull act `isAccountNamePrefixOf`) nonzeroaccounts)
-- | Render a compound balance report as plain text suitable for console output. -- | Render a compound balance report as plain text suitable for console output.
{- Eg: {- Eg:

8
tests/balance/373-layout.test
View File

@ -88,11 +88,13 @@ $ hledger -f - bal -Y --tree
Balance changes in 2015: Balance changes in 2015:
|| 2015 || 2015
===========++====== =========++======
1:2 || 0
3 || 1 3 || 1
4 || 0
5 || 1 5 || 1
-----------++------ ---------++------
|| || 0
# 6. TODO: after 5, test account code sorting # 6. TODO: after 5, test account code sorting
# account 1:2:3 100 # account 1:2:3 100

6
tests/balance/sorting.test
View File

@ -32,7 +32,7 @@ Balance changes in 2018:
>= >=
# 2. Tree mode. Missing parent accounts are added (b). # 2. Tree mode. Missing parent accounts are added (b).
$ hledger -f- bal -NY --tree $ hledger -f- bal -NY --tree --no-elide
Balance changes in 2018: Balance changes in 2018:
|| 2018 || 2018
@ -90,7 +90,7 @@ Balance changes in 2018:
# 4. With account directives, tree mode. # 4. With account directives, tree mode.
# Missing parent accounts are added (b). # Missing parent accounts are added (b).
$ hledger -f- bal -NY --tree $ hledger -f- bal -NY --tree --no-elide
Balance changes in 2018: Balance changes in 2018:
|| 2018 || 2018
@ -141,7 +141,7 @@ Balance changes in 2018:
2018/1/1 2018/1/1
(a:k) 1 (a:k) 1
$ hledger -f- bal -NY --sort-amount --tree $ hledger -f- bal -NY --sort-amount --tree --no-elide
Balance changes in 2018: Balance changes in 2018:
|| 2018 || 2018