From beb8b6d7c84492cd40da82968ff25b14b4437832 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Sat, 4 Jan 2020 12:13:50 +1100 Subject: [PATCH] lib: Use PeriodicReport in place of MultiBalanceReport. --- hledger-lib/Hledger/Reports/BudgetReport.hs | 47 ++++------ .../Hledger/Reports/MultiBalanceReport.hs | 93 ++++++------------- hledger-lib/Hledger/Reports/ReportTypes.hs | 67 +++++++++++-- 3 files changed, 103 insertions(+), 104 deletions(-) diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 58d932c88..a9888eb4f 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -80,17 +80,17 @@ budgetReport ropts' assrt reportspan d j = concatMap expandAccountName $ accountNamesFromPostings $ concatMap tpostings $ - concatMap (flip runPeriodicTransaction reportspan) $ + concatMap (`runPeriodicTransaction` reportspan) $ jperiodictxns j actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j - actualreport@(MultiBalanceReport (actualspans, _, _)) = dbg1 "actualreport" $ multiBalanceReport ropts q actualj - budgetgoalreport@(MultiBalanceReport (_, budgetgoalitems, budgetgoaltotals)) = dbg1 "budgetgoalreport" $ multiBalanceReport (ropts{empty_=True}) q budgetj + actualreport@(PeriodicReport (actualspans, _, _)) = dbg1 "actualreport" $ multiBalanceReport ropts q actualj + budgetgoalreport@(PeriodicReport (_, budgetgoalitems, budgetgoaltotals)) = dbg1 "budgetgoalreport" $ multiBalanceReport (ropts{empty_=True}) q budgetj budgetgoalreport' -- If no interval is specified: -- budgetgoalreport's span might be shorter actualreport's due to periodic txns; -- it should be safe to replace it with the latter, so they combine well. - | interval_ ropts == NoInterval = MultiBalanceReport (actualspans, budgetgoalitems, budgetgoaltotals) + | interval_ ropts == NoInterval = PeriodicReport (actualspans, budgetgoalitems, budgetgoaltotals) | otherwise = budgetgoalreport budgetreport = combineBudgetAndActual budgetgoalreport' actualreport sortedbudgetreport = sortBudgetReport ropts j budgetreport @@ -200,10 +200,11 @@ budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j } -- combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport combineBudgetAndActual - (MultiBalanceReport (budgetperiods, budgetrows, (budgettots, budgetgrandtot, budgetgrandavg))) - (MultiBalanceReport (actualperiods, actualrows, (actualtots, actualgrandtot, actualgrandavg))) = - let - periods = nubSort $ filter (/= nulldatespan) $ budgetperiods ++ actualperiods + (PeriodicReport (budgetperiods, budgetrows, (_, _, _, budgettots, budgetgrandtot, budgetgrandavg))) + (PeriodicReport (actualperiods, actualrows, (_, _, _, actualtots, actualgrandtot, actualgrandavg))) = + PeriodicReport (periods, rows, totalrow) + where + periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods -- first, combine any corresponding budget goals with actual changes rows1 = @@ -211,8 +212,8 @@ combineBudgetAndActual | (acct, treeacct, treeindent, actualamts, actualtot, actualavg) <- actualrows , 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 = maybe Nothing (Just . second3) mbudgetgoals :: Maybe BudgetTotal - , let mbudgetavg = maybe Nothing (Just . third3) mbudgetgoals :: Maybe BudgetAverage + , let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal + , let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage , let acctBudgetByPeriod = Map.fromList [ (p,budgetamt) | (p, Just budgetamt) <- zip budgetperiods budgetmamts ] :: Map DateSpan BudgetGoal , let acctActualByPeriod = Map.fromList [ (p,actualamt) | (p, Just actualamt) <- zip actualperiods (map Just actualamts) ] :: Map DateSpan Change , let amtandgoals = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [(Maybe Change, Maybe BudgetGoal)] @@ -227,7 +228,7 @@ combineBudgetAndActual rows2 = [ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal) | (acct, treeacct, treeindent, budgetgoals, budgettot, budgetavg) <- budgetrows - , not $ acct `elem` acctsdone + , acct `notElem` acctsdone , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal , let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [(Maybe Change, Maybe BudgetGoal)] , let totamtandgoal = (Nothing, Just budgettot) @@ -240,8 +241,8 @@ combineBudgetAndActual -- TODO: use MBR code -- TODO: respect --sort-amount -- TODO: add --sort-budget to sort by budget goal amount - rows :: [PeriodicReportRow (Maybe Change, Maybe BudgetGoal)] = - sortBy (comparing first6) $ rows1 ++ rows2 + rows :: [BudgetReportRow] = + sortOn first6 $ rows1 ++ rows2 -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells totalrow = @@ -256,18 +257,6 @@ combineBudgetAndActual totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change - in - PeriodicReport - ( periods - , rows - , totalrow - ) - --- | Figure out the overall period of a BudgetReport. -budgetReportSpan :: BudgetReport -> DateSpan -budgetReportSpan (PeriodicReport ([], _, _)) = DateSpan Nothing Nothing -budgetReportSpan (PeriodicReport (spans, _, _)) = DateSpan (spanStart $ head spans) (spanEnd $ last spans) - -- | Render a budget report as plain text suitable for console output. budgetReportAsText :: ReportOpts -> BudgetReport -> String budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) = @@ -276,7 +265,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) = where multiperiod = interval_ /= NoInterval title = printf "Budget performance in %s%s:" - (showDateSpan $ budgetReportSpan budgetr) + (showDateSpan $ periodicReportSpan budgetr) (case value_ of Just (AtCost _mc) -> ", valued at cost" Just (AtEnd _mc) -> ", valued at period ends" @@ -340,11 +329,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) = budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount) budgetReportAsTable ropts - (PeriodicReport - ( periods - , rows - , (_, _, _, coltots, grandtot, grandavg) - )) = + (PeriodicReport (periods, rows, (_, _, _, coltots, grandtot, grandavg))) = addtotalrow $ Table (T.Group NoLine $ map Header accts) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 266c4205a..68156ce24 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -6,14 +6,12 @@ Multi-column balance reports, used by the balance command. -} module Hledger.Reports.MultiBalanceReport ( - MultiBalanceReport(..), + MultiBalanceReport, MultiBalanceReportRow, + multiBalanceReport, multiBalanceReportWith, balanceReportFromMultiBalanceReport, - mbrNegate, - mbrNormaliseSign, - multiBalanceReportSpan, tableAsText, -- -- * Tests @@ -21,8 +19,6 @@ module Hledger.Reports.MultiBalanceReport ( ) where -import GHC.Generics (Generic) -import Control.DeepSeq (NFData) import Data.List import Data.List.Extra (nubSort) import qualified Data.Map as M @@ -38,12 +34,12 @@ import Hledger.Query import Hledger.Utils import Hledger.Read (mamountp') import Hledger.Reports.ReportOptions +import Hledger.Reports.ReportTypes import Hledger.Reports.BalanceReport --- | A multi balance report is a balance report with multiple columns, --- corresponding to consecutive subperiods within the overall report --- period. It has: +-- | A multi balance report is a kind of periodic report, where the amounts +-- correspond to balance changes or ending balances in a given period. It has: -- -- 1. a list of each column's period (date span) -- @@ -55,38 +51,17 @@ import Hledger.Reports.BalanceReport -- -- * the account's depth -- --- * A list of amounts, one for each column. The meaning of the --- amounts depends on the type of multi balance report, of which --- there are three: periodic, cumulative and historical (see --- 'BalanceType' and "Hledger.Cli.Commands.Balance"). +-- * A list of amounts, one for each column. -- --- * the total of the row's amounts for a periodic report, --- or zero for cumulative/historical reports (since summing --- end balances generally doesn't make sense). +-- * the total of the row's amounts for a periodic report -- -- * the average of the row's amounts -- -- 3. the column totals, and the overall grand total (or zero for -- cumulative/historical reports) and grand average. --- -newtype MultiBalanceReport = - MultiBalanceReport ([DateSpan] - ,[MultiBalanceReportRow] - ,MultiBalanceReportTotals - ) - deriving (Generic) -type MultiBalanceReportRow = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount) -type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals) - -instance NFData MultiBalanceReport - -instance Show MultiBalanceReport where - -- use pshow (pretty-show's ppShow) to break long lists onto multiple lines - -- we add some bogus extra shows here to help it parse the output - -- and wrap tuples and lists properly - show (MultiBalanceReport (spans, items, totals)) = - "MultiBalanceReport (ignore extra quotes):\n" ++ pshow (show spans, map show items, totals) +type MultiBalanceReport = PeriodicReport MixedAmount +type MultiBalanceReportRow = PeriodicReportRow MixedAmount -- type alias just to remind us which AccountNames might be depth-clipped, below. type ClippedAccountName = AccountName @@ -107,8 +82,8 @@ multiBalanceReport ropts q j = multiBalanceReportWith ropts q j (journalPriceOra -- for efficiency, passing it to each report by calling this function directly. multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = - (if invert_ then mbrNegate else id) $ - MultiBalanceReport (colspans, mappedsortedrows, mappedtotalsrow) + (if invert_ then prNegate else id) $ + PeriodicReport (colspans, mappedsortedrows, mappedtotalsrow) where dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in this function's debug output -- dbg1 = const id -- exclude this function from debug output @@ -308,6 +283,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = where -- Sort the report rows, representing a tree of accounts, by row total at each level. -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration. + sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount rows = sortedrows where anamesandrows = [(first6 r, r) | r <- rows] @@ -352,14 +328,13 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = ] in amts -- Totals row. - totalsrow :: MultiBalanceReportTotals = - dbg1 "totalsrow" (coltotals, grandtotal, grandaverage) + totalsrow :: PeriodicReportRow MixedAmount = + dbg1 "totalsrow" ("", "", 0, coltotals, grandtotal, grandaverage) ---------------------------------------------------------------------- -- 9. Map the report rows to percentages if needed -- It is not correct to do this before step 6 due to the total and average columns. -- This is not done in step 6, since the report totals are calculated in 8. - -- Perform the divisions to obtain percentages mappedsortedrows :: [MultiBalanceReportRow] = if not percent_ then sortedrows @@ -367,30 +342,13 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = [(aname, alname, alevel, zipWith perdivide rowvals coltotals, rowtotal `perdivide` grandtotal, rowavg `perdivide` grandaverage) | (aname, alname, alevel, rowvals, rowtotal, rowavg) <- sortedrows ] - mappedtotalsrow :: MultiBalanceReportTotals = - if not percent_ then totalsrow - else dbg1 "mappedtotalsrow" ( - map (\t -> perdivide t t) coltotals, - perdivide grandtotal grandtotal, - perdivide grandaverage grandaverage) - --- | Given a MultiBalanceReport and its normal balance sign, --- if it is known to be normally negative, convert it to normally positive. -mbrNormaliseSign :: NormalSign -> MultiBalanceReport -> MultiBalanceReport -mbrNormaliseSign NormallyNegative = mbrNegate -mbrNormaliseSign _ = id - --- | Flip the sign of all amounts in a MultiBalanceReport. -mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) = - MultiBalanceReport (colspans, map mbrRowNegate rows, mbrTotalsRowNegate totalsrow) - where - mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg) - mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg) - --- | Figure out the overall date span of a multicolumn balance report. -multiBalanceReportSpan :: MultiBalanceReport -> DateSpan -multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing -multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) + mappedtotalsrow :: PeriodicReportRow MixedAmount = + if not percent_ + then totalsrow + else dbg1 "mappedtotalsrow" $ ("", "", 0, + map (\t -> perdivide t t) coltotals, + perdivide grandtotal grandtotal, + perdivide grandaverage grandaverage) -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport, -- in order to support --historical. Does not support tree-mode boring parent eliding. @@ -399,7 +357,7 @@ multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanSta balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReportFromMultiBalanceReport opts q j = (rows', total) where - MultiBalanceReport (_, rows, (totals, _, _)) = multiBalanceReport opts q j + PeriodicReport (_, rows, (_,_,_,totals,_,_)) = multiBalanceReport opts q j rows' = [(a ,if flat_ opts then a else a' -- BalanceReport expects full account name here with --flat ,if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths @@ -432,10 +390,11 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} (opts,journal) `gives` r = do let (eitems, etotal) = r - (MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal - showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') + (PeriodicReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal + showw (acct,acct',indent,lAmt,amt,amt') + = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') (map showw aitems) @?= (map showw eitems) - ((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals + showMixedAmountDebug (fifth6 atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals in tests "multiBalanceReport" [ test "null journal" $ diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 73b4199cc..5cd07f029 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -3,7 +3,19 @@ New common report types, used by the BudgetReport for now, perhaps all reports l -} module Hledger.Reports.ReportTypes -where +( PeriodicReport(..) +, PeriodicReportRow + +, Percentage +, Change +, Balance +, Total +, Average + +, periodicReportSpan +, prNegate +, prNormaliseSign +) where import Data.Decimal import Hledger.Data @@ -15,11 +27,35 @@ type Balance = MixedAmount -- ^ An ending balance as of some date. type Total = MixedAmount -- ^ The sum of 'Change's in a report or a report row. Does not make sense for 'Balance's. type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a report or report row. --- | A generic tabular report of some value, where each row corresponds to an account --- and each column is a date period. The column periods are usually consecutive subperiods --- formed by splitting the overall report period by some report interval (daily, weekly, etc.) --- Depending on the value type, this can be a report of balance changes, ending balances, --- budget performance, etc. Successor to MultiBalanceReport. +-- | A periodic report is a generic tabular report, where each row corresponds +-- to an account and each column to a date period. The column periods are +-- usually consecutive subperiods formed by splitting the overall report period +-- by some report interval (daily, weekly, etc.). It has: +-- +-- 1. a list of each column's period (date span) +-- +-- 2. a list of rows, each containing: +-- +-- * the full account name +-- +-- * the leaf account name +-- +-- * the account's depth +-- +-- * A list of amounts, one for each column. Depending on the value type, +-- these can represent balance changes, ending balances, budget +-- performance, etc. (for example, see 'BalanceType' and +-- "Hledger.Cli.Commands.Balance"). +-- +-- * the total of the row's amounts for a periodic report, +-- or zero for cumulative/historical reports (since summing +-- end balances generally doesn't make sense). +-- +-- * the average of the row's amounts +-- +-- 3. the column totals, and the overall grand total (or zero for +-- cumulative/historical reports) and grand average. + data PeriodicReport a = PeriodicReport ( [DateSpan] -- The subperiods formed by splitting the overall report period by the report interval. @@ -38,3 +74,22 @@ type PeriodicReportRow a = , a -- The total of this row's values. , a -- The average of this row's values. ) + +-- | Figure out the overall date span of a PeridicReport +periodicReportSpan :: PeriodicReport a -> DateSpan +periodicReportSpan (PeriodicReport ([], _, _)) = DateSpan Nothing Nothing +periodicReportSpan (PeriodicReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) + +-- | Given a PeriodicReport and its normal balance sign, +-- if it is known to be normally negative, convert it to normally positive. +prNormaliseSign :: Num a => NormalSign -> PeriodicReport a -> PeriodicReport a +prNormaliseSign NormallyNegative = prNegate +prNormaliseSign _ = id + +-- | Flip the sign of all amounts in a PeriodicReport. +prNegate :: Num a => PeriodicReport a -> PeriodicReport a +prNegate (PeriodicReport (colspans, rows, totalsrow)) = + PeriodicReport (colspans, map rowNegate rows, rowNegate totalsrow) + where + rowNegate (acct, acct', indent, amts, tot, avg) = + (acct, acct', indent, map negate amts, -tot, -avg)