dev: fix DisplayName's off-by-one indent value, noted in #2246

Now displayIndent (and prrIndent) 0 means no indent, 1 means one
indent step, etc.
This commit is contained in:
Simon Michael 2024-10-08 23:04:26 -10:00
parent 05fd8e1d69
commit 4e6f6611a6
5 changed files with 30 additions and 24 deletions

View File

@ -138,6 +138,14 @@ accountNameType :: M.Map AccountName AccountType -> AccountName -> Maybe Account
accountNameType atypes a = asum (map (`M.lookup` atypes) $ a : parentAccountNames a) accountNameType atypes a = asum (map (`M.lookup` atypes) $ a : parentAccountNames a)
<|> accountNameInferType a <|> accountNameInferType a
-- | The level (depth) of an account name.
--
-- >>> accountNameLevel "" -- special case
-- 0
-- >>> accountNameLevel "assets"
-- 1
-- >>> accountNameLevel "assets:cash"
-- 2
accountNameLevel :: AccountName -> Int accountNameLevel :: AccountName -> Int
accountNameLevel "" = 0 accountNameLevel "" = 0
accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1 accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1

View File

@ -71,7 +71,7 @@ balanceReport rspec j = (rows, total)
report = multiBalanceReport rspec j report = multiBalanceReport rspec j
rows = [( prrFullName row rows = [( prrFullName row
, prrDisplayName row , prrDisplayName row
, prrIndent row - 1 -- BalanceReport uses 0-based account depths , prrIndent row
, prrTotal row , prrTotal row
) | row <- prRows report] ) | row <- prRows report]
total = prrTotal $ prTotals report total = prrTotal $ prTotals report

View File

@ -400,34 +400,33 @@ buildReportRows ropts displaynames =
rowavg = averageMixedAmounts rowbals rowavg = averageMixedAmounts rowbals
balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance
-- | Calculate accounts which are to be displayed in the report, as well as -- | Calculate accounts which are to be displayed in the report,
-- their name and depth -- and their name and their indent level if displayed in tree mode.
displayedAccounts :: ReportSpec displayedAccounts :: ReportSpec
-> Set AccountName -> Set AccountName
-> HashMap AccountName (Map DateSpan Account) -> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName -> HashMap AccountName DisplayName
displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts valuedaccts displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts valuedaccts
| qdepth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1 | qdepth == 0 = HM.singleton "..." $ DisplayName "..." "..." 0
| otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts | otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
where where
displayedName name = case accountlistmode_ ropts of
ALTree -> DisplayName name leaf (max 0 $ level - 1 - boringParents)
ALFlat -> DisplayName name droppedName 0
where
droppedName = accountNameDrop (drop_ ropts) name
leaf = accountNameFromComponents . reverse . map accountLeafName $
droppedName : takeWhile notDisplayed parents
level = max 0 $ (accountNameLevel name) - drop_ ropts
parents = take (level - 1) $ parentAccountNames name
boringParents = if no_elide_ ropts then 0 else length $ filter notDisplayed parents
notDisplayed = not . (`HM.member` displayedAccts)
-- Accounts which are to be displayed -- Accounts which are to be displayed
displayedAccts = (if qdepth == 0 then id else HM.filterWithKey keep) valuedaccts displayedAccts = (if qdepth == 0 then id else HM.filterWithKey keep) valuedaccts
where where
keep name amts = isInteresting name amts || name `HM.member` interestingParents keep name amts = isInteresting name amts || name `HM.member` interestingParents
displayedName name = case accountlistmode_ ropts of
ALTree -> DisplayName name leaf . max 0 $ level - boringParents
ALFlat -> DisplayName name droppedName 1
where
droppedName = accountNameDrop (drop_ ropts) name
leaf = accountNameFromComponents . reverse . map accountLeafName $
droppedName : takeWhile notDisplayed parents
level = max 0 $ accountNameLevel name - drop_ ropts
parents = take (level - 1) $ parentAccountNames name
boringParents = if no_elide_ ropts then 0 else length $ filter notDisplayed parents
notDisplayed = not . (`HM.member` displayedAccts)
-- Accounts interesting for their own sake -- Accounts interesting for their own sake
isInteresting name amts = isInteresting name amts =
d <= qdepth -- Throw out anything too deep d <= qdepth -- Throw out anything too deep

View File

@ -227,13 +227,12 @@ instance ToJSON DisplayName where
toJSON = toJSON . displayFull toJSON = toJSON . displayFull
toEncoding = toEncoding . displayFull toEncoding = toEncoding . displayFull
-- | Construct a flat display name, where the full name is also displayed at -- | Construct a display name for a list report, where full names are shown unindented.
-- depth 1
flatDisplayName :: AccountName -> DisplayName flatDisplayName :: AccountName -> DisplayName
flatDisplayName a = DisplayName a a 1 flatDisplayName a = DisplayName a a 0
-- | Construct a tree display name, where only the leaf is displayed at its -- | Construct a display name for a tree report, where leaf names (possibly prefixed by
-- given depth -- boring parents) are shown indented).
treeDisplayName :: AccountName -> DisplayName treeDisplayName :: AccountName -> DisplayName
treeDisplayName a = DisplayName a (accountLeafName a) (accountNameLevel a) treeDisplayName a = DisplayName a (accountLeafName a) (accountNameLevel a)

View File

@ -932,7 +932,7 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, b
fullRowAsTexts row = (replicate (length rs) (renderacct row), rs) fullRowAsTexts row = (replicate (length rs) (renderacct row), rs)
where where
rs = multiBalanceRowAsText opts row rs = multiBalanceRowAsText opts row
renderacct row' = T.replicate ((prrIndent row' - 1) * 2) " " <> prrDisplayName row' renderacct row' = T.replicate (prrIndent row' * 2) " " <> prrDisplayName row'
addtotalrow addtotalrow
| no_total_ opts = id | no_total_ opts = id
| otherwise = | otherwise =
@ -1343,7 +1343,7 @@ renderPeriodicAcct ::
ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct opts space row = renderPeriodicAcct opts space row =
renderBalanceAcct opts space renderBalanceAcct opts space
(prrFullName row, prrDisplayName row, prrIndent row - 1) (prrFullName row, prrDisplayName row, prrIndent row)
-- tests -- tests