slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: multiBalanceReport: Enable --drop for tree mode.

Browse Source
This commit is contained in:
Stephen Morgan 2020-06-15 14:44:12 +10:00
parent fcaec1540a
commit 5168d136ed
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -351,15 +351,16 @@ displayedAccounts ropts q valuedaccts
isDisplayed = (`HM.member` displayedAccts) isDisplayed = (`HM.member` displayedAccts)
displayedName name displayedName name
| flat_ ropts = DisplayName name (accountNameDrop (drop_ ropts) name) 0 | flat_ ropts = DisplayName name droppedName 0
| otherwise = DisplayName name leaf d | otherwise = DisplayName name leaf d
where where
leaf = accountNameFromComponents . reverse . map accountLeafName $ leaf = accountNameFromComponents . reverse . map accountLeafName $
name : takeWhile (not . isDisplayed) parents droppedName : takeWhile (not . isDisplayed) parents
d | no_elide_ ropts = accountNameLevel name d | no_elide_ ropts = accountNameLevel droppedName
| otherwise = accountNameLevel name - length boringParents | otherwise = accountNameLevel droppedName - length boringParents
boringParents = filter (not . isDisplayed) parents boringParents = filter (not . isDisplayed) parents
parents = parentAccountNames name parents = parentAccountNames droppedName
droppedName = accountNameDrop (drop_ ropts) name
-- Accounts interesting for their own sake -- Accounts interesting for their own sake
interestingAccounts = dbg'' "interestingAccounts" $ interestingAccounts = dbg'' "interestingAccounts" $
@ -374,7 +375,8 @@ displayedAccounts ropts q valuedaccts
-- Accounts interesting because they are a fork for interesting subaccounts -- Accounts interesting because they are a fork for interesting subaccounts
interestingParents = dbg'' "interestingParents" $ interestingParents = dbg'' "interestingParents" $
forkingAccounts $ HM.keys interestingAccounts HM.filterWithKey (\name i -> i > 1 && accountNameLevel name > drop_ ropts) .
subaccountTallies $ HM.keys interestingAccounts
isInterestingParent isInterestingParent
| flat_ ropts = const False | flat_ ropts = const False
@ -505,8 +507,8 @@ sortAccountItemsLike sortedas items = mapMaybe (`lookup` items) sortedas
-- | Given a list of account names, find all forking parent accounts, i.e. -- | Given a list of account names, find all forking parent accounts, i.e.
-- those which fork between different branches -- those which fork between different branches
forkingAccounts :: [AccountName] -> HashMap AccountName Int subaccountTallies :: [AccountName] -> HashMap AccountName Int
forkingAccounts as = HM.filter (>1) $ foldr incrementParent mempty allaccts subaccountTallies as = foldr incrementParent mempty allaccts
where where
allaccts = expandAccountNames as allaccts = expandAccountNames as
incrementParent a = HM.insertWith (+) (parentAccountName a) 1 incrementParent a = HM.insertWith (+) (parentAccountName a) 1