From 6b349e31234ba99e7f600a744fc95c623fd7ebce Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 15 Jan 2018 17:58:14 -0800 Subject: [PATCH] bs/bse/cf/is: show all balances as normally-positive (experimental) Income, liability and equity balances, which until now we have always displayed as negative numbers, are now shown as normally positive by these reports. Negative numbers now indicate a contra-balance (eg an overdrawn checking account), a net loss, a negative net worth, etc. This makes these reports more like conventional financial statements, and easier to read and share with normal people. --- .../Hledger/Reports/MultiBalanceReports.hs | 2 + hledger-lib/Hledger/Reports/ReportOptions.hs | 7 +- hledger/Hledger/Cli/Commands/Balancesheet.hs | 21 ++- .../Cli/Commands/Balancesheetequity.hs | 28 +++- hledger/Hledger/Cli/Commands/Cashflow.hs | 13 +- .../Hledger/Cli/Commands/Incomestatement.hs | 21 ++- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 131 +++++++++++------ tests/balancesheet/balancesheet.test | 132 ++++++++++-------- tests/incomestatement/incomestatement.test | 60 ++++++-- 9 files changed, 291 insertions(+), 124 deletions(-) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 81dcd7383..c73c6c41f 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -10,6 +10,8 @@ module Hledger.Reports.MultiBalanceReports ( MultiBalanceReportRow, multiBalanceReport, singleBalanceReport, +-- mbrNegate, +-- mbrNormaliseSign, -- -- * Tests tests_Hledger_Reports_MultiBalanceReport diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 660b8c796..86f6fc7fb 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -105,8 +105,11 @@ data ReportOpts = ReportOpts { ,normalbalance_ :: Maybe NormalSign -- ^ This can be set when running balance reports on a set of accounts -- with the same normal balance type (eg all assets, or all incomes). - -- It helps --sort-amount know how to sort negative numbers - -- (eg in the income section of an income statement) + -- - It helps --sort-amount know how to sort negative numbers + -- (eg in the income section of an income statement) + -- - It helps compound balance report commands (is, bs etc.) do + -- sign normalisation, converting normally negative subreports to + -- normally positive for a more conventional display. ,color_ :: Bool ,forecast_ :: Bool ,auto_ :: Bool diff --git a/hledger/Hledger/Cli/Commands/Balancesheet.hs b/hledger/Hledger/Cli/Commands/Balancesheet.hs index 00d7b0ade..369e3964c 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheet.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheet.hs @@ -27,11 +27,26 @@ This command displays a simple balance sheet, showing historical ending balances of asset and liability accounts (ignoring any report begin date). It assumes that these accounts are under a top-level `asset` or `liability` account (case insensitive, plural forms also allowed). + +Note this report shows all account balances with normal positive sign +(like conventional financial statements, unlike balance/print/register) +(experimental). |], cbctitle = "Balance Sheet", - cbcqueries = [ ("Assets" , journalAssetAccountQuery, Just NormallyPositive), - ("Liabilities", journalLiabilityAccountQuery, Just NormallyNegative) - ], + cbcqueries = [ + CBCSubreportSpec{ + cbcsubreporttitle="Assets" + ,cbcsubreportquery=journalAssetAccountQuery + ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportincreasestotal=True + } + ,CBCSubreportSpec{ + cbcsubreporttitle="Liabilities" + ,cbcsubreportquery=journalLiabilityAccountQuery + ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportincreasestotal=False + } + ], cbctype = HistoricalBalance } diff --git a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs index 4c6ba4e7c..669b32f78 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs @@ -24,12 +24,32 @@ balancesheetequitySpec = CompoundBalanceCommandSpec { balances of asset, liability and equity accounts (ignoring any report begin date). It assumes that these accounts are under a top-level `asset`, `liability` and `equity` account (plural forms also allowed). + +Note this report shows all account balances with normal positive sign +(like conventional financial statements, unlike balance/print/register) +(experimental). |], cbctitle = "Balance Sheet With Equity", - cbcqueries = [("Assets", journalAssetAccountQuery, Just NormallyPositive), - ("Liabilities", journalLiabilityAccountQuery, Just NormallyNegative), - ("Equity", journalEquityAccountQuery, Just NormallyNegative) - ], + cbcqueries = [ + CBCSubreportSpec{ + cbcsubreporttitle="Assets" + ,cbcsubreportquery=journalAssetAccountQuery + ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportincreasestotal=True + } + ,CBCSubreportSpec{ + cbcsubreporttitle="Liabilities" + ,cbcsubreportquery=journalLiabilityAccountQuery + ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportincreasestotal=False + } + ,CBCSubreportSpec{ + cbcsubreporttitle="Equity" + ,cbcsubreportquery=journalEquityAccountQuery + ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportincreasestotal=False + } + ], cbctype = HistoricalBalance } diff --git a/hledger/Hledger/Cli/Commands/Cashflow.hs b/hledger/Hledger/Cli/Commands/Cashflow.hs index 9a9c129da..863f78fdc 100644 --- a/hledger/Hledger/Cli/Commands/Cashflow.hs +++ b/hledger/Hledger/Cli/Commands/Cashflow.hs @@ -30,9 +30,20 @@ This command displays a simple cashflow statement, showing changes in "cash" accounts. It assumes that these accounts are under a top-level `asset` account (case insensitive, plural forms also allowed) and do not contain `receivable` or `A/R` in their name. + +Note this report shows all account balances with normal positive sign +(like conventional financial statements, unlike balance/print/register) +(experimental). |], cbctitle = "Cashflow Statement", - cbcqueries = [("Cash flows", journalCashAccountQuery, Just NormallyPositive)], + cbcqueries = [ + CBCSubreportSpec{ + cbcsubreporttitle="Cash flows" + ,cbcsubreportquery=journalCashAccountQuery + ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportincreasestotal=True + } + ], cbctype = PeriodChange } diff --git a/hledger/Hledger/Cli/Commands/Incomestatement.hs b/hledger/Hledger/Cli/Commands/Incomestatement.hs index 9bc2b4d6c..dd820affe 100644 --- a/hledger/Hledger/Cli/Commands/Incomestatement.hs +++ b/hledger/Hledger/Cli/Commands/Incomestatement.hs @@ -27,11 +27,26 @@ This command displays a simple income statement, showing revenues and expenses during a period. It assumes that these accounts are under a top-level `revenue` or `income` or `expense` account (case insensitive, plural forms also allowed). + +Note this report shows all account balances with normal positive sign +(like conventional financial statements, unlike balance/print/register) +(experimental). |], cbctitle = "Income Statement", - cbcqueries = [ ("Revenues", journalIncomeAccountQuery, Just NormallyNegative), - ("Expenses", journalExpenseAccountQuery, Just NormallyPositive) - ], + cbcqueries = [ + CBCSubreportSpec{ + cbcsubreporttitle="Revenues" + ,cbcsubreportquery=journalIncomeAccountQuery + ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportincreasestotal=True + } + ,CBCSubreportSpec{ + cbcsubreporttitle="Expenses" + ,cbcsubreportquery=journalExpenseAccountQuery + ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportincreasestotal=False + } + ], cbctype = PeriodChange } diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 4c9d1e9c5..60d2db4ab 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -8,6 +8,7 @@ like balancesheet, cashflow, and incomestatement. module Hledger.Cli.CompoundBalanceCommand ( CompoundBalanceCommandSpec(..) + ,CBCSubreportSpec(..) ,compoundBalanceCommandMode ,compoundBalanceCommand ) where @@ -17,7 +18,6 @@ import Data.Maybe (fromMaybe) import Data.Monoid (Sum(..), (<>)) import qualified Data.Text import qualified Data.Text.Lazy as TL -import Data.Tuple.HT (uncurry3) import System.Console.CmdArgs.Explicit as C import Text.CSV import Lucid as L @@ -34,15 +34,29 @@ import Hledger.Cli.Utils (writeOutput) -- each with its own title and subtotals row, in a certain order, -- plus a grand totals row if there's more than one section. -- Examples are the balancesheet, cashflow and incomestatement commands. +-- +-- Compound balance reports do sign normalisation: they show all account balances +-- as normally positive, unlike the ordinary BalanceReport and most hledger commands +-- which show income/liability/equity balances as normally negative. +-- Each subreport specifies the normal sign of its amounts, and whether +-- it should be added to or subtracted from the grand total. +-- data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec { - cbcname :: String, -- ^ command name - cbcaliases :: [String], -- ^ command aliases - cbchelp :: String, -- ^ command line help - cbctitle :: String, -- ^ overall report title - cbcqueries :: [(String, Journal -> Query, Maybe NormalSign)], - -- ^ title, journal-parameterised query, and normal balance sign for each subreport. - -- The normal balance helps --sort-amount know how to sort negative amounts. - cbctype :: BalanceType -- ^ the type of "balance" this report shows (overrides command line flags) + cbcname :: String, -- ^ command name + cbcaliases :: [String], -- ^ command aliases + cbchelp :: String, -- ^ command line help + cbctitle :: String, -- ^ overall report title + cbcqueries :: [CBCSubreportSpec], -- ^ subreport details + cbctype :: BalanceType -- ^ the "balance" type (change, cumulative, historical) + -- this report shows (overrides command line flags) +} + +-- | Description of one subreport within a compound balance report. +data CBCSubreportSpec = CBCSubreportSpec { + cbcsubreporttitle :: String + ,cbcsubreportquery :: Journal -> Query + ,cbcsubreportnormalsign :: NormalSign + ,cbcsubreportincreasestotal :: Bool } -- | A compound balance report has: @@ -51,7 +65,9 @@ data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec { -- -- * the period (date span) of each column -- --- * one or more named multi balance reports, with columns corresponding to the above +-- * one or more named, normal-positive multi balance reports, +-- with columns corresponding to the above, and a flag indicating +-- whether they increased or decreased the overall totals -- -- * a list of overall totals for each column, and their grand total and average -- @@ -60,7 +76,7 @@ data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec { type CompoundBalanceReport = ( String , [DateSpan] - , [(String, MultiBalanceReport)] + , [(String, MultiBalanceReport, Bool)] , ([MixedAmount], MixedAmount, MixedAmount) ) @@ -145,15 +161,16 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd, -- single-column report -- TODO refactor, support output format like multi column + -- TODO support sign normalisation ? NoInterval -> do let -- concatenate the rendering and sum the totals from each subreport - (subreportstr, total) = - foldMap (uncurry3 (compoundBalanceCommandSingleColumnReport ropts' userq j)) cbcqueries + (output, total) = + foldMap (compoundBalanceCommandSingleColumnReport ropts' userq j) cbcqueries writeOutput opts $ unlines $ [title ++ "\n"] ++ - subreportstr ++ + output ++ if (no_total_ ropts' || cmd=="cashflow") then [] else @@ -170,35 +187,48 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd, _ -> do let -- make a CompoundBalanceReport - namedsubreports = - map (\(subreporttitle, subreportq, subreportnormalsign) -> - (subreporttitle, compoundBalanceSubreport ropts' userq j subreportq subreportnormalsign)) + subreports = + map (\CBCSubreportSpec{..} -> + (cbcsubreporttitle + ,mbrNormaliseSign cbcsubreportnormalsign $ -- <- convert normal-negative to normal-positive + compoundBalanceSubreport ropts' userq j cbcsubreportquery cbcsubreportnormalsign + -- ^ allow correct amount sorting + ,cbcsubreportincreasestotal + )) cbcqueries - subtotalrows = [coltotals | MultiBalanceReport (_,_,(coltotals,_,_)) <- map snd namedsubreports] + subtotalrows = + [(coltotals, increasesoveralltotal) + | (_, MultiBalanceReport (_,_,(coltotals,_,_)), increasesoveralltotal) <- subreports + ] + -- Sum the subreport totals by column. Handle these cases: + -- - no subreports + -- - empty subreports, having no subtotals (#588) + -- - subreports with a shorter subtotals row than the others overalltotals = case subtotalrows of [] -> ([], nullmixedamt, nullmixedamt) rs -> - -- Sum the subtotals in each column. - -- A subreport might be empty and have no subtotals, count those as zeros (#588). - -- Short subtotals rows are also implicitly padded with zeros, though that is not expected to happen. let - numcols = maximum $ map length rs -- depends on non-null ts - zeros = replicate numcols nullmixedamt - rs' = [take numcols $ as ++ repeat nullmixedamt | as <- rs] - coltotals = foldl' (zipWith (+)) zeros rs' + numcols = maximum $ map (length.fst) rs -- partial maximum is ok, rs is non-null + paddedsignedsubtotalrows = + [map (if increasesoveralltotal then id else negate) $ -- maybe flip the signs + take numcols $ as ++ repeat nullmixedamt -- pad short rows with zeros + | (as,increasesoveralltotal) <- rs + ] + coltotals = foldl' (zipWith (+)) zeros paddedsignedsubtotalrows -- sum the columns + where zeros = replicate numcols nullmixedamt grandtotal = sum coltotals grandavg | null coltotals = nullmixedamt | otherwise = grandtotal `divideMixedAmount` fromIntegral (length coltotals) in (coltotals, grandtotal, grandavg) colspans = - case namedsubreports of - (_, MultiBalanceReport (ds,_,_)):_ -> ds + case subreports of + (_, MultiBalanceReport (ds,_,_), _):_ -> ds [] -> [] cbr = (title ,colspans - ,namedsubreports + ,subreports ,overalltotals ) -- render appropriately @@ -208,6 +238,19 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd, "html" -> (++ "\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr _ -> compoundBalanceReportAsText ropts' cbr +-- | 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) + -- | Run one subreport for a compound balance command in single-column mode. -- Currently this returns the plain text rendering of the subreport, and its total. -- The latter is wrapped in a Sum for easy monoidal combining. @@ -215,30 +258,28 @@ compoundBalanceCommandSingleColumnReport :: ReportOpts -> Query -> Journal - -> String - -> (Journal -> Query) - -> Maybe NormalSign + -> CBCSubreportSpec -> ([String], Sum MixedAmount) -compoundBalanceCommandSingleColumnReport ropts userq j subreporttitle subreportqfn subreportnormalsign = +compoundBalanceCommandSingleColumnReport ropts userq j CBCSubreportSpec{..} = ([subreportstr], Sum total) where - q = And [subreportqfn j, userq] - ropts' = ropts{normalbalance_=subreportnormalsign} + q = And [cbcsubreportquery j, userq] + ropts' = ropts{normalbalance_=Just cbcsubreportnormalsign} r@(_,total) -- XXX For --historical/--cumulative, we must use singleBalanceReport; -- otherwise we use balanceReport -- because it supports eliding boring parents. -- See also compoundBalanceCommand, Balance.hs -> balance. | balancetype_ ropts `elem` [CumulativeChange, HistoricalBalance] = singleBalanceReport ropts' q j | otherwise = balanceReport ropts' q j - subreportstr = intercalate "\n" [subreporttitle <> ":", balanceReportAsText ropts r] + subreportstr = intercalate "\n" [cbcsubreporttitle <> ":", balanceReportAsText ropts r] -- | Run one subreport for a compound balance command in multi-column mode. -- This returns a MultiBalanceReport. -compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> Maybe NormalSign -> MultiBalanceReport +compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport compoundBalanceSubreport ropts userq j subreportqfn subreportnormalsign = r' where -- force --empty to ensure same columns in all sections - ropts' = ropts { empty_=True, normalbalance_=subreportnormalsign } + ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign } -- run the report q = And [subreportqfn j, userq] r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j @@ -286,7 +327,7 @@ compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, gra | otherwise = bigtable +====+ - row "Total" ( + row "Net:" ( coltotals ++ (if row_total_ ropts then [grandtotal] else []) ++ (if average_ ropts then [grandavg] else []) @@ -294,7 +335,7 @@ compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, gra -- | Convert a named multi balance report to a table suitable for -- concatenating with others to make a compound balance report table. - subreportAsTable ropts singlesubreport (title, r) = t + subreportAsTable ropts singlesubreport (title, r, _) = t where -- unless there's only one section, always show the subtotal row ropts' | singlesubreport = ropts @@ -325,7 +366,7 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand where singlesubreport = length subreports == 1 -- | Add a subreport title row and drop the heading row. - subreportAsCsv ropts singlesubreport (subreporttitle, multibalreport) = + subreportAsCsv ropts singlesubreport (subreporttitle, multibalreport, _) = padRow subreporttitle : tail (multiBalanceReportAsCsv ropts' multibalreport) where @@ -342,11 +383,11 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand (if average_ ropts then (1+) else id) $ maximum $ -- depends on non-null subreports map (\(MultiBalanceReport (amtcolheadings, _, _)) -> length amtcolheadings) $ - map snd subreports + map second3 subreports addtotals | no_total_ ropts || length subreports == 1 = id | otherwise = (++ - ["Grand total" : + ["Net:" : map showMixedAmountOneLineWithoutPrice ( coltotals ++ (if row_total_ ropts then [grandtotal] else []) @@ -374,8 +415,8 @@ compoundBalanceReportAsHtml ropts cbr = -- Make rows for a subreport: its title row, not the headings row, -- the data rows, any totals row, and a blank row for whitespace. - subreportrows :: (String, MultiBalanceReport) -> [Html ()] - subreportrows (subreporttitle, mbr) = + subreportrows :: (String, MultiBalanceReport, Bool) -> [Html ()] + subreportrows (subreporttitle, mbr, _increasestotal) = let (_,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr in @@ -387,7 +428,7 @@ compoundBalanceReportAsHtml ropts cbr = totalrows | no_total_ ropts || length subreports == 1 = [] | otherwise = [thRow $ - "Grand Total:" : + "Net:" : map showMixedAmountOneLineWithoutPrice ( coltotals ++ (if row_total_ ropts then [grandtotal] else []) diff --git a/tests/balancesheet/balancesheet.test b/tests/balancesheet/balancesheet.test index f3a44ff45..0c929aab0 100644 --- a/tests/balancesheet/balancesheet.test +++ b/tests/balancesheet/balancesheet.test @@ -1,4 +1,4 @@ -# 1. +# 1. trivial balance sheet hledger -f - balancesheet <<< 2016/1/1 @@ -23,7 +23,28 @@ Total: >>>2 >>>= 0 -# 2. +# 2. monthly balance sheet, normal positive sign +# old (arithmetic sign): +#Balance Sheet +# +# || 2008/01/31 2008/02/29 2008/03/31 2008/04/30 2008/05/31 2008/06/30 2008/07/31 2008/08/31 2008/09/30 2008/10/31 2008/11/30 2008/12/31 +#======================++================================================================================================================================================ +# Assets || +#----------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# assets:bank:checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0 +# assets:bank:saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 +# assets:cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2 +#----------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1 +#======================++================================================================================================================================================ +# Liabilities || +#----------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $1 +#----------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# || 0 0 0 0 0 0 0 0 0 0 0 $1 +#======================++================================================================================================================================================ +# Total || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 +# hledger -f sample.journal balancesheet -p 'monthly in 2008' >>> Balance Sheet @@ -40,15 +61,37 @@ Balance Sheet ======================++================================================================================================================================================ Liabilities || ----------------------++------------------------------------------------------------------------------------------------------------------------------------------------ - liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $1 + liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $-1 ----------------------++------------------------------------------------------------------------------------------------------------------------------------------------ - || 0 0 0 0 0 0 0 0 0 0 0 $1 + || 0 0 0 0 0 0 0 0 0 0 0 $-1 ======================++================================================================================================================================================ - Total || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 + Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 >>>=0 -# 3. +# 3. monthly balance sheet in tree mode +# old (arithmetic sign): +# || 2008/01/31 2008/02/29 2008/03/31 2008/04/30 2008/05/31 2008/06/30 2008/07/31 2008/08/31 2008/09/30 2008/10/31 2008/11/30 2008/12/31 +#==============++================================================================================================================================================ +# Assets || +#--------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# assets || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1 +# bank || $1 $1 $1 $1 $1 $2 $2 $2 $2 $2 $2 $1 +# checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0 +# saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 +# cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2 +#--------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1 +#==============++================================================================================================================================================ +# Liabilities || +#--------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# liabilities || 0 0 0 0 0 0 0 0 0 0 0 $1 +# debts || 0 0 0 0 0 0 0 0 0 0 0 $1 +#--------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# || 0 0 0 0 0 0 0 0 0 0 0 $1 +#==============++================================================================================================================================================ +# Total || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 +# hledger -f sample.journal balancesheet -p 'monthly in 2008' --tree >>> Balance Sheet @@ -67,64 +110,39 @@ Balance Sheet ==============++================================================================================================================================================ Liabilities || --------------++------------------------------------------------------------------------------------------------------------------------------------------------ - liabilities || 0 0 0 0 0 0 0 0 0 0 0 $1 - debts || 0 0 0 0 0 0 0 0 0 0 0 $1 + liabilities || 0 0 0 0 0 0 0 0 0 0 0 $-1 + debts || 0 0 0 0 0 0 0 0 0 0 0 $-1 --------------++------------------------------------------------------------------------------------------------------------------------------------------------ - || 0 0 0 0 0 0 0 0 0 0 0 $1 + || 0 0 0 0 0 0 0 0 0 0 0 $-1 ==============++================================================================================================================================================ - Total || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 + Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 >>>= 0 -# 4. -hledger -f sample.journal balancesheet -p 'monthly in 2008' -A +# 4. monthly balancesheet with average/total columns and without overall totals row +hledger -f sample.journal balancesheet -p 'monthly in 2008' -NAT >>> Balance Sheet - || 2008/01/31 2008/02/29 2008/03/31 2008/04/30 2008/05/31 2008/06/30 2008/07/31 2008/08/31 2008/09/30 2008/10/31 2008/11/30 2008/12/31 Average -======================++========================================================================================================================================================= - Assets || -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - assets:bank:checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0 $1 - assets:bank:saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 $1 - assets:cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2 $-1 -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1 0 -======================++========================================================================================================================================================= - Liabilities || -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $1 0 -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - || 0 0 0 0 0 0 0 0 0 0 0 $1 0 -======================++========================================================================================================================================================= - Total || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 0 + || 2008/01/31 2008/02/29 2008/03/31 2008/04/30 2008/05/31 2008/06/30 2008/07/31 2008/08/31 2008/09/30 2008/10/31 2008/11/30 2008/12/31 Total Average +======================++================================================================================================================================================================== + Assets || +----------------------++------------------------------------------------------------------------------------------------------------------------------------------------------------------ + assets:bank:checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0 $11 $1 + assets:bank:saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 $7 $1 + assets:cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2 $-14 $-1 +----------------------++------------------------------------------------------------------------------------------------------------------------------------------------------------------ + || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1 $4 0 +======================++================================================================================================================================================================== + Liabilities || +----------------------++------------------------------------------------------------------------------------------------------------------------------------------------------------------ + liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $-1 $-1 0 +----------------------++------------------------------------------------------------------------------------------------------------------------------------------------------------------ + || 0 0 0 0 0 0 0 0 0 0 0 $-1 $-1 0 >>>= 0 -# 5. -hledger -f sample.journal balancesheet -p 'monthly in 2008' -NT ->>> -Balance Sheet - - || 2008/01/31 2008/02/29 2008/03/31 2008/04/30 2008/05/31 2008/06/30 2008/07/31 2008/08/31 2008/09/30 2008/10/31 2008/11/30 2008/12/31 Total -======================++========================================================================================================================================================= - Assets || -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - assets:bank:checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0 $11 - assets:bank:saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 $7 - assets:cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2 $-14 -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1 $4 -======================++========================================================================================================================================================= - Liabilities || -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $1 $1 -----------------------++--------------------------------------------------------------------------------------------------------------------------------------------------------- - || 0 0 0 0 0 0 0 0 0 0 0 $1 $1 - ->>>= 0 - -# 6. Tree output still works, #565 +# 5. Tree output still works, #565 hledger -f- balancesheet <<< 2017/1/1 @@ -149,7 +167,7 @@ Total: >>>2 >>>=0 -# 7. Flat output still works, #552 +# 6. Flat output still works, #552 hledger -f- balancesheet --flat <<< 2017/1/1 @@ -173,7 +191,7 @@ Total: >>>2 >>>=0 -# 8. An empty section is does not disrupt the overall totals, #588 +# 7. An empty section is does not disrupt the overall totals, #588 hledger -f- balancesheet -YTA <<< 2017/1/1 @@ -194,7 +212,7 @@ Balance Sheet -------------++------------------------------ || =============++============================== - Total || $1 $1 $1 + Net: || $1 $1 $1 >>>2 >>>=0 @@ -221,7 +239,7 @@ Balance Sheet ─────────────╫──────────── ║ ═════════════╬════════════ - Total ║ 1 + Net: ║ 1 >>>2 >>>= 0 diff --git a/tests/incomestatement/incomestatement.test b/tests/incomestatement/incomestatement.test index 33cab9bd7..756bc189d 100644 --- a/tests/incomestatement/incomestatement.test +++ b/tests/incomestatement/incomestatement.test @@ -191,6 +191,27 @@ Total: >>>= 0 # 6. Multicolumn test +# old (arithmetic sign): +# Income Statement +# +# || 2008/01 2008/02 2008/03 2008/04 2008/05 2008/06 2008/07 2008/08 2008/09 2008/10 2008/11 2008/12 Total Average +# ===================++============================================================================================================================== +# Revenues || +# -------------------++------------------------------------------------------------------------------------------------------------------------------ +# income:gifts || 0 0 0 0 0 $-1 0 0 0 0 0 0 $-1 0 +# income:salary || $-1 0 0 0 0 0 0 0 0 0 0 0 $-1 0 +# -------------------++------------------------------------------------------------------------------------------------------------------------------ +# || $-1 0 0 0 0 $-1 0 0 0 0 0 0 $-2 0 +# ===================++============================================================================================================================== +# Expenses || +# -------------------++------------------------------------------------------------------------------------------------------------------------------ +# expenses:food || 0 0 0 0 0 $1 0 0 0 0 0 0 $1 0 +# expenses:supplies || 0 0 0 0 0 $1 0 0 0 0 0 0 $1 0 +# -------------------++------------------------------------------------------------------------------------------------------------------------------ +# || 0 0 0 0 0 $2 0 0 0 0 0 0 $2 0 +# ===================++============================================================================================================================== +# Total || $-1 0 0 0 0 $1 0 0 0 0 0 0 0 0 +# hledger -f sample.journal incomestatement -p 'monthly in 2008' -AT >>> Income Statement @@ -199,10 +220,10 @@ Income Statement ===================++============================================================================================================================== Revenues || -------------------++------------------------------------------------------------------------------------------------------------------------------ - income:gifts || 0 0 0 0 0 $-1 0 0 0 0 0 0 $-1 0 - income:salary || $-1 0 0 0 0 0 0 0 0 0 0 0 $-1 0 + income:gifts || 0 0 0 0 0 $1 0 0 0 0 0 0 $1 0 + income:salary || $1 0 0 0 0 0 0 0 0 0 0 0 $1 0 -------------------++------------------------------------------------------------------------------------------------------------------------------ - || $-1 0 0 0 0 $-1 0 0 0 0 0 0 $-2 0 + || $1 0 0 0 0 $1 0 0 0 0 0 0 $2 0 ===================++============================================================================================================================== Expenses || -------------------++------------------------------------------------------------------------------------------------------------------------------ @@ -211,11 +232,32 @@ Income Statement -------------------++------------------------------------------------------------------------------------------------------------------------------ || 0 0 0 0 0 $2 0 0 0 0 0 0 $2 0 ===================++============================================================================================================================== - Total || $-1 0 0 0 0 $1 0 0 0 0 0 0 0 0 + Net: || $1 0 0 0 0 $-1 0 0 0 0 0 0 0 0 >>>= 0 -# 6. Multicolumn test (historical) +# 7. Multicolumn test (historical) +# old (arithmetic sign): +# Income Statement (Historical Ending Balances) +# +# || 2008/01/31 2008/02/29 2008/03/31 2008/04/30 2008/05/31 2008/06/30 2008/07/31 2008/08/31 2008/09/30 2008/10/31 2008/11/30 2008/12/31 +# ===================++================================================================================================================================================ +# Revenues || +# -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# income:gifts || 0 0 0 0 0 $-1 $-1 $-1 $-1 $-1 $-1 $-1 +# income:salary || $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 +# -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# || $-1 $-1 $-1 $-1 $-1 $-2 $-2 $-2 $-2 $-2 $-2 $-2 +# ===================++================================================================================================================================================ +# Expenses || +# -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# expenses:food || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 +# expenses:supplies || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 +# -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ +# || 0 0 0 0 0 $2 $2 $2 $2 $2 $2 $2 +# ===================++================================================================================================================================================ +# Total || $-1 $-1 $-1 $-1 $-1 0 0 0 0 0 0 0 +# hledger -f sample.journal incomestatement -p 'monthly in 2008' --historical >>> Income Statement (Historical Ending Balances) @@ -224,10 +266,10 @@ Income Statement (Historical Ending Balances) ===================++================================================================================================================================================ Revenues || -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ - income:gifts || 0 0 0 0 0 $-1 $-1 $-1 $-1 $-1 $-1 $-1 - income:salary || $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 $-1 + income:gifts || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1 + income:salary || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ - || $-1 $-1 $-1 $-1 $-1 $-2 $-2 $-2 $-2 $-2 $-2 $-2 + || $1 $1 $1 $1 $1 $2 $2 $2 $2 $2 $2 $2 ===================++================================================================================================================================================ Expenses || -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ @@ -236,6 +278,6 @@ Income Statement (Historical Ending Balances) -------------------++------------------------------------------------------------------------------------------------------------------------------------------------ || 0 0 0 0 0 $2 $2 $2 $2 $2 $2 $2 ===================++================================================================================================================================================ - Total || $-1 $-1 $-1 $-1 $-1 0 0 0 0 0 0 0 + Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0 >>>= 0