From 2e20d0717f7e9ac1a0a01fcbf235495c9a65c89a Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Sat, 4 Jan 2020 14:05:55 +1100 Subject: [PATCH] lib: Generalise PeriodicReport to be polymorphic in the account labels. --- hledger-lib/Hledger/Reports/BudgetReport.hs | 44 ++++++------ .../Hledger/Reports/MultiBalanceReport.hs | 36 +++++----- hledger-lib/Hledger/Reports/ReportTypes.hs | 72 ++++++++++++------- 3 files changed, 85 insertions(+), 67 deletions(-) diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index b8883b365..31b25d569 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 BudgetCell -type BudgetReportRow = PeriodicReportRow BudgetCell +type BudgetReport = PeriodicReport AccountLeaf BudgetCell +type BudgetReportRow = PeriodicReportRow AccountLeaf 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 = [(prrName r, r) | r <- rows] + anamesandrows = [(prrFullName r, r) | r <- rows] anames = map fst anamesandrows - atotals = [(a, tot) | PeriodicReportRow a _ _ _ (tot,_) _ <- rows] + atotals = [(acctFull 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 ((=="") . prrName) rows - anamesandrows = [(prrName r, r) | r <- rows'] + (unbudgetedrow,rows') = partition ((=="") . prrFullName) rows + anamesandrows = [(prrFullName r, r) | r <- rows'] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows @@ -190,17 +190,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 treeacct treeindent amtandgoals totamtandgoal avgamtandgoal - | PeriodicReportRow acct treeacct treeindent actualamts actualtot actualavg <- actualrows - , let mbudgetgoals = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) + [ 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 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,31 +212,31 @@ combineBudgetAndActual ] where budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = - Map.fromList [ (acct, (amts, tot, avg)) - | PeriodicReportRow acct _ _ amts tot avg <- budgetrows ] + Map.fromList [ (acctFull acct, (amts, tot, avg)) + | PeriodicReportRow acct _ amts tot avg <- budgetrows ] -- next, make rows for budget goals with no actual changes rows2 = - [ PeriodicReportRow acct treeacct treeindent amtandgoals totamtandgoal avgamtandgoal - | PeriodicReportRow acct treeacct treeindent budgetgoals budgettot budgetavg <- budgetrows - , acct `notElem` acctsdone + [ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal + | PeriodicReportRow acct treeindent budgetgoals budgettot budgetavg <- budgetrows + , acctFull acct `notElem` acctsdone , 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 prrName rows1 + 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 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 () 0 [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] ( Just actualgrandtot, Just budgetgrandtot ) ( Just actualgrandavg, Just budgetgrandavg ) @@ -313,7 +313,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) @@ -324,10 +324,10 @@ budgetReportAsTable ++ [" Total" | row_total_ ropts] ++ ["Average" | average_ ropts] accts = map renderacct rows - renderacct (PeriodicReportRow a a' i _ _ _) + renderacct (PeriodicReportRow (AccountLeaf a a') i _ _ _) | tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a' | otherwise = T.unpack $ maybeAccountNameDrop ropts a - rowvals (PeriodicReportRow _ _ _ as rowtot rowavg) = + 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 24d3de9d7..9eced0230 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -60,8 +60,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 MixedAmount -type MultiBalanceReportRow = PeriodicReportRow MixedAmount +type MultiBalanceReport = PeriodicReport AccountLeaf MixedAmount +type MultiBalanceReportRow = PeriodicReportRow AccountLeaf MixedAmount -- type alias just to remind us which AccountNames might be depth-clipped, below. type ClippedAccountName = AccountName @@ -233,7 +233,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 a (accountLeafName a) + [ PeriodicReportRow (AccountLeaf a $ accountLeafName a) (accountNameLevel a) valuedrowbals rowtot rowavg | (a,changes) <- dbg1 "acctchanges" acctchanges -- The row amounts to be displayed: per-period changes, @@ -287,9 +287,9 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount 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 = [(prrFullName r, prrTotal r) | r <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where @@ -307,7 +307,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = -- 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 @@ -318,7 +318,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) || prrName row `elem` highestlevelaccts + where isHighest row = not (tree_ ropts) || prrFullName row `elem` highestlevelaccts coltotals :: [MixedAmount] = dbg1 "coltotals" $ map sum colamts -- Calculate the grand total and average. These are always the sum/average @@ -330,8 +330,8 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = ] in amts -- Totals row. - totalsrow :: PeriodicReportRow MixedAmount = - dbg1 "totalsrow" $ PeriodicReportRow "" "" 0 coltotals grandtotal grandaverage + totalsrow :: PeriodicReportRow () MixedAmount = + dbg1 "totalsrow" $ PeriodicReportRow () 0 coltotals grandtotal grandaverage ---------------------------------------------------------------------- -- 9. Map the report rows to percentages if needed @@ -341,14 +341,14 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = mappedsortedrows :: [MultiBalanceReportRow] = if not percent_ then sortedrows else dbg1 "mappedsortedrows" - [ PeriodicReportRow aname alname alevel + [ PeriodicReportRow aname alevel (zipWith perdivide rowvals coltotals) (rowtotal `perdivide` grandtotal) (rowavg `perdivide` grandaverage) - | PeriodicReportRow aname alname alevel rowvals rowtotal rowavg <- sortedrows + | PeriodicReportRow aname alevel rowvals rowtotal rowavg <- sortedrows ] - mappedtotalsrow :: PeriodicReportRow MixedAmount - | percent_ = dbg1 "mappedtotalsrow" $ PeriodicReportRow "" "" 0 + mappedtotalsrow :: PeriodicReportRow () MixedAmount + | percent_ = dbg1 "mappedtotalsrow" $ PeriodicReportRow () 0 (map (\t -> perdivide t t) coltotals) (perdivide grandtotal grandtotal) (perdivide grandaverage grandaverage) @@ -361,12 +361,12 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReportFromMultiBalanceReport opts q j = (rows', total) where - PeriodicReport _ rows (PeriodicReportRow _ _ _ totals _ _) = multiBalanceReport opts q j + 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 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 a a' d amts _ _ <- rows] + ) | PeriodicReportRow (AccountLeaf a a') d amts _ _ <- rows] total = headDef nullmixedamt totals @@ -395,7 +395,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ (opts,journal) `gives` r = do let (eitems, etotal) = r (PeriodicReport _ aitems atotal) = multiBalanceReport opts (queryFromOpts nulldate opts) journal - showw (PeriodicReportRow acct acct' indent lAmt amt amt') + showw (PeriodicReportRow (AccountLeaf acct acct') indent lAmt amt amt') = (acct, 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 @@ -407,8 +407,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" "checking" 3 [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}]) - , PeriodicReportRow "income:salary" "salary" 2 [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}]) + [ 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)}]) ], Mixed [nullamt]) diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 01d452bf3..9bdc2b950 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -5,6 +5,7 @@ New common report types, used by the BudgetReport for now, perhaps all reports l module Hledger.Reports.ReportTypes ( PeriodicReport(..) , PeriodicReportRow(..) +, AccountLeaf(..) , Percentage , Change @@ -15,6 +16,9 @@ module Hledger.Reports.ReportTypes , periodicReportSpan , prNegate , prNormaliseSign + +, prrFullName +, prrLeaf ) where import Data.Decimal @@ -28,17 +32,16 @@ type Total = MixedAmount -- ^ The sum of 'Change's in a report or a report ro type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a report or report row. -- | 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: +-- to some label (usually an account name) 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 +-- * an account label -- -- * the account's depth -- @@ -56,43 +59,58 @@ type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a rep -- 3. the column totals, and the overall grand total (or zero for -- cumulative/historical reports) and grand average. -data PeriodicReport a = +data PeriodicReport a b = PeriodicReport - { prDates :: [DateSpan] -- The subperiods formed by splitting the overall - -- report period by the report interval. For - -- ending-balance reports, only the end date is - -- significant. Usually displayed as report columns. - , prRows :: [PeriodicReportRow a] -- One row per account in the report. - , prTotals :: PeriodicReportRow a -- The grand totals row. The account name in this row is always empty. + { prDates :: [DateSpan] -- The subperiods formed by splitting the overall + -- report period by the report interval. For + -- ending-balance reports, only the end date is + -- significant. Usually displayed as report columns. + , prRows :: [PeriodicReportRow a b] -- One row per account in the report. + , prTotals :: PeriodicReportRow () b -- The grand totals row. } deriving (Show) -data PeriodicReportRow a = +data PeriodicReportRow a b = PeriodicReportRow - { prrName :: AccountName -- A full account name. - , prrLeaf :: AccountName -- Shortened form of the account name to display - -- in tree mode. Usually the leaf name, possibly - -- with parent accounts prefixed. - , prrDepth :: Int -- Indent level for displaying this account name in tree mode. 0, 1, 2... - , prrAmounts :: [a] -- The data value for each subperiod. - , prrTotal :: a -- The total of this row's values. - , prrAverage :: a -- The average of this row's values. + { 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. } 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 -> DateSpan +periodicReportSpan :: PeriodicReport a b -> 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 :: Num b => NormalSign -> PeriodicReport a b -> PeriodicReport a b prNormaliseSign NormallyNegative = prNegate prNormaliseSign _ = id -- | Flip the sign of all amounts in a PeriodicReport. -prNegate :: Num a => PeriodicReport a -> PeriodicReport a +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 leaf indent amts tot avg) = - PeriodicReportRow name leaf indent (map negate amts) (-tot) (-avg) + 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