diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 22698f28e..4d51dd584 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -47,8 +47,8 @@ type BudgetAverage = Average -- | A budget report tracks expected and actual changes per account and subperiod. type BudgetCell = (Maybe Change, Maybe BudgetGoal) -type BudgetReport = PeriodicReport AccountName BudgetCell -type BudgetReportRow = PeriodicReportRow AccountName BudgetCell +type BudgetReport = PeriodicReport DisplayName BudgetCell +type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell -- | Calculate budget goals from all periodic transactions, -- actual balance changes from the regular transactions, @@ -99,9 +99,9 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] sortTreeBURByActualAmount rows = sortedrows where - anamesandrows = [(prrName r, r) | r <- rows] + anamesandrows = [(prrFullName r, r) | r <- rows] anames = map fst anamesandrows - atotals = [(a, tot) | PeriodicReportRow a _ _ (tot,_) _ <- rows] + atotals = [(displayFull a, tot) | PeriodicReportRow a _ (tot,_) _ <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where @@ -124,8 +124,8 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte -- remains at the top. sortByAccountDeclaration rows = sortedrows where - (unbudgetedrow,rows') = partition ((=="") . prrName) rows - anamesandrows = [(prrName r, r) | r <- rows'] + (unbudgetedrow,rows') = partition ((==unbudgetedAccountName) . prrFullName) rows + anamesandrows = [(prrFullName r, r) | r <- rows'] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows @@ -189,17 +189,17 @@ budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j } -- combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport combineBudgetAndActual - (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ _ budgettots budgetgrandtot budgetgrandavg)) - (PeriodicReport actualperiods actualrows (PeriodicReportRow _ _ actualtots actualgrandtot actualgrandavg)) = + (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg)) + (PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) = PeriodicReport periods rows totalrow where periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods -- first, combine any corresponding budget goals with actual changes rows1 = - [ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal - | PeriodicReportRow acct treeindent actualamts actualtot actualavg <- actualrows - , let mbudgetgoals = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) + [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal + | PeriodicReportRow acct actualamts actualtot actualavg <- actualrows + , let mbudgetgoals = Map.lookup (displayFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) , let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal] , let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal , let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage @@ -211,14 +211,14 @@ combineBudgetAndActual ] where budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = - Map.fromList [ (acct, (amts, tot, avg)) - | PeriodicReportRow acct _ amts tot avg <- budgetrows ] + Map.fromList [ (displayFull acct, (amts, tot, avg)) + | PeriodicReportRow acct amts tot avg <- budgetrows ] -- next, make rows for budget goals with no actual changes rows2 = - [ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal - | PeriodicReportRow acct treeindent budgetgoals budgettot budgetavg <- budgetrows - , acct `notElem` map prrName rows1 + [ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal + | PeriodicReportRow acct budgetgoals budgettot budgetavg <- budgetrows + , displayFull acct `notElem` map prrFullName rows1 , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal , let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell] , let totamtandgoal = (Nothing, Just budgettot) @@ -230,10 +230,10 @@ combineBudgetAndActual -- TODO: respect --sort-amount -- TODO: add --sort-budget to sort by budget goal amount rows :: [BudgetReportRow] = - sortOn prrName $ rows1 ++ rows2 + sortOn prrFullName $ rows1 ++ rows2 -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells - totalrow = PeriodicReportRow () 0 + totalrow = PeriodicReportRow () [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] ( Just actualgrandtot, Just budgetgrandtot ) ( Just actualgrandavg, Just budgetgrandavg ) @@ -311,7 +311,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount) budgetReportAsTable ropts - (PeriodicReport periods rows (PeriodicReportRow _ _ coltots grandtot grandavg)) = + (PeriodicReport periods rows (PeriodicReportRow _ coltots grandtot grandavg)) = addtotalrow $ Table (T.Group NoLine $ map Header accts) @@ -322,10 +322,13 @@ budgetReportAsTable ++ [" Total" | row_total_ ropts] ++ ["Average" | average_ ropts] accts = map renderacct rows - renderacct (PeriodicReportRow a i _ _ _) - | tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack (accountLeafName a) - | otherwise = T.unpack $ maybeAccountNameDrop ropts a - rowvals (PeriodicReportRow _ _ as rowtot rowavg) = + -- FIXME. Have to check explicitly for which to render here, since + -- budgetReport sets accountlistmode to ALTree. Find a principled way to do + -- this. + renderacct row + | tree_ ropts = replicate ((prrDepth row - 1)*2) ' ' ++ T.unpack (prrDisplayName row) + | otherwise = T.unpack . maybeAccountNameDrop ropts $ prrFullName row + rowvals (PeriodicReportRow _ as rowtot rowavg) = as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts] addtotalrow | no_total_ ropts = id diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index a0f4a4b5e..54ebc7529 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -50,9 +50,7 @@ import Hledger.Reports.ReportTypes -- -- 2. a list of rows, each containing: -- --- * the full account name --- --- * the account's depth +-- * the full account name, display name, and display depth -- -- * A list of amounts, one for each column. -- @@ -63,8 +61,8 @@ import Hledger.Reports.ReportTypes -- 3. the column totals, and the overall grand total (or zero for -- cumulative/historical reports) and grand average. -type MultiBalanceReport = PeriodicReport AccountName MixedAmount -type MultiBalanceReportRow = PeriodicReportRow AccountName MixedAmount +type MultiBalanceReport = PeriodicReport DisplayName MixedAmount +type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount -- type alias just to remind us which AccountNames might be depth-clipped, below. type ClippedAccountName = AccountName @@ -78,7 +76,7 @@ type ClippedAccountName = AccountName -- command (in multiperiod mode) and (via multiBalanceReport') by the bs/cf/is commands. multiBalanceReport :: Day -> ReportOpts -> Journal -> MultiBalanceReport multiBalanceReport today ropts j = - multiBalanceReportWith ropts q j (journalPriceOracle infer j) + multiBalanceReportWith ropts q j (journalPriceOracle infer j) where q = queryFromOpts today ropts infer = infer_value_ ropts @@ -93,46 +91,55 @@ multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> Multi multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = report where -- Queries, report/column dates. - reportspan = dbg "reportspan" $ calculateReportSpan ropts q j - reportq = dbg "reportq" $ makeReportQuery ropts reportspan q + ropts' = dbg "ropts'" $ setDefaultAccountListMode ALFlat ropts + reportspan = dbg "reportspan" $ calculateReportSpan ropts' q j + reportq = dbg "reportq" $ makeReportQuery ropts' reportspan q -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. - startbals = dbg' "startbals" $ startingBalances ropts reportq j reportspan + startbals = dbg' "startbals" $ startingBalances ropts' reportq j reportspan -- Postings matching the query within the report period. - ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts reportq j + ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts' reportq j days = map snd ps -- The date spans to be included as report columns. - colspans = dbg "colspans" $ calculateColSpans ropts reportspan days + colspans = dbg "colspans" $ calculateColSpans ropts' reportspan days -- Group postings into their columns. colps = dbg'' "colps" $ calculateColumns colspans ps -- Each account's balance changes across all columns. - acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q startbals colps + acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts' q startbals colps -- Process changes into normal, cumulative, or historical amounts, plus value them - accumvalued = dbg'' "accumvalued" $ accumValueAmounts ropts j priceoracle colspans startbals acctchanges + accumvalued = dbg'' "accumvalued" $ accumValueAmounts ropts' j priceoracle colspans startbals acctchanges -- All account names that will be displayed, possibly depth-clipped. - displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts q accumvalued + displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts' q accumvalued -- All the rows of the report. - rows = dbg'' "rows" $ buildReportRows ropts reportq accumvalued + rows = dbg'' "rows" $ buildReportRows ropts' reportq accumvalued -- Sorted report rows. - sortedrows = dbg' "sortedrows" $ sortRows ropts j rows + sortedrows = dbg' "sortedrows" $ sortRows ropts' j rows -- Calculate column totals - totalsrow = dbg' "totalsrow" $ calculateTotalsRow ropts displayaccts sortedrows + totalsrow = dbg' "totalsrow" $ calculateTotalsRow ropts' displayaccts sortedrows -- Postprocess the report, negating balances and taking percentages if needed - report = dbg' "report" . postprocessReport ropts $ + report = dbg' "report" . postprocessReport ropts' $ PeriodicReport colspans sortedrows totalsrow +-- | Calculate the span of the report to be generated. +setDefaultAccountListMode :: AccountListMode -> ReportOpts -> ReportOpts +setDefaultAccountListMode def ropts = ropts{accountlistmode_=mode} + where + mode = case accountlistmode_ ropts of + ALDefault -> def + a -> a + -- | Calculate the span of the report to be generated. calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan calculateReportSpan ropts q j = reportspan @@ -312,7 +319,7 @@ buildReportRows :: ReportOpts -> Query -> HashMap AccountName [Account] -> [MultiBalanceReportRow] buildReportRows ropts q acctvalues = - [ PeriodicReportRow a (accountNameLevel a) rowbals rowtot rowavg + [ PeriodicReportRow (name a) rowbals rowtot rowavg | (a,accts) <- HM.toList acctvalues , let rowbals = map balance accts -- The total and average for the row. @@ -323,6 +330,7 @@ buildReportRows ropts q acctvalues = , empty_ ropts || queryDepth q == 0 || any (not . mixedAmountLooksZero) rowbals -- TODO: Remove this eventually, to be handled elswhere ] where + name = if tree_ ropts then treeDisplayName else flatDisplayName balance = if tree_ ropts then aibalance else aebalance -- | Calculate accounts which are to be displayed in the report, as well as @@ -363,9 +371,9 @@ sortRows ropts j sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount rows = sortedrows where - anamesandrows = [(prrName r, r) | r <- rows] + anamesandrows = [(prrFullName r, r) | r <- rows] anames = map fst anamesandrows - atotals = [(prrName r, prrTotal r) | r <- rows] + atotals = [(prrFullName r, prrTotal r) | r <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where @@ -383,7 +391,7 @@ sortRows ropts j -- Sort the report rows by account declaration order then account name. sortMBRByAccountDeclaration rows = sortedrows where - anamesandrows = [(prrName r, r) | r <- rows] + anamesandrows = [(prrFullName r, r) | r <- rows] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedrows = sortAccountItemsLike sortedanames anamesandrows @@ -394,13 +402,13 @@ sortRows ropts j calculateTotalsRow :: ReportOpts -> HashMap ClippedAccountName (ClippedAccountName, Int) -> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount calculateTotalsRow ropts displayaccts rows = - PeriodicReportRow () 0 coltotals grandtotal grandaverage + PeriodicReportRow () coltotals grandtotal grandaverage where highestlevelaccts = HM.filterWithKey (\a _ -> isHighest a) displayaccts where isHighest = not . any (`HM.member` displayaccts) . init . expandAccountName colamts = transpose . map prrAmounts $ filter isHighest rows - where isHighest row = not (tree_ ropts) || prrName row `HM.member` highestlevelaccts + where isHighest row = not (tree_ ropts) || prrFullName row `HM.member` highestlevelaccts -- TODO: If colamts is null, then this is empty. Do we want it to be a full -- column of zeros? @@ -418,8 +426,8 @@ postprocessReport ropts (PeriodicReport spans rows totalrow) = where maybeInvert = if invert_ ropts then prNegate else id percentage = if not (percent_ ropts) then id else \case - PeriodicReportRow name d rowvals rowtotal rowavg -> - PeriodicReportRow name d + PeriodicReportRow name rowvals rowtotal rowavg -> + PeriodicReportRow name (zipWith perdivide rowvals $ prrAmounts totalrow) (perdivide rowtotal $ prrTotal totalrow) (perdivide rowavg $ prrAverage totalrow) @@ -431,16 +439,17 @@ postprocessReport ropts (PeriodicReport spans rows totalrow) = -- (see ReportOpts and CompoundBalanceCommand). balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount) -balanceReportFromMultiBalanceReport opts q j = (rows', total) +balanceReportFromMultiBalanceReport ropts q j = (rows', total) where - PeriodicReport _ rows (PeriodicReportRow _ _ totals _ _) = - multiBalanceReportWith opts q j (journalPriceOracle (infer_value_ opts) j) - rows' = [( a - , if flat_ opts then a else accountLeafName a -- BalanceReport expects full account name here with --flat - , if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths + PeriodicReport _ rows (PeriodicReportRow _ totals _ _) = + multiBalanceReportWith ropts q j (journalPriceOracle (infer_value_ ropts) j) + rows' = [( displayFull a + , leafName a + , if tree_ ropts then displayDepth a - 1 else 0 -- BalanceReport uses 0-based account depths , headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does - ) | PeriodicReportRow a d amts _ _ <- rows] + ) | PeriodicReportRow a amts _ _ <- rows] total = headDef nullmixedamt totals + leafName = if flat_ ropts then displayFull else displayName -- BalanceReport expects full account name here with --flat -- | Transpose a Map of HashMaps to a HashMap of Maps. @@ -519,8 +528,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ (opts,journal) `gives` r = do let (eitems, etotal) = r (PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal - showw (PeriodicReportRow acct indent lAmt amt amt') - = (acct, accountLeafName acct, indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') + showw (PeriodicReportRow a lAmt amt amt') + = (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') (map showw aitems) @?= (map showw eitems) showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals in @@ -531,8 +540,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ ,test "with -H on a populated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` ( - [ PeriodicReportRow "assets:bank:checking" 3 [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}]) - , PeriodicReportRow "income:salary" 2 [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}]) + [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}]) + , PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}]) ], Mixed [nullamt]) diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 63f77efdc..1d4084d20 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -17,10 +17,22 @@ module Hledger.Reports.ReportTypes , periodicReportSpan , prNegate , prNormaliseSign + +, prMapName +, prMapMaybeName + +, DisplayName(..) +, flatDisplayName +, treeDisplayName + +, prrFullName +, prrDisplayName +, prrDepth ) where import Data.Aeson import Data.Decimal +import Data.Maybe (mapMaybe) import GHC.Generics (Generic) import Hledger.Data @@ -72,7 +84,6 @@ data PeriodicReport a b = data PeriodicReportRow a b = PeriodicReportRow { prrName :: a -- An account name. - , prrDepth :: Int -- Indent level for displaying this account name in tree mode. 0, 1, 2... , prrAmounts :: [b] -- The data value for each subperiod. , prrTotal :: b -- The total of this row's values. , prrAverage :: b -- The average of this row's values. @@ -94,5 +105,57 @@ prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b prNegate (PeriodicReport colspans rows totalsrow) = PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow) where - rowNegate (PeriodicReportRow name indent amts tot avg) = - PeriodicReportRow name indent (map negate amts) (-tot) (-avg) + rowNegate (PeriodicReportRow name amts tot avg) = + PeriodicReportRow name (map negate amts) (-tot) (-avg) + +-- | Map a function over the row names. +prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c +prMapName f report = report{prRows = map (prrMapName f) $ prRows report} + +-- | Map a function over the row names, possibly discarding some. +prMapMaybeName :: (a -> Maybe b) -> PeriodicReport a c -> PeriodicReport b c +prMapMaybeName f report = report{prRows = mapMaybe (prrMapMaybeName f) $ prRows report} + +-- | Map a function over the row names of the PeriodicReportRow. +prrMapName :: (a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c +prrMapName f row = row{prrName = f $ prrName row} + +-- | Map maybe a function over the row names of the PeriodicReportRow. +prrMapMaybeName :: (a -> Maybe b) -> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c) +prrMapMaybeName f row = case f $ prrName row of + Nothing -> Nothing + Just a -> Just row{prrName = a} + + +-- | A full name, display name, and depth for an account. +data DisplayName = DisplayName + { displayFull :: AccountName + , displayName :: AccountName + , displayDepth :: Int + } deriving (Show, Eq, Ord) + +instance ToJSON DisplayName where + toJSON = toJSON . displayFull + toEncoding = toEncoding . displayFull + +-- | Construct a flat display name, where the full name is also displayed at +-- depth 0 +flatDisplayName :: AccountName -> DisplayName +flatDisplayName a = DisplayName a a 0 + +-- | Construct a tree display name, where only the leaf is displayed at its +-- given depth +treeDisplayName :: AccountName -> DisplayName +treeDisplayName a = DisplayName a (accountLeafName a) (accountNameLevel a) +-- | Get the full, canonical, name of a PeriodicReportRow tagged by a +-- DisplayName. +prrFullName :: PeriodicReportRow DisplayName a -> AccountName +prrFullName = displayFull . prrName + +-- | Get the display name of a PeriodicReportRow tagged by a DisplayName. +prrDisplayName :: PeriodicReportRow DisplayName a -> AccountName +prrDisplayName = displayName . prrName + +-- | Get the display depth of a PeriodicReportRow tagged by a DisplayName. +prrDepth :: PeriodicReportRow DisplayName a -> Int +prrDepth = displayDepth . prrName diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index e20b839fa..1b4ef5593 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -463,18 +463,18 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field) -- and will include the final totals row unless --no-total is set. multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} - (PeriodicReport colspans items (PeriodicReportRow _ _ coltotals tot avg)) = + (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) = maybetranspose $ ("Account" : map showDateSpan colspans ++ ["Total" | row_total_] ++ ["Average" | average_] ) : - [T.unpack (maybeAccountNameDrop opts a) : + [T.unpack (displayFull a) : map showMixedAmountOneLineWithoutPrice (amts ++ [rowtot | row_total_] ++ [rowavg | average_]) - | PeriodicReportRow a _ amts rowtot rowavg <- items] + | PeriodicReportRow a amts rowtot rowavg <- items] ++ if no_total_ opts then [] @@ -603,7 +603,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = -- | Build a 'Table' from a multi-column balance report. balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} - (PeriodicReport colspans items (PeriodicReportRow _ _ coltotals tot avg)) = + (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) = maybetranspose $ addtotalrow $ Table @@ -619,10 +619,9 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} ++ [" Total" | totalscolumn] ++ ["Average" | average_] accts = map renderacct items - renderacct (PeriodicReportRow a i _ _ _) - | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack (accountLeafName a) - | otherwise = T.unpack $ maybeAccountNameDrop opts a - rowvals (PeriodicReportRow _ _ as rowtot rowavg) = as + renderacct row = + replicate ((prrDepth row - 1) * 2) ' ' ++ T.unpack (prrDisplayName row) + rowvals (PeriodicReportRow _ as rowtot rowavg) = as ++ [rowtot | totalscolumn] ++ [rowavg | average_] addtotalrow | no_total_ opts = id diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index a92e9c3bc..872df830e 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -203,7 +203,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r -- "2008/01/01-2008/12/31", not "2008"). titledatestr | balancetype == HistoricalBalance = showEndDates enddates - | otherwise = showDateSpan requestedspan + | otherwise = showDateSpan requestedspan where enddates = map (addDays (-1)) $ catMaybes $ map spanEnd colspans -- these spans will always have a definite end date requestedspan = queryDateSpan date2_ userq `spanDefaultsFrom` journalDateSpan date2_ j @@ -271,12 +271,12 @@ compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn s where nonzeroaccounts = dbg5 "nonzeroaccounts" $ - mapMaybe (\(PeriodicReportRow act _ amts _ _) -> - if not (all mixedAmountLooksZero amts) then Just act else Nothing) rows + mapMaybe (\(PeriodicReportRow act amts _ _) -> + if not (all mixedAmountLooksZero amts) then Just (displayFull act) else Nothing) rows rows' = filter (not . emptyRow) rows where - emptyRow (PeriodicReportRow act _ amts _ _) = - all mixedAmountLooksZero amts && not (any (act `isAccountNamePrefixOf`) nonzeroaccounts) + emptyRow (PeriodicReportRow act amts _ _) = + all mixedAmountLooksZero amts && not (any (displayFull act `isAccountNamePrefixOf`) nonzeroaccounts) -- | Render a compound balance report as plain text suitable for console output. {- Eg: