diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 31b25d569..38dd820dc 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 AccountLeaf BudgetCell -type BudgetReportRow = PeriodicReportRow AccountLeaf BudgetCell +type BudgetReport = PeriodicReport AccountName BudgetCell +type BudgetReportRow = PeriodicReportRow AccountName BudgetCell -- | Calculate budget goals from all periodic transactions, -- actual balance changes from the regular transactions, @@ -100,9 +100,9 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] sortTreeBURByActualAmount rows = sortedrows where - anamesandrows = [(prrFullName r, r) | r <- rows] + anamesandrows = [(prrName r, r) | r <- rows] anames = map fst anamesandrows - atotals = [(acctFull a, tot) | PeriodicReportRow a _ _ (tot,_) _ <- rows] + atotals = [(a, tot) | PeriodicReportRow a _ _ (tot,_) _ <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where @@ -125,8 +125,8 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte -- remains at the top. sortByAccountDeclaration rows = sortedrows where - (unbudgetedrow,rows') = partition ((=="") . prrFullName) rows - anamesandrows = [(prrFullName r, r) | r <- rows'] + (unbudgetedrow,rows') = partition ((=="") . prrName) rows + anamesandrows = [(prrName r, r) | r <- rows'] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows @@ -200,7 +200,7 @@ combineBudgetAndActual rows1 = [ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal | PeriodicReportRow acct treeindent actualamts actualtot actualavg <- actualrows - , let mbudgetgoals = Map.lookup (acctFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) + , let mbudgetgoals = Map.lookup 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 @@ -212,28 +212,26 @@ combineBudgetAndActual ] where budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = - Map.fromList [ (acctFull acct, (amts, tot, avg)) + Map.fromList [ (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 - , acctFull acct `notElem` acctsdone + , acct `notElem` map prrName 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) , let avgamtandgoal = (Nothing, Just budgetavg) ] - where - acctsdone = map prrFullName rows1 -- combine and re-sort rows -- TODO: use MBR code -- TODO: respect --sort-amount -- TODO: add --sort-budget to sort by budget goal amount rows :: [BudgetReportRow] = - sortOn prrFullName $ rows1 ++ rows2 + sortOn prrName $ rows1 ++ rows2 -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells totalrow = PeriodicReportRow () 0 @@ -324,8 +322,8 @@ budgetReportAsTable ++ [" Total" | row_total_ ropts] ++ ["Average" | average_ ropts] accts = map renderacct rows - renderacct (PeriodicReportRow (AccountLeaf a a') i _ _ _) - | tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a' + 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) = as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 9eced0230..4512bb335 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -47,8 +47,6 @@ import Hledger.Reports.BalanceReport -- -- * the full account name -- --- * the leaf account name --- -- * the account's depth -- -- * A list of amounts, one for each column. @@ -60,8 +58,8 @@ import Hledger.Reports.BalanceReport -- 3. the column totals, and the overall grand total (or zero for -- cumulative/historical reports) and grand average. -type MultiBalanceReport = PeriodicReport AccountLeaf MixedAmount -type MultiBalanceReportRow = PeriodicReportRow AccountLeaf MixedAmount +type MultiBalanceReport = PeriodicReport AccountName MixedAmount +type MultiBalanceReportRow = PeriodicReportRow AccountName MixedAmount -- type alias just to remind us which AccountNames might be depth-clipped, below. type ClippedAccountName = AccountName @@ -233,8 +231,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = -- One row per account, with account name info, row amounts, row total and row average. rows :: [MultiBalanceReportRow] = dbg1 "rows" $ - [ PeriodicReportRow (AccountLeaf a $ accountLeafName a) - (accountNameLevel a) valuedrowbals rowtot rowavg + [ PeriodicReportRow a (accountNameLevel a) valuedrowbals rowtot rowavg | (a,changes) <- dbg1 "acctchanges" acctchanges -- The row amounts to be displayed: per-period changes, -- zero-based cumulative totals, or @@ -287,9 +284,9 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount rows = sortedrows where - anamesandrows = [(prrFullName r, r) | r <- rows] + anamesandrows = [(prrName r, r) | r <- rows] anames = map fst anamesandrows - atotals = [(prrFullName r, prrTotal r) | r <- rows] + atotals = [(prrName r, prrTotal r) | r <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where @@ -307,7 +304,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = -- Sort the report rows by account declaration order then account name. sortMBRByAccountDeclaration rows = sortedrows where - anamesandrows = [(prrFullName r, r) | r <- rows] + anamesandrows = [(prrName r, r) | r <- rows] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedrows = sortAccountItemsLike sortedanames anamesandrows @@ -318,7 +315,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = -- Calculate the column totals. These are always the sum of column amounts. highestlevelaccts = [a | a <- displayaccts, not $ any (`elem` displayaccts) $ init $ expandAccountName a] colamts = transpose . map prrAmounts $ filter isHighest rows - where isHighest row = not (tree_ ropts) || prrFullName row `elem` highestlevelaccts + where isHighest row = not (tree_ ropts) || prrName row `elem` highestlevelaccts coltotals :: [MixedAmount] = dbg1 "coltotals" $ map sum colamts -- Calculate the grand total and average. These are always the sum/average @@ -363,10 +360,10 @@ balanceReportFromMultiBalanceReport opts q j = (rows', total) where PeriodicReport _ rows (PeriodicReportRow _ _ totals _ _) = multiBalanceReport opts q j rows' = [( a - , if flat_ opts then a else a' -- BalanceReport expects full account name here with --flat + , 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 , headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does - ) | PeriodicReportRow (AccountLeaf a a') d amts _ _ <- rows] + ) | PeriodicReportRow a d amts _ _ <- rows] total = headDef nullmixedamt totals @@ -395,8 +392,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ (opts,journal) `gives` r = do let (eitems, etotal) = r (PeriodicReport _ aitems atotal) = multiBalanceReport opts (queryFromOpts nulldate opts) journal - showw (PeriodicReportRow (AccountLeaf acct acct') indent lAmt amt amt') - = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') + showw (PeriodicReportRow acct indent lAmt amt amt') + = (acct, accountLeafName acct, indent, 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 @@ -407,8 +404,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 (AccountLeaf "assets:bank:checking" "checking") 3 [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}]) - , PeriodicReportRow (AccountLeaf "income:salary" "salary") 2 [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}]) + [ 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)}]) ], Mixed [nullamt]) diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 9bdc2b950..e9063724c 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -5,7 +5,6 @@ New common report types, used by the BudgetReport for now, perhaps all reports l module Hledger.Reports.ReportTypes ( PeriodicReport(..) , PeriodicReportRow(..) -, AccountLeaf(..) , Percentage , Change @@ -16,9 +15,6 @@ module Hledger.Reports.ReportTypes , periodicReportSpan , prNegate , prNormaliseSign - -, prrFullName -, prrLeaf ) where import Data.Decimal @@ -78,16 +74,6 @@ data PeriodicReportRow a b = , prrAverage :: b -- The average of this row's values. } deriving (Show) --- | A combination of a full account name and a shortened form, used for display --- purposes. -data AccountLeaf = AccountLeaf - { acctFull :: AccountName -- A full account name. - , acctLeaf :: AccountName -- Shortened form of the account name to display - -- in tree mode. Usually the leaf name, possibly - -- with parent accounts prefixed. - } - deriving (Show) - -- | Figure out the overall date span of a PeridicReport periodicReportSpan :: PeriodicReport a b -> DateSpan periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing @@ -106,11 +92,3 @@ prNegate (PeriodicReport colspans rows totalsrow) = where rowNegate (PeriodicReportRow name indent amts tot avg) = PeriodicReportRow name indent (map negate amts) (-tot) (-avg) - --- | Get the full account name for a `PeriodicReport AccountLeaf`> -prrFullName :: PeriodicReportRow AccountLeaf b -> AccountName -prrFullName = acctFull . prrName - --- | Get the shortened form of the account name for a `PeriodicReport AccountLeaf`> -prrLeaf :: PeriodicReportRow AccountLeaf b -> AccountName -prrLeaf = acctLeaf . prrName diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 0ff2a1a3c..d66f85392 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -465,7 +465,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} ++ ["Total" | row_total_] ++ ["Average" | average_] ) : - [T.unpack (maybeAccountNameDrop opts $ acctFull a) : + [T.unpack (maybeAccountNameDrop opts a) : map showMixedAmountOneLineWithoutPrice (amts ++ [rowtot | row_total_] @@ -606,7 +606,7 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} (T.Group NoLine $ map Header colheadings) (map rowvals items) where - totalscolumn = row_total_ && not (balancetype_ `elem` [CumulativeChange, HistoricalBalance]) + totalscolumn = row_total_ && balancetype_ `notElem` [CumulativeChange, HistoricalBalance] mkDate = case balancetype_ of PeriodChange -> showDateSpanMonthAbbrev _ -> maybe "" (showDate . prevday) . spanEnd @@ -614,8 +614,8 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_} ++ [" Total" | totalscolumn] ++ ["Average" | average_] accts = map renderacct items - renderacct (PeriodicReportRow (AccountLeaf a a') i _ _ _) - | tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a' + 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 ++ [rowtot | totalscolumn] diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index abe77e0c0..1c3f88a37 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -270,11 +270,11 @@ compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn s nonzeroaccounts = dbg1 "nonzeroaccounts" $ mapMaybe (\(PeriodicReportRow act _ amts _ _) -> - if not (all isZeroMixedAmount amts) then Just (acctFull act) else Nothing) rows + if not (all isZeroMixedAmount amts) then Just act else Nothing) rows rows' = filter (not . emptyRow) rows where emptyRow (PeriodicReportRow act _ amts _ _) = - all isZeroMixedAmount amts && all (not . (acctFull act `isAccountNamePrefixOf`)) nonzeroaccounts + all isZeroMixedAmount amts && not (any (act `isAccountNamePrefixOf`) nonzeroaccounts) -- | Render a compound balance report as plain text suitable for console output. {- Eg: