From 2af04ec2fc4cd6953cfe65b3f411219eb5e7cdf1 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 13 Apr 2014 11:07:39 -0700 Subject: [PATCH] balance: merge/improve multicol report implementations Periodic, cumulative and historical multicolumn balance reports are now generated by one code path, which helps with consistency and reducing the bug/test surface. --tree now also works with --cumulative or --historical. --- .../Hledger/Reports/MultiBalanceReports.hs | 190 +++++------------- hledger/Hledger/Cli/Balance.hs | 6 +- tests/balance-multicol.test | 46 +++++ 3 files changed, 101 insertions(+), 141 deletions(-) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 0d925e18b..ffce04926 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -8,8 +8,7 @@ Multi-column balance reports, used by the balance command. module Hledger.Reports.MultiBalanceReports ( MultiBalanceReport(..), MultiBalanceReportRow, - periodBalanceReport, - cumulativeOrHistoricalBalanceReport, + multiBalanceReport -- -- * Tests -- tests_Hledger_Reports_MultiBalanceReport @@ -36,8 +35,9 @@ import Hledger.Reports.BalanceReport -- -- 3. a list of each column's final total -- --- The meaning of the amounts depends on the type of balance report (see --- 'BalanceType' and "Hledger.Cli.Balance"). +-- The meaning of the amounts depends on the type of multi balance +-- report, of which there are three: periodic, cumulative and historical +-- (see 'BalanceType' and "Hledger.Cli.Balance"). newtype MultiBalanceReport = MultiBalanceReport ([DateSpan] ,[MultiBalanceReportRow] ,[MixedAmount] @@ -60,29 +60,19 @@ instance Show MultiBalanceReport where -- type alias just to remind us which AccountNames might be depth-clipped, below. type ClippedAccountName = AccountName --- | Generate a multi balance report for the matched accounts, showing --- their change of balance in each of the specified periods. --- Currently has some limitations compared to the simple balance report, --- eg always displays accounts in --flat mode. -periodBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport -periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals) +-- | Generate a multicolumn balance report for the matched accounts, +-- showing the change of balance, accumulated balance, or historical balance +-- in each of the specified periods. +multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport +multiBalanceReport opts q j = MultiBalanceReport (spans, items, totals) where -- dbg = const id -- exclude from debug output - dbg s = let p = "periodBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output - - -- Example data below is from - -- hledger -f data/balance-multicol.journal balance -p 'monthly2013' assets: --depth=1 --debug=1 - -- with flatShowsExclusiveBalance=True. To see more, run other commands from - -- tests/balance-multicol.test with --debug=1. + -- dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output nodepthq = dbg "nodepthq" $ filterQuery (not . queryIsDepth) q - -- And ([Date (DateSpan (Just 2013-01-01) (Just 2014-01-01)),Acct "assets:"]) depthq = dbg "depthq" $ filterQuery queryIsDepth q - -- Any depth = queryDepth depthq - -- Depth 1 symq = dbg "symq" $ filterQuery queryIsSym q - -- Any ps :: [Posting] = dbg "ps" $ @@ -90,12 +80,6 @@ periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals) filterJournalPostingAmounts symq $ -- exclude amount parts excluded by cur: filterJournalPostings nodepthq $ -- exclude unmatched postings, but include all depths journalSelectingAmountFromOpts opts j - -- - -- [(assets:checking) 1 - -- ,(assets:checking) -1 - -- ,(assets:cash) 1 - -- ,(assets:checking) 1 - -- ] -- the report's span will be the requested span intersected with -- the selected data's span; or with -E, the requested span @@ -106,41 +90,18 @@ periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals) requestedspan = queryDateSpan (date2_ opts) q -- based on -b/-e/-p opts and query args IIRC journalspan = journalDateSpan j matchedspan = postingsDateSpan ps - spans :: [DateSpan] = dbg "spans" $ splitSpan (intervalFromOpts opts) reportspan - -- [DateSpan (Just 2013-01-01) (Just 2013-02-01) - -- ,DateSpan (Just 2013-02-01) (Just 2013-03-01) - -- ,DateSpan (Just 2013-03-01) (Just 2013-04-01) - -- ] + -- (reportspan, spans) = dbg "report spans" $ reportSpans opts q j - psBySpan :: [[Posting]] = - dbg "psBySpan" $ + psPerSpan :: [[Posting]] = + dbg "psPerSpan" $ [filter (isPostingInDateSpan s) ps | s <- spans] - -- [[(assets:checking) 1, (assets:checking) -1] - -- ,[(assets:cash) 1] - -- ,[(assets:checking) 1] - postedAccts :: [AccountName] = - dbg "postedAccts" $ - sort $ accountNamesFromPostings ps - -- [ "assets:cash" , "assets:checking" ] - - displayedAccts :: [ClippedAccountName] = - dbg "displayedAccts" $ - (if tree_ opts then expandAccountNames else id) $ - nub $ map (clipAccountName depth) postedAccts - -- [ "assets" ] - - zeroes :: [(ClippedAccountName, MixedAmount)] = - dbg "zeroes" $ - [(a, nullmixedamt) | a <- displayedAccts] - -- [ ( "assets" , 0 ) ] - - postedAcctBalsBySpan :: [[(ClippedAccountName, MixedAmount)]] = - dbg "postedAcctBalsBySpan" $ - [postingAcctBals ps | ps <- psBySpan] + postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = + dbg "postedAcctBalChangesPerSpan" $ + map postingAcctBals psPerSpan where postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)] postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as] @@ -151,100 +112,53 @@ periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals) depthLimit | tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances | otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit - -- [ [ ( "assets" , 0 ) ] - -- , [ ( "assets" , 1 ) ] - -- , [ ( "assets" , 1 ) ] - -- ] - displayedBalsBySpan :: [[(ClippedAccountName, MixedAmount)]] = - dbg "displayedBalsBySpan" $ + postedAccts :: [AccountName] = + dbg "postedAccts" $ + sort $ accountNamesFromPostings ps + + displayedAccts :: [ClippedAccountName] = + dbg "displayedAccts" $ + (if tree_ opts then expandAccountNames else id) $ + nub $ map (clipAccountName depth) postedAccts + + acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = + dbg "acctBalChangesPerSpan" $ [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes - | postedacctbals <- postedAcctBalsBySpan] - -- - -- [ [ ( "assets" , 0 ) ] - -- , [ ( "assets" , 1 ) ] - -- , [ ( "assets" , 1 ) ] - -- ] + | postedacctbals <- postedAcctBalChangesPerSpan] + where zeroes = [(a, nullmixedamt) | a <- displayedAccts] - displayedBalsByAcct :: [[(ClippedAccountName, MixedAmount)]] = - dbg "displayedBalsByAcct" $ - transpose displayedBalsBySpan - -- [ [ ( "assets" , 0 ) , ( "assets" , 1 ) , ( "assets" , 1 ) ] ] - - acctBalsAlist :: [(ClippedAccountName, [MixedAmount])] = - dbg "acctBalsAlist" $ - zip displayedAccts (map (map snd) [bs | bs <- displayedBalsByAcct - -- , maybe False ((`elem` postedAccts).fst) $ headMay bs - ]) - -- [ ( "assets" , [ 0 , 1 , 1 ] ) ] - - items :: [MultiBalanceReportRow] = - dbg "items" $ - [((a, accountLeafName a, accountNameLevel a), bs) | (a,bs) <- acctBalsAlist, empty_ opts || any (not . isZeroMixedAmount) bs] - -- [ ( ( "assets" , "assets" , 1 ) , [ 0 , 1 , 1 ] ) ] - - -- highestLevelBalsBySpan :: [[MixedAmount]] = - -- dbg "highestLevelBalsBySpan" $ - -- [[b | (a,b) <- spanbals, not $ any (`elem` postedAccts) $ init $ expandAccountName a] | spanbals <- displayedBalsBySpan] - - totals :: [MixedAmount] = - dbg "totals" $ - if tree_ opts - then map (sum . map pamount) psBySpan - else map (sum . map snd) displayedBalsBySpan - -- else map sum highestLevelBalsBySpan - -- [ 0 , 1 , 1 ] - --- | Generate a multi balance report for the matched accounts, showing --- their cumulative or (with -H) historical balance in each of the specified periods. --- Has the same limitations as periodBalanceReport. -cumulativeOrHistoricalBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport -cumulativeOrHistoricalBalanceReport opts q j = MultiBalanceReport (periodbalancespans, items, totals) - where - -- dbg = const id -- exclude from debug output - dbg s = let p = "cumulativeOrHistoricalBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output - - -- select/adjust basic report dates - (reportspan, _) = dbg "report spans" $ reportSpans opts q j + acctBalChanges :: [(ClippedAccountName, [MixedAmount])] = + dbg "acctBalChanges" $ + [(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan] -- never null, or used when null... -- starting balances and accounts from transactions before the report start date startacctbals = dbg "startacctbals" $ map (\((a,_,_),b) -> (a,b)) $ startbalanceitems where dateless = filterQuery (not . queryIsDate) precedingq = dbg "precedingq" $ And [dateless q, Date $ DateSpan Nothing (spanStart reportspan)] - (startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts{flat_=True,empty_=True} precedingq j -- XXX - -- acctsWithStartingBalance = map fst $ filter (not . isZeroMixedAmount . snd) startacctbals - startingBalanceFor a - | balancetype_ opts == HistoricalBalance = fromMaybe nullmixedamt $ lookup a startacctbals - | otherwise = nullmixedamt + (startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts' precedingq j + where + opts' | tree_ opts = opts{no_elide_=True} + | otherwise = opts{flat_=True} + startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals - -- balance changes in each period for each account - MultiBalanceReport (periodbalancespans,periodbalanceitems,_) = dbg "balance changes report" $ periodBalanceReport opts q j - balanceChangesByAcct = map (\((a,_,_),bs) -> (a,bs)) periodbalanceitems - acctsWithBalanceChanges = map fst $ filter ((any (not . isZeroMixedAmount)) . snd) balanceChangesByAcct - balanceChangesFor a = fromMaybe (error $ "no data for account: a") $ -- XXX - lookup a balanceChangesByAcct + items :: [MultiBalanceReportRow] = + dbg "items" $ + [((a, accountLeafName a, accountNameLevel a), displayedBals) + | (a,changes) <- acctBalChanges + , let displayedBals = case balancetype_ opts of + HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes + CumulativeBalance -> drop 1 $ scanl (+) nullmixedamt changes + _ -> changes + , empty_ opts || any (not . isZeroMixedAmount) displayedBals + ] - -- accounts to report on - reportaccts = dbg "reportaccts" - acctsWithBalanceChanges - -- (dbg' "acctsWithStartingBalance" acctsWithStartingBalance) `union` (dbg' "acctsWithBalanceChanges" acctsWithBalanceChanges) - - -- ending balances in each period (starting balance plus balance changes) for an account - endingBalancesFor a = - dbg "ending balances" $ drop 1 $ scanl (+) (startingBalanceFor a) $ - dbg ("balance changes for "++a) $ balanceChangesFor a - - items = dbg "items" $ [((a,a,0), endingBalancesFor a) | a <- reportaccts] - - totals = dbg "totals" $ - if tree_ opts - then map sum highestlevelbalsbycol - else map sum balsbycol + totals :: [MixedAmount] = + dbg "totals" $ + map sum balsbycol where - balsbycol = transpose $ map endingBalancesFor reportaccts - highestlevelbalsbycol = transpose $ map endingBalancesFor highestlevelaccts + balsbycol = transpose [bs | ((a,_,_),bs) <- items, not (tree_ opts) || a `elem` highestlevelaccts] highestlevelaccts = dbg "highestlevelaccts" $ - [a | a <- reportaccts, not $ any (`elem` reportaccts) $ init $ expandAccountName a] - + [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a] diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 1dfe63519..9333823ac 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -288,9 +288,9 @@ balance CliOpts{reportopts_=ropts} j = do Right _ -> case (intervalFromOpts ropts, balancetype_ ropts) of (NoInterval,_) -> balanceReportAsText ropts $ balanceReport ropts (queryFromOpts d ropts) j - (_,PeriodBalance) -> periodBalanceReportAsText ropts $ periodBalanceReport ropts (queryFromOpts d ropts) j - (_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j - (_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j + (_,PeriodBalance) -> periodBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j + (_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j + (_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j putStr $ unlines output -- | Render an old-style single-column balance report as plain text. diff --git a/tests/balance-multicol.test b/tests/balance-multicol.test index 9b7416759..c7b336211 100644 --- a/tests/balance-multicol.test +++ b/tests/balance-multicol.test @@ -191,3 +191,49 @@ Ending balance (historical): || 10 12 13 >>>=0 + +# 14. The three multicol balance report types again, this time with --tree +hledgerdev -f data/balance-multicol.journal balance -p 'monthly in 2013' --tree +>>> +Change of balance (flow): + + || 2013/01/01-2013/01/31 2013/02/01-2013/02/28 2013/03/01-2013/03/31 +============++====================================================================== + assets || 0 2 1 + cash || 0 1 0 + checking || 0 0 1 +------------++---------------------------------------------------------------------- + || 0 2 1 + +>>>=0 + +# 15. +hledgerdev -f data/balance-multicol.journal balance -p 'monthly in 2013' --cumulative --tree +>>> +Ending balance (cumulative): + + || 2013/01/31 2013/02/28 2013/03/31 +============++===================================== + assets || 0 2 3 + cash || 0 1 1 + checking || 0 0 1 +------------++------------------------------------- + || 0 2 3 + +>>>=0 + +# 16. +hledgerdev -f data/balance-multicol.journal balance -p 'monthly in 2013' --historical --tree +>>> +Ending balance (historical): + + || 2013/01/31 2013/02/28 2013/03/31 +============++===================================== + assets || 10 12 13 + cash || 0 1 1 + checking || 10 10 11 +------------++------------------------------------- + || 10 12 13 + +>>>=0 +