bs/cf/is: always show a tabular report, even with no report interval

Previously, if you specified no report interval, the text output of
these commands was a simple report like the original balance command,
with amounts on the left and account names on the right. Also,
balances used arithmetic sign like the balance command.
Now it always draws a table, with account names in the left
column, and shows balances with normal-positive sign, consistent with
the multicolumn reports. Less code, fewer bugs.
This commit is contained in:
Simon Michael 2018-01-23 10:47:47 -08:00
parent 04d7d13be6
commit 6c60e4a97b
6 changed files with 229 additions and 275 deletions

View File

@ -313,7 +313,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
-- ie when there's a report interval, or when --historical or --cumulative -- ie when there's a report interval, or when --historical or --cumulative
-- are used (balanceReport doesn't handle those). -- are used (balanceReport doesn't handle those).
-- Otherwise prefer the older balanceReport since it can elide boring parents. -- Otherwise prefer the older balanceReport since it can elide boring parents.
-- See also compoundBalanceCommandSingleColumnReport, singleBalanceReport etc. -- See also singleBalanceReport etc.
case interval of case interval of
NoInterval -> do NoInterval -> do
let report let report

View File

@ -13,9 +13,8 @@ module Hledger.Cli.CompoundBalanceCommand (
,compoundBalanceCommand ,compoundBalanceCommand
) where ) where
import Data.List (intercalate, foldl') import Data.List (foldl')
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Monoid (Sum(..), (<>))
import qualified Data.Text as TS import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import System.Console.CmdArgs.Explicit as C import System.Console.CmdArgs.Explicit as C
@ -122,7 +121,7 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = (defCommandMode $ cb
-- | Generate a runnable command from a compound balance command specification. -- | Generate a runnable command from a compound balance command specification.
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd, reportopts_=ropts, rawopts_=rawopts} j = do compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts, rawopts_=rawopts} j = do
d <- getCurrentDay d <- getCurrentDay
let let
-- use the default balance type for this report, unless the user overrides -- use the default balance type for this report, unless the user overrides
@ -147,7 +146,6 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd,
-- are used in single column mode, since in that situation we will be using -- are used in single column mode, since in that situation we will be using
-- singleBalanceReport which does not support eliding boring parents, -- singleBalanceReport which does not support eliding boring parents,
-- and tree mode hides this.. or something.. -- and tree mode hides this.. or something..
-- see also compoundBalanceCommandSingleColumnReport, #565
ropts' ropts'
| not (flat_ ropts) && | not (flat_ ropts) &&
interval_ ropts==NoInterval && interval_ ropts==NoInterval &&
@ -158,86 +156,58 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd,
userq = queryFromOpts d ropts' userq = queryFromOpts d ropts'
format = outputFormatFromOpts opts format = outputFormatFromOpts opts
case interval_ ropts' of -- make a CompoundBalanceReport
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, 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 ->
let
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 subreports of
(_, MultiBalanceReport (ds,_,_), _):_ -> ds
[] -> []
cbr =
(title
,colspans
,subreports
,overalltotals
)
-- single-column report -- render appropriately
-- TODO refactor, support output format like multi column writeOutput opts $
-- TODO support sign normalisation ? case format of
NoInterval -> do "csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
let "html" -> (++ "\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
-- concatenate the rendering and sum the totals from each subreport _ -> compoundBalanceReportAsText ropts' cbr
(output, total) =
foldMap (compoundBalanceCommandSingleColumnReport ropts' userq j) cbcqueries
writeOutput opts $ unlines $
[title ++ "\n"] ++
output ++
if (no_total_ ropts' || cmd=="cashflow")
then []
else
[ "Total:"
, "--------------------"
, padLeftWide 20 $ showamt (getSum total)
, ""
]
where
showamt | color_ ropts' = cshowMixedAmountWithoutPrice
| otherwise = showMixedAmountWithoutPrice
-- multi-column report
_ -> do
let
-- make a CompoundBalanceReport
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, 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 ->
let
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 subreports of
(_, MultiBalanceReport (ds,_,_), _):_ -> ds
[] -> []
cbr =
(title
,colspans
,subreports
,overalltotals
)
-- render appropriately
writeOutput opts $
case format of
"csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
"html" -> (++ "\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
_ -> compoundBalanceReportAsText ropts' cbr
-- | Given a MultiBalanceReport and its normal balance sign, -- | Given a MultiBalanceReport and its normal balance sign,
-- if it is known to be normally negative, convert it to normally positive. -- if it is known to be normally negative, convert it to normally positive.
@ -252,28 +222,6 @@ mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) =
mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg) mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg)
mbrTotalsRowNegate (amts,tot,avg) = (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.
compoundBalanceCommandSingleColumnReport
:: ReportOpts
-> Query
-> Journal
-> CBCSubreportSpec
-> ([String], Sum MixedAmount)
compoundBalanceCommandSingleColumnReport ropts userq j CBCSubreportSpec{..} =
([subreportstr], Sum total)
where
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" [cbcsubreporttitle <> ":", balanceReportAsText ropts r]
-- | Run one subreport for a compound balance command in multi-column mode. -- | Run one subreport for a compound balance command in multi-column mode.
-- This returns a MultiBalanceReport. -- This returns a MultiBalanceReport.
compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport

View File

@ -7,18 +7,20 @@ hledger -f - balancesheet
>>> >>>
Balance Sheet 2016/01/01 Balance Sheet 2016/01/01
Assets: || 2016/01/01
1 assets =============++============
-------------------- Assets ||
1 -------------++------------
assets || 1
Liabilities: -------------++------------
-------------------- || 1
0 =============++============
Liabilities ||
Total: -------------++------------
-------------------- -------------++------------
1 ||
=============++============
Net: || 1
>>>2 >>>2
>>>= 0 >>>= 0
@ -150,19 +152,21 @@ hledger -f- balancesheet
>>> >>>
Balance Sheet 2017/01/01 Balance Sheet 2017/01/01
Assets: || 2017/01/01
1 assets =============++============
1 b Assets ||
-------------------- -------------++------------
1 assets || 1
b || 1
Liabilities: -------------++------------
-------------------- || 1
0 =============++============
Liabilities ||
Total: -------------++------------
-------------------- -------------++------------
1 ||
=============++============
Net: || 1
>>>2 >>>2
>>>=0 >>>=0
@ -175,18 +179,20 @@ hledger -f- balancesheet --flat
>>> >>>
Balance Sheet 2017/01/01 Balance Sheet 2017/01/01
Assets: || 2017/01/01
1 assets:b =============++============
-------------------- Assets ||
1 -------------++------------
assets:b || 1
Liabilities: -------------++------------
-------------------- || 1
0 =============++============
Liabilities ||
Total: -------------++------------
-------------------- -------------++------------
1 ||
=============++============
Net: || 1
>>>2 >>>2
>>>=0 >>>=0

View File

@ -7,10 +7,13 @@ hledger -f - cashflow
>>> >>>
Cashflow Statement 2016/01/01 Cashflow Statement 2016/01/01
Cash flows: || 2016/01/01
1 assets ============++============
-------------------- Cash flows ||
1 ------------++------------
assets || 1
------------++------------
|| 1
>>>2 >>>2
>>>= 0 >>>= 0
@ -40,10 +43,13 @@ hledger -f - cashflow -b 2016 -e 2017
>>> >>>
Cashflow Statement 2016 Cashflow Statement 2016
Cash flows: || 2016
$-40.00 assets:checking =================++=========
-------------------- Cash flows ||
$-40.00 -----------------++---------
assets:checking || $-40.00
-----------------++---------
|| $-40.00
>>>2 >>>2
>>>= 0 >>>= 0
@ -73,10 +79,13 @@ hledger -f - cashflow -b 2015 -e 2017
>>> >>>
Cashflow Statement 2015/01/01-2016/12/31 Cashflow Statement 2015/01/01-2016/12/31
Cash flows: || 2015/01/01-2016/12/31
$9,960.00 assets:checking =================++=======================
-------------------- Cash flows ||
$9,960.00 -----------------++-----------------------
assets:checking || $9,960.00
-----------------++-----------------------
|| $9,960.00
>>>2 >>>2
>>>= 0 >>>= 0
@ -106,10 +115,13 @@ hledger -f - cashflow -b 2015/11 -e 2015/12
>>> >>>
Cashflow Statement 2015/11 Cashflow Statement 2015/11
Cash flows: || 2015/11
$10,000.00 assets:checking =================++============
-------------------- Cash flows ||
$10,000.00 -----------------++------------
assets:checking || $10,000.00
-----------------++------------
|| $10,000.00
>>>2 >>>2
>>>= 0 >>>= 0
@ -139,9 +151,12 @@ hledger -f - cashflow -b 2016/10 -e 2016/11
>>> >>>
Cashflow Statement 2016/10 Cashflow Statement 2016/10
Cash flows: || 2016/10
-------------------- ============++=========
0 Cash flows ||
------------++---------
------------++---------
|| 0
>>>2 >>>2
>>>= 0 >>>= 0
@ -180,37 +195,9 @@ Cashflow Statement 2008 (Historical Ending Balances)
>>>= 0 >>>= 0
# 8. without -N/--no-total (single column) # 8. without -N/--no-total
hledger -f sample.journal cf hledger -f sample.journal cf
>>> >>>
Cashflow Statement 2008
Cash flows:
$-1 assets
$1 bank:saving
$-2 cash
--------------------
$-1
>>>2
>>>= 0
# 9. with -N (single column)
hledger -f sample.journal cf -N
>>>
Cashflow Statement 2008
Cash flows:
$-1 assets
$1 bank:saving
$-2 cash
>>>2
>>>= 0
# 10. without -N (multi column)
hledger -f sample.journal cf -Y
>>>
Cashflow Statement 2008 Cashflow Statement 2008
|| 2008 || 2008
@ -225,8 +212,8 @@ Cashflow Statement 2008
>>>2 >>>2
>>>= 0 >>>= 0
# 11. with -N (multi column) # 9. with -N
hledger -f sample.journal cf -Y -N hledger -f sample.journal cf -N
>>> >>>
Cashflow Statement 2008 Cashflow Statement 2008
@ -240,7 +227,7 @@ Cashflow Statement 2008
>>>2 >>>2
>>>= 0 >>>= 0
# 12. exclude fixed assets from cashflow # 10. exclude fixed assets from cashflow
hledger -f - cashflow hledger -f - cashflow
<<< <<<
2016/1/1 2016/1/1
@ -253,10 +240,13 @@ hledger -f - cashflow
>>> >>>
Cashflow Statement 2016/01/01 Cashflow Statement 2016/01/01
Cash flows: || 2016/01/01
1 assets ============++============
-------------------- Cash flows ||
1 ------------++------------
assets || 1
------------++------------
|| 1
>>>2 >>>2
>>>= 0 >>>= 0

View File

@ -3,20 +3,21 @@ hledger inc -f personal.journal -f business.journal
>>> >>>
Income Statement 2014/01/01-2014/01/02 Income Statement 2014/01/01-2014/01/02
Revenues: || 2014/01/01-2014/01/02
-------------------- ==========================++=======================
0 Revenues ||
--------------------------++-----------------------
Expenses: --------------------------++-----------------------
$2 expenses ||
$1 food ==========================++=======================
$1 office supplies Expenses ||
-------------------- --------------------------++-----------------------
$2 expenses:food || $1
expenses:office supplies || $1
Total: --------------------------++-----------------------
-------------------- || $2
$2 ==========================++=======================
Net: || $-2
>>>2 >>>2
>>>=0 >>>=0

View File

@ -7,18 +7,20 @@ hledger -f - incomestatement
>>> >>>
Income Statement 2016/01/01 Income Statement 2016/01/01
Revenues: || 2016/01/01
1 income ==========++============
-------------------- Revenues ||
1 ----------++------------
income || -1
Expenses: ----------++------------
-------------------- || -1
0 ==========++============
Expenses ||
Total: ----------++------------
-------------------- ----------++------------
1 ||
==========++============
Net: || -1
>>>2 >>>2
>>>= 0 >>>= 0
@ -48,19 +50,21 @@ hledger -f - incomestatement -b 2016 -e 2017
>>> >>>
Income Statement 2016 Income Statement 2016
Revenues: || 2016
$-10.00 revenue:clients:B ===================++=========
-------------------- Revenues ||
$-10.00 -------------------++---------
revenue:clients:B || $10.00
Expenses: -------------------++---------
$50.00 expense:hosting || $10.00
-------------------- ===================++=========
$50.00 Expenses ||
-------------------++---------
Total: expense:hosting || $50.00
-------------------- -------------------++---------
$40.00 || $50.00
===================++=========
Net: || $-40.00
>>>2 >>>2
>>>= 0 >>>= 0
@ -90,21 +94,22 @@ hledger -f - incomestatement -b 2015 -e 2017
>>> >>>
Income Statement 2015/01/01-2016/12/31 Income Statement 2015/01/01-2016/12/31
Revenues: || 2015/01/01-2016/12/31
$-10,010.00 revenue:clients ===================++=======================
$-10,000.00 A Revenues ||
$-10.00 B -------------------++-----------------------
-------------------- revenue:clients:A || $10,000.00
$-10,010.00 revenue:clients:B || $10.00
-------------------++-----------------------
Expenses: || $10,010.00
$50.00 expense:hosting ===================++=======================
-------------------- Expenses ||
$50.00 -------------------++-----------------------
expense:hosting || $50.00
Total: -------------------++-----------------------
-------------------- || $50.00
$-9,960.00 ===================++=======================
Net: || $9,960.00
>>>2 >>>2
>>>= 0 >>>= 0
@ -134,18 +139,20 @@ hledger -f - incomestatement -b 2015/10 -e 2015/11
>>> >>>
Income Statement 2015/10 Income Statement 2015/10
Revenues: || 2015/10
$-10,000.00 revenue:clients:A ===================++============
-------------------- Revenues ||
$-10,000.00 -------------------++------------
revenue:clients:A || $10,000.00
Expenses: -------------------++------------
-------------------- || $10,000.00
0 ===================++============
Expenses ||
Total: -------------------++------------
-------------------- -------------------++------------
$-10,000.00 ||
===================++============
Net: || $10,000.00
>>>2 >>>2
>>>= 0 >>>= 0
@ -175,17 +182,19 @@ hledger -f - incomestatement -b 2016/10 -e 2016/11
>>> >>>
Income Statement 2016/10 Income Statement 2016/10
Revenues: || 2016/10
-------------------- ==========++=========
0 Revenues ||
----------++---------
Expenses: ----------++---------
-------------------- || 0
0 ==========++=========
Expenses ||
Total: ----------++---------
-------------------- ----------++---------
0 || 0
==========++=========
Net: || 0
>>>2 >>>2
>>>= 0 >>>= 0