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).
This commit is contained in:
parent
23f3da4e92
commit
6ea5da2d9d
@ -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 "<unbudgeted>: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 "<unbudgeted>:") 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
|
||||
|
||||
92
tests/budget/budget.test
Normal file
92
tests/budget/budget.test
Normal file
@ -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
|
||||
=======================++=======================================
|
||||
<unbudgeted>: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
|
||||
Loading…
Reference in New Issue
Block a user