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.
This commit is contained in:
Simon Michael 2018-01-15 17:58:14 -08:00
parent 3b2a9eaba4
commit 6b349e3123
9 changed files with 291 additions and 124 deletions

View File

@ -10,6 +10,8 @@ module Hledger.Reports.MultiBalanceReports (
MultiBalanceReportRow,
multiBalanceReport,
singleBalanceReport,
-- mbrNegate,
-- mbrNormaliseSign,
-- -- * Tests
tests_Hledger_Reports_MultiBalanceReport

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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