From 6ea5da2d9d031935c7d60c5c929e5ddbc83cd1c2 Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Sun, 19 Nov 2017 01:07:08 +0000 Subject: [PATCH] bal: --budget shows budget performance Budget goals specified with periodic transactions (as with hledger-budget) can now be displayed in balance report (but not in bs/is/cf). --budget shows the target amount and percentage alongside the actual amount, per account and period. Unbudgeted accounts will be hidden, unless --show-unbudgeted is used. Budgeted accounts are displayed folded (depth-clipped) at a depth matching the budget specification. Unbudgeted accounts, if shown, are displayed at their usual depth (in full detail, or according to --depth). --- hledger/Hledger/Cli/Commands/Balance.hs | 117 ++++++++++++++++++++++-- tests/budget/budget.test | 92 +++++++++++++++++++ 2 files changed, 199 insertions(+), 10 deletions(-) create mode 100644 tests/budget/budget.test diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 896987f1f..83ca1ac58 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -246,8 +246,9 @@ module Hledger.Cli.Commands.Balance ( ,tests_Hledger_Cli_Commands_Balance ) where -import Data.List (intercalate) +import Data.List (intercalate, nub) import Data.Maybe +import qualified Data.Map as Map -- import Data.Monoid import qualified Data.Text as T import System.Console.CmdArgs.Explicit as C @@ -283,6 +284,8 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)" ,flagNone ["pretty-tables"] (\opts -> setboolopt "pretty-tables" opts) "use unicode when displaying tables" ,flagNone ["sort-amount","S"] (\opts -> setboolopt "sort-amount" opts) "sort by amount instead of account name" + ,flagNone ["budget"] (setboolopt "budget") "compute budget from periodic transactions and compare real balances to it" + ,flagNone ["show-unbudgeted"] (setboolopt "show-unbudgeted") "show full names of accounts not mentioned in budget" ] ++ outputflags ,groupHidden = [] @@ -293,7 +296,7 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don -- | The balance command, prints a balance report. balance :: CliOpts -> Journal -> IO () -balance opts@CliOpts{reportopts_=ropts} j = do +balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do d <- getCurrentDay case lineFormatFromOpts ropts of Left err -> error' $ unlines [err] @@ -319,12 +322,58 @@ balance opts@CliOpts{reportopts_=ropts} j = do "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r _ -> balanceReportAsText writeOutput opts $ render ropts report - _ -> do + + _ | boolopt "budget" rawopts -> do + let budget = budgetJournal opts j + j' = budgetRollUp opts budget j + report = multiBalanceReport ropts (queryFromOpts d ropts) j' + budgetReport = multiBalanceReport ropts (queryFromOpts d ropts) budget + render = case format of + -- XXX: implement csv rendering + "csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts + _ -> multiBalanceReportWithBudgetAsText ropts budgetReport + writeOutput opts $ render report + + | otherwise -> do let report = multiBalanceReport ropts (queryFromOpts d ropts) j render = case format of - "csv" -> \ropts r -> (++ "\n") $ printCSV $ multiBalanceReportAsCsv ropts r - _ -> multiBalanceReportAsText - writeOutput opts $ render ropts report + "csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts + _ -> multiBalanceReportAsText ropts + writeOutput opts $ render report + +-- | Re-map account names to closet parent with periodic transaction from budget. +-- Accounts that dont have suitable parent are either remapped to ":topAccount" +-- or left as-is if --show-unbudgeted is provided +budgetRollUp :: CliOpts -> Journal -> Journal -> Journal +budgetRollUp CliOpts{rawopts_=rawopts} budget j = j { jtxns = remapTxn <$> jtxns j } + where + budgetAccounts = nub $ concatMap (map paccount . ptpostings) $ jperiodictxns budget + remapAccount origAcctName = remapAccount' origAcctName + where + remapAccount' acctName + | acctName `elem` budgetAccounts = acctName + | otherwise = + case parentAccountName acctName of + "" | boolopt "show-unbudgeted" rawopts -> origAcctName + | otherwise -> T.append (T.pack ":") acctName + parent -> remapAccount' parent + remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p } + remapTxn = mapPostings (map remapPosting) + mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t } + +-- | Generate journal of all periodic transactions in the given journal for the +-- entireity of its history or reporting period, whatever is smaller +budgetJournal :: CliOpts -> Journal -> Journal +budgetJournal opts j = journalBalanceTransactions' opts j { jtxns = budget } + where + dates = spanIntersect (jdatespan j) (periodAsDateSpan $ period_ $ reportopts_ opts) + budget = [makeBudget t | pt <- jperiodictxns j, t <- runPeriodicTransaction pt dates] + makeBudget t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" } + journalBalanceTransactions' opts j = + let assrt = not . ignore_assertions_ $ inputopts_ opts + in + either error' id $ journalBalanceTransactions assrt j + -- single-column balance reports @@ -494,16 +543,66 @@ multiBalanceReportAsText opts r = CumulativeChange -> "Ending balances (cumulative)" HistoricalBalance -> "Ending balances (historical)" +-- | Render two multi-column balance reports as plain text suitable for console output. +-- They are assumed to have same number of columns, one of them representing +-- a budget +multiBalanceReportWithBudgetAsText :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport -> String +multiBalanceReportWithBudgetAsText opts budget r = + printf "%s in %s:\n\n" typeStr (showDateSpan $ multiBalanceReportSpan r) + ++ renderBalanceReportTable' opts showcell tabl + where + tabl = combine (balanceReportAsTable opts r) (balanceReportAsTable opts budget) + typeStr :: String + typeStr = case balancetype_ opts of + PeriodChange -> "Balance changes" + CumulativeChange -> "Ending balances (cumulative)" + HistoricalBalance -> "Ending balances (historical)" + showcell (real, Nothing) = showamt real + showcell (real, Just budget) = + printf "%s [%s]" (showamt real) (showamt budget) + showamt | color_ opts = cshowMixedAmountOneLineWithoutPrice + | otherwise = showMixedAmountOneLineWithoutPrice + -- combine reportTable budgetTable will combine them into a single table where cells + -- are tuples of (actual, Maybe budget) numbers. Main assumptions is that + -- row/column titles of budgetTable are subset of row/column titles or reportTable, + -- and there are now row/column titles in budgetTable that are not mentioned in reporTable. + -- Both of these are satisfied by construction of budget report and process of rolling up + -- account names. + combine (Table l t d) (Table l' t' d') = Table l t combinedRows + where + -- For all accounts that are present in the budget, zip real amounts with budget amounts + combinedRows = [ combineRow row budgetRow + | (acct, row) <- zip (headerContents l) d + , let budgetRow = + if acct == "" then [] -- "" is totals row + else fromMaybe [] $ Map.lookup acct budgetAccts + ] + -- Budget could cover smaller interval of time than the whole journal. + -- Headers for budget row will always be a sublist of headers of row + combineRow r br = + let reportRow = zip (headerContents t) r + budgetRow = Map.fromList $ zip (headerContents t') br + findBudgetVal hdr = Map.lookup hdr budgetRow + in map (\(hdr, val) -> (val, findBudgetVal hdr)) reportRow + budgetAccts = Map.fromList $ zip (headerContents l') d' + -- | Given a table representing a multi-column balance report (for example, -- made using 'balanceReportAsTable'), render it in a format suitable for -- console output. renderBalanceReportTable :: ReportOpts -> Table String String MixedAmount -> String -renderBalanceReportTable (ReportOpts { pretty_tables_ = pretty, color_=usecolor }) = +renderBalanceReportTable ropts = + renderBalanceReportTable' ropts showamt + where + showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice + | otherwise = showMixedAmountOneLineWithoutPrice + +renderBalanceReportTable' :: ReportOpts -> (a -> String) -> Table String String a -> String +renderBalanceReportTable' (ReportOpts { pretty_tables_ = pretty}) showCell = unlines . addtrailingblank . trimborder . lines - . render pretty id id showamt + . render pretty id id showCell . align where addtrailingblank = (++[""]) @@ -512,8 +611,6 @@ renderBalanceReportTable (ReportOpts { pretty_tables_ = pretty, color_=usecolor where acctswidth = maximum' $ map strWidth (headerContents l) l' = padRightWide acctswidth <$> l - showamt | usecolor = cshowMixedAmountOneLineWithoutPrice - | otherwise = showMixedAmountOneLineWithoutPrice -- | Build a 'Table' from a multi-column balance report. balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount diff --git a/tests/budget/budget.test b/tests/budget/budget.test new file mode 100644 index 000000000..e7c457dc9 --- /dev/null +++ b/tests/budget/budget.test @@ -0,0 +1,92 @@ +# Test --budget switch +hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget +<<< +2016/12/01 + expenses:food $10 + assets:cash + +2016/12/02 + expenses:food $9 + assets:cash + +2016/12/03 + expenses:food $11 + assets:cash + +2016/12/02 + expenses:leisure $5 + assets:cash + +2016/12/03 + expenses:movies $25 + assets:cash + +2016/12/03 + expenses:cab $15 + assets:cash + +~ daily from 2016/1/1 + expenses:food $10 + expenses:leisure $15 + assets:cash +>>> +Balance changes in 2016/12/01-2016/12/03: + + || 2016/12/01 2016/12/02 2016/12/03 +=======================++======================================= + :expenses || 0 0 $40 + assets:cash || $-10 [$-25] $-14 [$-25] $-51 [$-25] + expenses:food || $10 [$10] $9 [$10] $11 [$10] + expenses:leisure || 0 [$15] $5 [$15] 0 [$15] +-----------------------++--------------------------------------- + || 0 0 0 + +>>>2 +>>>=0 + +# --show-unbudgeted +hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget --show-unbudgeted +<<< +2016/12/01 + expenses:food $10 + assets:cash + +2016/12/02 + expenses:food $9 + assets:cash + +2016/12/03 + expenses:food $11 + assets:cash + +2016/12/02 + expenses:leisure $5 + assets:cash + +2016/12/03 + expenses:movies $25 + assets:cash + +2016/12/03 + expenses:cab $15 + assets:cash + +~ daily from 2016/1/1 + expenses:food $10 + expenses:leisure $15 + assets:cash +>>> +Balance changes in 2016/12/01-2016/12/03: + + || 2016/12/01 2016/12/02 2016/12/03 +==================++======================================= + assets:cash || $-10 [$-25] $-14 [$-25] $-51 [$-25] + expenses:cab || 0 0 $15 + expenses:food || $10 [$10] $9 [$10] $11 [$10] + expenses:leisure || 0 [$15] $5 [$15] 0 [$15] + expenses:movies || 0 0 $25 +------------------++--------------------------------------- + || 0 0 0 + +>>>2 +>>>=0