lib: Use PeriodicReport in place of MultiBalanceReport.

This commit is contained in:
Stephen Morgan 2020-01-04 12:13:50 +11:00 committed by Simon Michael
parent 74778efcf5
commit beb8b6d7c8
3 changed files with 103 additions and 104 deletions

View File

@ -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)

View File

@ -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" $

View File

@ -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)