diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index a9888eb4f..b8883b365 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -41,18 +41,6 @@ import Hledger.Reports.BalanceReport (sortAccountItemsLike) import Hledger.Reports.MultiBalanceReport --- for reference: --- ---type MultiBalanceReportRow = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount) ---type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals) --- ---type PeriodicReportRow a = --- ( AccountName -- ^ A full account name. --- , [a] -- ^ The data value for each subperiod. --- , a -- ^ The total of this row's values. --- , a -- ^ The average of this row's values. --- ) - type BudgetGoal = Change type BudgetTotal = Total type BudgetAverage = Average @@ -84,13 +72,15 @@ budgetReport ropts' assrt reportspan d j = jperiodictxns j actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j - actualreport@(PeriodicReport (actualspans, _, _)) = dbg1 "actualreport" $ multiBalanceReport ropts q actualj - budgetgoalreport@(PeriodicReport (_, 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 = PeriodicReport (actualspans, budgetgoalitems, budgetgoaltotals) + | interval_ ropts == NoInterval = PeriodicReport actualspans budgetgoalitems budgetgoaltotals | otherwise = budgetgoalreport budgetreport = combineBudgetAndActual budgetgoalreport' actualreport sortedbudgetreport = sortBudgetReport ropts j budgetreport @@ -99,7 +89,7 @@ budgetReport ropts' assrt reportspan d j = -- | Sort a budget report's rows according to options. sortBudgetReport :: ReportOpts -> Journal -> BudgetReport -> BudgetReport -sortBudgetReport ropts j (PeriodicReport (ps, rows, trow)) = PeriodicReport (ps, sortedrows, trow) +sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sortedrows trow where sortedrows | sort_amount_ ropts && tree_ ropts = sortTreeBURByActualAmount rows @@ -110,9 +100,9 @@ sortBudgetReport ropts j (PeriodicReport (ps, rows, trow)) = PeriodicReport (ps, sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] sortTreeBURByActualAmount rows = sortedrows where - anamesandrows = [(first6 r, r) | r <- rows] + anamesandrows = [(prrName r, r) | r <- rows] anames = map fst anamesandrows - atotals = [(a,tot) | (a,_,_,_,(tot,_),_) <- rows] + atotals = [(a, tot) | PeriodicReportRow a _ _ _ (tot,_) _ <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where @@ -127,16 +117,16 @@ sortBudgetReport ropts j (PeriodicReport (ps, rows, trow)) = PeriodicReport (ps, -- Sort a flat-mode budget report's rows by total actual amount. sortFlatBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] - sortFlatBURByActualAmount = sortBy (maybeflip $ comparing (fst . fifth6)) - where - maybeflip = if normalbalance_ ropts == Just NormallyNegative then id else flip + sortFlatBURByActualAmount = case normalbalance_ ropts of + Just NormallyNegative -> sortOn (fst . prrTotal) + _ -> sortOn (Down . fst . prrTotal) -- Sort the report rows by account declaration order then account name. -- remains at the top. sortByAccountDeclaration rows = sortedrows where - (unbudgetedrow,rows') = partition ((=="").first6) rows - anamesandrows = [(first6 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,66 +190,63 @@ budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j } -- combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport combineBudgetAndActual - (PeriodicReport (budgetperiods, budgetrows, (_, _, _, budgettots, budgetgrandtot, budgetgrandavg))) - (PeriodicReport (actualperiods, actualrows, (_, _, _, actualtots, actualgrandtot, actualgrandavg))) = - PeriodicReport (periods, rows, totalrow) + (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 = - [ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal) - | (acct, treeacct, treeindent, actualamts, actualtot, actualavg) <- actualrows + [ 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) , 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 , 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)] + , let amtandgoals = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell] , let totamtandgoal = (Just actualtot, mbudgettot) , let avgamtandgoal = (Just actualavg, mbudgetavg) ] where budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = - Map.fromList [ (acct, (amts, tot, avg)) | (acct, _, _, amts, tot, avg) <- budgetrows ] + Map.fromList [ (acct, (amts, tot, avg)) + | PeriodicReportRow acct _ _ amts tot avg <- budgetrows ] -- next, make rows for budget goals with no actual changes rows2 = - [ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal) - | (acct, treeacct, treeindent, budgetgoals, budgettot, budgetavg) <- budgetrows + [ PeriodicReportRow acct treeacct treeindent amtandgoals totamtandgoal avgamtandgoal + | PeriodicReportRow acct treeacct treeindent budgetgoals budgettot budgetavg <- budgetrows , 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 amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell] , let totamtandgoal = (Nothing, Just budgettot) , let avgamtandgoal = (Nothing, Just budgetavg) ] where - acctsdone = map first6 rows1 + acctsdone = map prrName 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 first6 $ rows1 ++ rows2 + sortOn prrName $ rows1 ++ rows2 -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells - totalrow = - ( "" - , "" - , 0 - , [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] :: [(Maybe Total, Maybe BudgetTotal)] - , ( Just actualgrandtot, Just budgetgrandtot ) :: (Maybe Total, Maybe BudgetTotal) - , ( Just actualgrandavg, Just budgetgrandavg ) :: (Maybe Total, Maybe BudgetTotal) - ) + totalrow = PeriodicReportRow "" "" 0 + [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] + ( Just actualgrandtot, Just budgetgrandtot ) + ( Just actualgrandavg, Just budgetgrandavg ) where totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change -- | Render a budget report as plain text suitable for console output. budgetReportAsText :: ReportOpts -> BudgetReport -> String -budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) = +budgetReportAsText ropts@ReportOpts{..} budgetr = title ++ "\n\n" ++ tableAsText ropts showcell (maybetranspose $ budgetReportAsTable ropts budgetr) where @@ -275,16 +262,13 @@ budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) = Just (AtDefault _mc) -> ", current value" Just (AtDate d _mc) -> ", valued at "++showDate d Nothing -> "") - actualwidth = - maximum' [ maybe 0 (length . showMixedAmountOneLineWithoutPrice) amt - | (_, _, _, amtandgoals, _, _) <- rows - , (amt, _) <- amtandgoals ] - budgetwidth = - maximum' [ maybe 0 (length . showMixedAmountOneLineWithoutPrice) goal - | (_, _, _, amtandgoals, _, _) <- rows - , (_, goal) <- amtandgoals ] + actualwidth = maximum' $ map fst amountsAndGoals + budgetwidth = maximum' $ map snd amountsAndGoals + amountsAndGoals = map (\(a,g) -> (amountLength a, amountLength g)) + . concatMap prrAmounts $ prRows budgetr + where amountLength = maybe 0 (length . showMixedAmountOneLineWithoutPrice) -- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells - showcell :: (Maybe Change, Maybe BudgetGoal) -> String + showcell :: BudgetCell -> String showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr where percentwidth = 4 @@ -329,7 +313,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 (PeriodicReportRow _ _ _ coltots grandtot grandavg)) = addtotalrow $ Table (T.Group NoLine $ map Header accts) @@ -337,21 +321,20 @@ budgetReportAsTable (map rowvals rows) where colheadings = map showDateSpanMonthAbbrev periods - ++ (if row_total_ ropts then [" Total"] else []) - ++ (if average_ ropts then ["Average"] else []) + ++ [" Total" | row_total_ ropts] + ++ ["Average" | average_ ropts] accts = map renderacct rows - renderacct (a,a',i,_,_,_) + renderacct (PeriodicReportRow a a' i _ _ _) | tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a' | otherwise = T.unpack $ maybeAccountNameDrop ropts a - rowvals (_,_,_,as,rowtot,rowavg) = as - ++ (if row_total_ ropts then [rowtot] else []) - ++ (if average_ ropts then [rowavg] else []) - addtotalrow | no_total_ ropts = id - | otherwise = (+----+ (row "" $ - coltots - ++ (if row_total_ ropts && not (null coltots) then [grandtot] else []) - ++ (if average_ ropts && not (null coltots) then [grandavg] else []) - )) + rowvals (PeriodicReportRow _ _ _ as rowtot rowavg) = + as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts] + addtotalrow + | no_total_ ropts = id + | otherwise = (+----+ (row "" $ + coltots ++ [grandtot | row_total_ ropts && not (null coltots)] + ++ [grandavg | average_ ropts && not (null coltots)] + )) -- XXX here for now -- TODO: does not work for flat-by-default reports with --flat not specified explicitly diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 68156ce24..24d3de9d7 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -83,7 +83,7 @@ multiBalanceReport ropts q j = multiBalanceReportWith ropts q j (journalPriceOra multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = (if invert_ then prNegate else id) $ - PeriodicReport (colspans, mappedsortedrows, mappedtotalsrow) + 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 @@ -233,7 +233,8 @@ 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" $ - [(a, accountLeafName a, accountNameLevel a, valuedrowbals, rowtot, rowavg) + [ PeriodicReportRow a (accountLeafName 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 @@ -286,9 +287,9 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount rows = sortedrows where - anamesandrows = [(first6 r, r) | r <- rows] + anamesandrows = [(prrName r, r) | r <- rows] anames = map fst anamesandrows - atotals = [(a,tot) | (a,_,_,_,tot,_) <- rows] + atotals = [(a,tot) | PeriodicReportRow a _ _ _ tot _ <- rows] accounttree = accountTree "root" anames accounttreewithbals = mapAccounts setibalance accounttree where @@ -299,14 +300,14 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = sortedrows = sortAccountItemsLike sortedanames anamesandrows -- Sort the report rows, representing a flat account list, by row total. - sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fifth6)) + sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . prrTotal)) where maybeflip = if normalbalance_ == Just NormallyNegative then id else flip -- Sort the report rows by account declaration order then account name. sortMBRByAccountDeclaration rows = sortedrows where - anamesandrows = [(first6 r, r) | r <- rows] + anamesandrows = [(prrName r, r) | r <- rows] anames = map fst anamesandrows sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedrows = sortAccountItemsLike sortedanames anamesandrows @@ -316,7 +317,8 @@ 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 [bs | (a,_,_,bs,_,_) <- rows, not (tree_ ropts) || a `elem` highestlevelaccts] + colamts = transpose . map prrAmounts $ filter isHighest rows + 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 @@ -329,7 +331,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = in amts -- Totals row. totalsrow :: PeriodicReportRow MixedAmount = - dbg1 "totalsrow" ("", "", 0, coltotals, grandtotal, grandaverage) + dbg1 "totalsrow" $ PeriodicReportRow "" "" 0 coltotals grandtotal grandaverage ---------------------------------------------------------------------- -- 9. Map the report rows to percentages if needed @@ -339,16 +341,18 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = mappedsortedrows :: [MultiBalanceReportRow] = if not percent_ then sortedrows else dbg1 "mappedsortedrows" - [(aname, alname, alevel, zipWith perdivide rowvals coltotals, rowtotal `perdivide` grandtotal, rowavg `perdivide` grandaverage) - | (aname, alname, alevel, rowvals, rowtotal, rowavg) <- sortedrows + [ PeriodicReportRow aname alname alevel + (zipWith perdivide rowvals coltotals) + (rowtotal `perdivide` grandtotal) + (rowavg `perdivide` grandaverage) + | PeriodicReportRow aname alname alevel rowvals rowtotal rowavg <- sortedrows ] - mappedtotalsrow :: PeriodicReportRow MixedAmount = - if not percent_ - then totalsrow - else dbg1 "mappedtotalsrow" $ ("", "", 0, - map (\t -> perdivide t t) coltotals, - perdivide grandtotal grandtotal, - perdivide grandaverage grandaverage) + mappedtotalsrow :: PeriodicReportRow MixedAmount + | percent_ = dbg1 "mappedtotalsrow" $ PeriodicReportRow "" "" 0 + (map (\t -> perdivide t t) coltotals) + (perdivide grandtotal grandtotal) + (perdivide grandaverage grandaverage) + | otherwise = totalsrow -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport, -- in order to support --historical. Does not support tree-mode boring parent eliding. @@ -357,12 +361,12 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReportFromMultiBalanceReport opts q j = (rows', total) where - 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 + 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 - ) | (a,a',d, amts, _, _) <- rows] + ) | PeriodicReportRow a a' d amts _ _ <- rows] total = headDef nullmixedamt totals @@ -390,11 +394,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 - (PeriodicReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal - showw (acct,acct',indent,lAmt,amt,amt') + (PeriodicReport _ aitems atotal) = multiBalanceReport opts (queryFromOpts nulldate opts) journal + showw (PeriodicReportRow acct acct' indent lAmt amt amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') (map showw aitems) @?= (map showw eitems) - showMixedAmountDebug (fifth6 atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals + showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals in tests "multiBalanceReport" [ test "null journal" $ @@ -403,9 +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` ( - [ - ("assets:bank:checking", "checking", 3, [mamountp' "$1.00"] , Mixed [nullamt], Mixed [amt0 {aquantity=1}]) - ,("income:salary" ,"salary" , 2, [mamountp' "$-1.00"], Mixed [nullamt], Mixed [amt0 {aquantity=(-1)}]) + [ 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)}]) ], Mixed [nullamt]) diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 5cd07f029..01d452bf3 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -4,7 +4,7 @@ New common report types, used by the BudgetReport for now, perhaps all reports l module Hledger.Reports.ReportTypes ( PeriodicReport(..) -, PeriodicReportRow +, PeriodicReportRow(..) , Percentage , Change @@ -58,27 +58,30 @@ type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a rep data PeriodicReport a = PeriodicReport - ( [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. - , [PeriodicReportRow a] -- One row per account in the report. - , PeriodicReportRow a -- The grand totals row. The account name in this row is always empty. - ) - deriving (Show) + { 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. + } deriving (Show) -type PeriodicReportRow a = - ( AccountName -- A full account name. - , AccountName -- Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed. - , Int -- Indent level for displaying this account name in tree mode. 0, 1, 2... - , [a] -- The data value for each subperiod. - , a -- The total of this row's values. - , a -- The average of this row's values. - ) +data PeriodicReportRow a = + 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. + } deriving (Show) -- | 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) +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. @@ -88,8 +91,8 @@ 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) +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) + rowNegate (PeriodicReportRow name leaf indent amts tot avg) = + PeriodicReportRow name leaf indent (map negate amts) (-tot) (-avg)