From ba0623165f14218dbd7a2df040741e9b5d8b3174 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 26 Dec 2014 11:04:23 -0800 Subject: [PATCH] balance: row totals/averages in multicolumn mode --- doc/manual.md | 7 +- hledger-lib/Hledger/Data/Amount.hs | 6 ++ .../Hledger/Reports/MultiBalanceReports.hs | 24 +++-- hledger-lib/Hledger/Reports/ReportOptions.hs | 3 + hledger/Hledger/Cli/Balance.hs | 90 ++++++++++++++----- 5 files changed, 100 insertions(+), 30 deletions(-) diff --git a/doc/manual.md b/doc/manual.md index a897368e2..795de34d0 100644 --- a/doc/manual.md +++ b/doc/manual.md @@ -1019,7 +1019,7 @@ In flat mode, balances from accounts below the depth limit will be shown as part -##### Multi balance reports +##### Multicolumn balance reports With a [reporting interval](#reporting-interval), multiple balance columns will be shown, one for each report period. @@ -1066,6 +1066,11 @@ considered, not just the ones with activity during the report period (use -E to include low-activity accounts which would otherwise would be omitted). +The `--row-totals` flag adds an additional column showing the total +for each row. The `-A/--average` flag adds one more column showing +the average value in each row. Note in `--H/--historical` mode only +the average is useful, and in `--cumulative` mode neither is useful. + ##### Custom output formats In simple balance reports (only), the `--format FMT` option will customize diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 445d2f5d4..7aaf06176 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -80,6 +80,7 @@ module Hledger.Data.Amount ( -- ** arithmetic costOfMixedAmount, divideMixedAmount, + averageMixedAmounts, isNegativeMixedAmount, isZeroMixedAmount, isReallyZeroMixedAmount, @@ -480,6 +481,11 @@ costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as divideMixedAmount :: MixedAmount -> Quantity -> MixedAmount divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as +-- | Calculate the average of some mixed amounts. +averageMixedAmounts :: [MixedAmount] -> MixedAmount +averageMixedAmounts [] = 0 +averageMixedAmounts as = sum as `divideMixedAmount` fromIntegral (length as) + -- | Is this mixed amount negative, if it can be normalised to a single commodity ? isNegativeMixedAmount :: MixedAmount -> Maybe Bool isNegativeMixedAmount m = case as of [a] -> Just $ isNegativeAmount a diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 6a6d9ccdc..2846896c2 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -41,7 +41,7 @@ import Hledger.Reports.BalanceReport -- (see 'BalanceType' and "Hledger.Cli.Balance"). newtype MultiBalanceReport = MultiBalanceReport ([DateSpan] ,[MultiBalanceReportRow] - ,[MixedAmount] + ,MultiBalanceTotalsRow ) -- | A row in a multi balance report has @@ -49,7 +49,13 @@ newtype MultiBalanceReport = MultiBalanceReport ([DateSpan] -- * An account name, with rendering hints -- -- * A list of amounts to be shown in each of the report's columns. -type MultiBalanceReportRow = (RenderableAccountName, [MixedAmount]) +-- +-- * The total of the row amounts. +-- +-- * The average of the row amounts. +type MultiBalanceReportRow = (RenderableAccountName, [MixedAmount], MixedAmount, MixedAmount) + +type MultiBalanceTotalsRow = ([MixedAmount], MixedAmount, MixedAmount) instance Show MultiBalanceReport where -- use ppShow to break long lists onto multiple lines @@ -65,7 +71,7 @@ type ClippedAccountName = AccountName -- showing the change of balance, accumulated balance, or historical balance -- in each of the specified periods. multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport -multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totals) +multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow) where symq = dbg "symq" $ filterQuery queryIsSym $ dbg "requested q" q depthq = dbg "depthq" $ filterQuery queryIsDepth q @@ -144,24 +150,30 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totals) items :: [MultiBalanceReportRow] = dbg "items" $ - [((a, accountLeafName a, accountNameLevel a), displayedBals) + [((a, accountLeafName a, accountNameLevel a), displayedBals, rowtot, rowavg) | (a,changes) <- acctBalChanges , let displayedBals = case balancetype_ opts of HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes CumulativeBalance -> drop 1 $ scanl (+) nullmixedamt changes _ -> changes + , let rowtot = sum displayedBals + , let rowavg = averageMixedAmounts displayedBals , empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals ] totals :: [MixedAmount] = - dbg "totals" $ + -- dbg "totals" $ map sum balsbycol where - balsbycol = transpose [bs | ((a,_,_),bs) <- items, not (tree_ opts) || a `elem` highestlevelaccts] + balsbycol = transpose [bs | ((a,_,_),bs,_,_) <- items, not (tree_ opts) || a `elem` highestlevelaccts] highestlevelaccts = dbg "highestlevelaccts" $ [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a] + totalsrow :: MultiBalanceTotalsRow = + dbg "totalsrow" $ + (totals, sum totals, averageMixedAmounts totals) + dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in this function's debug output -- dbg = const id -- exclude this function from debug output diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 4dffb3c67..ebe32fdb9 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -86,6 +86,7 @@ data ReportOpts = ReportOpts { ,accountlistmode_ :: AccountListMode ,drop_ :: Int ,no_total_ :: Bool + ,row_totals_ :: Bool } deriving (Show, Data, Typeable) instance Default ReportOpts where def = defreportopts @@ -117,6 +118,7 @@ defreportopts = ReportOpts def def def + def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = do @@ -147,6 +149,7 @@ rawOptsToReportOpts rawopts = do ,accountlistmode_ = accountlistmodeopt rawopts ,drop_ = intopt "drop" rawopts ,no_total_ = boolopt "no-total" rawopts + ,row_totals_ = boolopt "row-totals" rawopts } accountlistmodeopt :: RawOpts -> AccountListMode diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 8e3f294ef..3d4512237 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -265,7 +265,9 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts" ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "tree mode: use this custom line format" ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "tree mode: don't squash boring parent accounts" - ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total" + ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total(s) row" + ,flagNone ["row-totals"] (\opts -> setboolopt "row-totals" opts) "multicolumn mode: show a row totals column" + ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "multicolumn mode: show a row averages column" ,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "multicolumn mode: show accumulated ending balances" ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "multicolumn mode: show historical ending balances" ] @@ -393,85 +395,127 @@ formatField opts accountName depth total ljust min max field = case field of -- | Render a multi-column balance report as CSV. multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV -multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, coltotals)) = - ("account" : "short account" : "indent" : map showDateSpan colspans) : - [a : a' : show i : map showMixedAmountOneLineWithoutPrice amts | ((a,a',i), amts) <- items] +multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) = + ("account" : "short account" : "indent" : map showDateSpan colspans + ++ (if row_totals_ opts then ["total"] else []) + ++ (if average_ opts then ["average"] else []) + ) : + [a : a' : show i : + map showMixedAmountOneLineWithoutPrice + (amts + ++ (if row_totals_ opts then [rowtot] else []) + ++ (if average_ opts then [rowavg] else [])) + | ((a,a',i), amts, rowtot, rowavg) <- items] ++ if no_total_ opts then [] - else [["totals", "", ""] ++ map showMixedAmountOneLineWithoutPrice coltotals] + else [["totals", "", ""] + ++ map showMixedAmountOneLineWithoutPrice ( + coltotals + ++ (if row_totals_ opts then [tot] else []) + ++ (if average_ opts then [avg] else []) + )] -- | Render a multi-column period balance report as plain text suitable for console output. periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String -periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) = +periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) = unlines $ ([printf "Balance changes in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $ trimborder $ lines $ render id - ((" "++) . showDateSpan) + (" "++) showMixedAmountOneLineWithoutPrice $ Table (T.Group NoLine $ map (Header . padright acctswidth) accts) - (T.Group NoLine $ map Header colspans) - (map snd items') + (T.Group NoLine $ map Header colheadings) + (map rowvals items') +----+ totalrow where trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) + colheadings = map showDateSpan colspans + ++ (if row_totals_ opts then [" Total"] else []) + ++ (if average_ opts then ["Average"] else []) items' | empty_ opts = items | otherwise = items -- dbg "2" $ filter (any (not . isZeroMixedAmount) . snd) $ dbg "1" items accts = map renderacct items' - renderacct ((a,a',i),_) + renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a acctswidth = maximum $ map length $ accts + rowvals (_,as,rowtot,rowavg) = as + ++ (if row_totals_ opts then [rowtot] else []) + ++ (if average_ opts then [rowavg] else []) totalrow | no_total_ opts = row "" [] - | otherwise = row "" coltotals + | otherwise = row "" $ + coltotals + ++ (if row_totals_ opts then [tot] else []) + ++ (if average_ opts then [avg] else []) -- | Render a multi-column cumulative balance report as plain text suitable for console output. cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String -cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) = +cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) = unlines $ ([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $ trimborder $ lines $ - render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $ + render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table (T.Group NoLine $ map (Header . padright acctswidth) accts) - (T.Group NoLine $ map Header colspans) - (map snd items) + (T.Group NoLine $ map Header colheadings) + (map rowvals items) where trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) + colheadings = map (maybe "" (showDate . prevday) . spanEnd) colspans + ++ (if row_totals_ opts then [" Total"] else []) + ++ (if average_ opts then ["Average"] else []) accts = map renderacct items - renderacct ((a,a',i),_) + renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a acctswidth = maximum $ map length $ accts + rowvals (_,as,rowtot,rowavg) = as + ++ (if row_totals_ opts then [rowtot] else []) + ++ (if average_ opts then [rowavg] else []) addtotalrow | no_total_ opts = id - | otherwise = (+----+ row "" coltotals) + | otherwise = (+----+ (row "" $ + coltotals + ++ (if row_totals_ opts then [tot] else []) + ++ (if average_ opts then [avg] else []) + )) -- | Render a multi-column historical balance report as plain text suitable for console output. historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String -historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) = +historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) = unlines $ ([printf "Ending balances (historical) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $ trimborder $ lines $ - render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $ + render id (" "++) showMixedAmountOneLineWithoutPrice $ addtotalrow $ Table (T.Group NoLine $ map (Header . padright acctswidth) accts) - (T.Group NoLine $ map Header colspans) - (map snd items) + (T.Group NoLine $ map Header colheadings) + (map rowvals items) where trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init) + colheadings = map (maybe "" (showDate . prevday) . spanEnd) colspans + ++ (if row_totals_ opts then [" Total"] else []) + ++ (if average_ opts then ["Average"] else []) accts = map renderacct items - renderacct ((a,a',i),_) + renderacct ((a,a',i),_,_,_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a' | otherwise = maybeAccountNameDrop opts a acctswidth = maximum $ map length $ accts + rowvals (_,as,rowtot,rowavg) = as + ++ (if row_totals_ opts then [rowtot] else []) + ++ (if average_ opts then [rowavg] else []) addtotalrow | no_total_ opts = id - | otherwise = (+----+ row "" coltotals) + | otherwise = (+----+ (row "" $ + coltotals + ++ (if row_totals_ opts then [tot] else []) + ++ (if average_ opts then [avg] else []) + )) -- | Figure out the overall date span of a multicolumn balance report. multiBalanceReportSpan :: MultiBalanceReport -> DateSpan