budget: --drop preserves the <unbudgeted> top-level account

This commit is contained in:
Simon Michael 2018-04-04 13:04:34 +01:00
parent 43287a3e26
commit e2c55aafa9
2 changed files with 18 additions and 2 deletions

View File

@ -57,8 +57,24 @@ accountNameLevel :: AccountName -> Int
accountNameLevel "" = 0
accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1
-- | Remove some number of account name components from the front of the account name.
-- If the special "<unbudgeted>" top-level account is present, it is preserved and
-- dropping affects the rest of the account name.
accountNameDrop :: Int -> AccountName -> AccountName
accountNameDrop n = accountNameFromComponents . drop n . accountNameComponents
accountNameDrop n a
| a == unbudgetedAccount = a
| unbudgetedAccountAndSep `T.isPrefixOf` a =
case accountNameDrop n $ T.drop (T.length unbudgetedAccountAndSep) a of
"" -> unbudgetedAccount
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 = "<unbudgeted>"
-- | Sorted unique account names implied by these account names,
-- ie these plus all their parent accounts up to the root.

View File

@ -106,7 +106,7 @@ budgetRollUp showunbudgeted budget j = j { jtxns = remapTxn <$> jtxns j }
| otherwise =
case parentAccountName acctName of
"" | showunbudgeted -> origAcctName
| otherwise -> T.append (T.pack "<unbudgeted>:") acctName -- TODO: --drop should not remove this
| otherwise -> unbudgetedAccount <> acctsep <> acctName
parent -> remapAccount' parent
remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p }
remapTxn = mapPostings (map remapPosting)