From 568a44230749003f0722b55accd1459922c2fcfb Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 24 Apr 2018 13:42:12 -0700 Subject: [PATCH] budget: tweak hiding/grouping of unbudgeted accounts It now works slightly differently. Eg: - 's subaccounts are hidden by default - --show-unbudgeted shows all unbudgeted accounts, including subaccounts of budgeted parents - --show-unbudgeted doesn't affect the grouping under IMHO it's a nice simplification and increase in consistency, while still meeting the original intent. --- hledger-lib/Hledger/Data/AccountName.hs | 16 ++-- hledger-lib/Hledger/Reports/BudgetReport.hs | 81 +++++---------------- tests/budget/budget.test | 62 ++++++++-------- 3 files changed, 59 insertions(+), 100 deletions(-) diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index cd523c5eb..54c9759a0 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -57,24 +57,24 @@ accountNameLevel :: AccountName -> Int accountNameLevel "" = 0 accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1 +-- | A top-level account prefixed to some accounts in budget reports. +-- Defined here so it can be ignored by accountNameDrop. +unbudgetedAccountName :: T.Text +unbudgetedAccountName = "" + -- | Remove some number of account name components from the front of the account name. -- If the special "" top-level account is present, it is preserved and -- dropping affects the rest of the account name. accountNameDrop :: Int -> AccountName -> AccountName accountNameDrop n a - | a == unbudgetedAccount = a + | a == unbudgetedAccountName = a | unbudgetedAccountAndSep `T.isPrefixOf` a = case accountNameDrop n $ T.drop (T.length unbudgetedAccountAndSep) a of - "" -> unbudgetedAccount + "" -> unbudgetedAccountName a' -> unbudgetedAccountAndSep <> a' | otherwise = accountNameFromComponents $ drop n $ accountNameComponents a where - unbudgetedAccountAndSep = unbudgetedAccount <> acctsep - --- | A top-level account prefixed to some accounts in budget reports. --- Defined here so it can be ignored by accountNameDrop. -unbudgetedAccount :: T.Text -unbudgetedAccount = "" + unbudgetedAccountAndSep = unbudgetedAccountName <> acctsep -- | Sorted unique account names implied by these account names, -- ie these plus all their parent accounts up to the root. diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index b5832f092..d0f6ec925 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -16,7 +16,7 @@ import Data.Monoid ((<>)) #endif import Data.Ord import Data.Time.Calendar ---import Safe +import Safe import Test.HUnit --import Data.List --import Data.Maybe @@ -65,24 +65,19 @@ type BudgetReport = PeriodicReport (Maybe Change, Maybe BudgetGoal) budgetReport :: ReportOpts -> Bool -> Bool -> DateSpan -> Day -> Journal -> BudgetReport budgetReport ropts assrt showunbudgeted reportspan d j = let - budgetj = budgetJournal assrt ropts reportspan j - budgetedacctsinperiod = + q = queryFromOpts d ropts + budgetj = budgetJournal assrt ropts reportspan j + budgetedaccts = dbg2 "budgetedacctsinperiod" $ accountNamesFromPostings $ concatMap tpostings $ concatMap (flip runPeriodicTransaction reportspan) $ jperiodictxns j - actualj = - budgetRollUp budgetedacctsinperiod showunbudgeted --- (if showunbudgeted then id else budgetRollUp budgetedacctsinperiod True budgetj) - j - q = queryFromOpts d ropts + actualj = budgetRollUp budgetedaccts showunbudgeted j budgetgoalreport = dbg1 "budgetgoalreport" $ multiBalanceReport ropts q budgetj actualreport = dbg1 "actualreport" $ multiBalanceReport ropts q actualj in - dbg1 "budgetreport" $ --- (if showunbudgeted then id else hideUnbudgetedAccounts budgetedacctsinperiod) $ - combineBudgetAndActual budgetgoalreport actualreport + dbg1 "budgetreport" $ combineBudgetAndActual budgetgoalreport actualreport -- | Use all periodic transactions in the journal to generate -- budget transactions in the specified report period. @@ -101,19 +96,15 @@ budgetJournal assrt _ropts reportspan j = ] makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" } --- variations on hiding unbudgeted accounts: - --- | Adjust a journal for budget reporting, hiding all or most unbudgeted subaccounts. --- Specifically, +-- | Adjust a journal's account names for budget reporting, in two ways: -- --- - account names with no budget goal are rewritten to their closest parent with a budget goal --- (thereby hiding unbudgeted subaccounts of budgeted accounts, regardless of depth limit). +-- 1. accounts with no budget goal anywhere in their ancestry are moved +-- under the "unbudgeted" top level account. -- --- - accounts with no budgeted parent are rewritten to ":topaccountname" --- (hiding subaccounts of unbudgeted accounts, regardless of depth limit), --- unless --show-unbudgeted is provided. +-- 2. subaccounts with no budget goal are merged with their closest parent account +-- with a budget goal, so that only budgeted accounts are shown. +-- This can be disabled by --show-unbudgeted. -- --- This is slightly inconsistent/confusing but probably useful. budgetRollUp :: [AccountName] -> Bool -> Journal -> Journal budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j } where @@ -122,47 +113,15 @@ budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j } mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t } remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p } where - remapAccount origAcctName = remapAccount' origAcctName + remapAccount a + | hasbudget = a + | hasbudgetedparent = if showunbudgeted then a else budgetedparent + | otherwise = if showunbudgeted then u <> acctsep <> a else u where - remapAccount' a - | a `elem` budgetedaccts = a - | not (T.null parent) = remapAccount' parent - | showunbudgeted = origAcctName - | otherwise = unbudgetedAccount <> acctsep <> a - where - parent = parentAccountName a - ---type PeriodicReportRow a = --- ( AccountName -- A full account name. --- , AccountName -- Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed. --- , Int -- Indent level for displaying this account name in tree mode. 0, 1, 2... --- , [a] -- The data value for each subperiod. --- , a -- The total of this row's values. --- , a -- The average of this row's values. --- ) --- XXX doesn't work right with depth limit, show-unbudgeted, tree mode --- | Adjust a budget report, altering the account name for any rows which have no --- budget goals in any period, so that they are grouped under a special "unbudgeted" --- prefix, and moving all "unbudgeted" rows to the end. -hideOrRenameUnbudgetedAccounts :: [AccountName] -> BudgetReport -> BudgetReport -hideOrRenameUnbudgetedAccounts budgetedaccts (PeriodicReport (spans, rows, totalrow)) = - PeriodicReport (spans, rs ++ unbudgetedrs, totalrow) - where - (rs, unbudgetedrs) = partition (any (isJust . snd) . fourth6) $ map renameacct rows - renameacct r@(a, a', indent, vals, tot, avg) = - -- if any (isJust . snd) vals - if a `elem` budgetedaccts - then r - else (rename a, mayberename a', indent, vals, tot, avg) - where - rename = (":"<>) - mayberename = id -- XXX - --- | Adjust a budget report, removing any rows which do not correspond to --- one of the provided budgeted accounts. -hideUnbudgetedAccounts :: [AccountName] -> BudgetReport -> BudgetReport -hideUnbudgetedAccounts budgetedaccts (PeriodicReport (spans, rows, totalrow)) = - PeriodicReport (spans, filter ((`elem` budgetedaccts) . first6) rows, totalrow) + hasbudget = a `elem` budgetedaccts + hasbudgetedparent = not $ T.null budgetedparent + budgetedparent = headDef "" $ filter (`elem` budgetedaccts) $ parentAccountNames a + u = unbudgetedAccountName -- | Combine a per-account-and-subperiod report of budget goals, and one -- of actual change amounts, into a budget performance report. diff --git a/tests/budget/budget.test b/tests/budget/budget.test index 30ebce1b1..51b1eb999 100644 --- a/tests/budget/budget.test +++ b/tests/budget/budget.test @@ -34,28 +34,28 @@ $ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget Budget performance in 2016/12/01-2016/12/03: - || 2016/12/01 2016/12/02 2016/12/03 -=======================++============================================================================== - :expenses || 0 0 $40 - assets:cash || $-10 [ 40% of $-25] $-14 [ 56% of $-25] $-51 [ 204% of $-25] - expenses:food || $10 [ 100% of $10] $9 [ 90% of $10] $11 [ 110% of $10] - expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15] ------------------------++------------------------------------------------------------------------------ - || 0 [ 0] 0 [ 0] 0 [ 0] + || 2016/12/01 2016/12/02 2016/12/03 +==================++============================================================================== + || 0 0 $40 + assets:cash || $-10 [ 40% of $-25] $-14 [ 56% of $-25] $-51 [ 204% of $-25] + expenses:food || $10 [ 100% of $10] $9 [ 90% of $10] $11 [ 110% of $10] + expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15] +------------------++------------------------------------------------------------------------------ + || 0 [ 0] 0 [ 0] 0 [ 0] # 2. --show-unbudgeted $ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget --show-unbudgeted Budget performance in 2016/12/01-2016/12/03: - || 2016/12/01 2016/12/02 2016/12/03 -==================++============================================================================== - assets:cash || $-10 [ 40% of $-25] $-14 [ 56% of $-25] $-51 [ 204% of $-25] - expenses:cab || 0 0 $15 - expenses:food || $10 [ 100% of $10] $9 [ 90% of $10] $11 [ 110% of $10] - expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15] - expenses:movies || 0 0 $25 -------------------++------------------------------------------------------------------------------ - || 0 [ 0] 0 [ 0] 0 [ 0] + || 2016/12/01 2016/12/02 2016/12/03 +==============================++============================================================================== + :expenses:cab || 0 0 $15 + :expenses:movies || 0 0 $25 + assets:cash || $-10 [ 40% of $-25] $-14 [ 56% of $-25] $-51 [ 204% of $-25] + expenses:food || $10 [ 100% of $10] $9 [ 90% of $10] $11 [ 110% of $10] + expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15] +------------------------------++------------------------------------------------------------------------------ + || 0 [ 0] 0 [ 0] 0 [ 0] # 3. Test that budget works with mix of commodities < @@ -95,14 +95,14 @@ Budget performance in 2016/12/01-2016/12/03: $ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget Budget performance in 2016/12/01-2016/12/03: - || 2016/12/01 2016/12/02 2016/12/03 -=======================++===================================================================================== - :expenses || 0 0 $40 - assets:cash || $-15 [ 60% of $-25] $-26 [ 104% of $-25] $-51 [ 204% of $-25] - expenses:food || £10 [ 150% of $10] 20 CAD [ 210% of $10] $11 [ 110% of $10] - expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15] ------------------------++------------------------------------------------------------------------------------- - || $-15, £10 [ 0] $-21, 20 CAD [ 0] 0 [ 0] + || 2016/12/01 2016/12/02 2016/12/03 +==================++===================================================================================== + || 0 0 $40 + assets:cash || $-15 [ 60% of $-25] $-26 [ 104% of $-25] $-51 [ 204% of $-25] + expenses:food || £10 [ 150% of $10] 20 CAD [ 210% of $10] $11 [ 110% of $10] + expenses:leisure || 0 [ 0% of $15] $5 [ 33% of $15] 0 [ 0% of $15] +------------------++------------------------------------------------------------------------------------- + || $-15, £10 [ 0] $-21, 20 CAD [ 0] 0 [ 0] < ~ daily @@ -182,12 +182,12 @@ Budget performance in 2018/01/01w01: $ hledger -f- bal --budget -D Budget performance in 2018/01/01-2018/01/04: - || 2018/01/01 2018/01/02 2018/01/03 2018/01/04 -================++======================================================================================================== - :b || 1 1 1 1 - a || 1 1 [ 100% of 1] 1 [ 100% of 1] 1 -----------------++-------------------------------------------------------------------------------------------------------- - || 2 2 [ 200% of 1] 2 [ 200% of 1] 2 + || 2018/01/01 2018/01/02 2018/01/03 2018/01/04 +==============++======================================================================================================== + || 1 1 1 1 + a || 1 1 [ 100% of 1] 1 [ 100% of 1] 1 +--------------++-------------------------------------------------------------------------------------------------------- + || 2 2 [ 200% of 1] 2 [ 200% of 1] 2 # 8. Multiple bounded budgets. <