bs/bse/is: --sort-amount puts large liabilities/equities/incomes at top

Compound balance commands like these can now be aware of normal account
balance sign, and sort negative balances accordingly.

This also adds utility-ht as a dependency, only for the uncurry function
right now but it looks potentially useful to have.
This commit is contained in:
Simon Michael 2017-09-25 19:06:38 -10:00
parent 35e2e94228
commit d9d92b3bf1
10 changed files with 60 additions and 28 deletions

View File

@ -108,7 +108,9 @@ balanceReport opts q j = (items, total)
filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a))) filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a)))
prunezeros = if empty_ opts then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance) prunezeros = if empty_ opts then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance)
markboring = if no_elide_ opts then id else markBoringParentAccounts markboring = if no_elide_ opts then id else markBoringParentAccounts
maybesort = if sort_amount_ opts then sortBy (flip $ comparing balance) else id maybesort = if sort_amount_ opts then sortBy (maybeflip $ comparing balance) else id
where
maybeflip = if normalbalance_ opts == Just NormalPositive then flip else id
items = dbg1 "items" $ map (balanceReportItem opts q) accts' items = dbg1 "items" $ map (balanceReportItem opts q) accts'
total | not (flat_ opts) = dbg1 "total" $ sum [amt | (_,_,indent,amt) <- items, indent == 0] total | not (flat_ opts) = dbg1 "total" $ sum [amt | (_,_,indent,amt) <- items, indent == 0]
| otherwise = dbg1 "total" $ | otherwise = dbg1 "total" $

View File

@ -171,10 +171,7 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow
items :: [MultiBalanceReportRow] = items :: [MultiBalanceReportRow] =
dbg1 "items" $ dbg1 "items" $
(if sort_amount_ opts && accountlistmode_ opts /= ALTree (if sort_amount_ opts && accountlistmode_ opts /= ALTree
then sortBy (flip $ comparing $ then sortBy (maybeflip $ comparing sortfield)
-- sort by average when that is displayed, instead of total.
-- Usually equivalent, but perhaps not in future.
if average_ opts then sixth6 else fifth6)
else id) $ else id) $
[(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg) [(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg)
| (a,changes) <- acctBalChanges | (a,changes) <- acctBalChanges
@ -186,6 +183,13 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow
, let rowavg = averageMixedAmounts displayedBals , let rowavg = averageMixedAmounts displayedBals
, empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals , empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals
] ]
where
-- reverse the sort if doing a balance report on normally-negative accounts,
-- so eg a large negative income balance appears at top in income statement
maybeflip = if normalbalance_ opts == Just NormalPositive then flip else id
-- sort by average when that is displayed, instead of total.
-- Usually equivalent, but perhaps not in future (eg with --percent)
sortfield = if average_ opts then sixth6 else fifth6
totals :: [MixedAmount] = totals :: [MixedAmount] =
-- dbg1 "totals" $ -- dbg1 "totals" $

View File

@ -7,6 +7,7 @@ Options common to most hledger reports.
module Hledger.Reports.ReportOptions ( module Hledger.Reports.ReportOptions (
ReportOpts(..), ReportOpts(..),
NormalBalance(..),
BalanceType(..), BalanceType(..),
AccountListMode(..), AccountListMode(..),
FormatStr, FormatStr,
@ -70,9 +71,10 @@ data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typ
instance Default AccountListMode where def = ALDefault instance Default AccountListMode where def = ALDefault
-- | Standard options for customising report filtering and output, -- | Standard options for customising report filtering and output.
-- corresponding to hledger's command-line options and query language -- Most of these correspond to standard hledger command-line options
-- arguments. Used in hledger-lib and above. -- or query arguments, but not all. Some are used only by certain
-- commands, as noted below.
data ReportOpts = ReportOpts { data ReportOpts = ReportOpts {
period_ :: Period period_ :: Period
,interval_ :: Interval ,interval_ :: Interval
@ -86,10 +88,10 @@ data ReportOpts = ReportOpts {
,real_ :: Bool ,real_ :: Bool
,format_ :: Maybe FormatStr ,format_ :: Maybe FormatStr
,query_ :: String -- all arguments, as a string ,query_ :: String -- all arguments, as a string
-- register only -- register command only
,average_ :: Bool ,average_ :: Bool
,related_ :: Bool ,related_ :: Bool
-- balance only -- balance-type commands only
,balancetype_ :: BalanceType ,balancetype_ :: BalanceType
,accountlistmode_ :: AccountListMode ,accountlistmode_ :: AccountListMode
,drop_ :: Int ,drop_ :: Int
@ -98,6 +100,10 @@ data ReportOpts = ReportOpts {
,value_ :: Bool ,value_ :: Bool
,pretty_tables_ :: Bool ,pretty_tables_ :: Bool
,sort_amount_ :: Bool ,sort_amount_ :: Bool
,normalbalance_ :: Maybe NormalBalance
-- ^ when running a balance report on accounts of the same normal balance type,
-- eg in the income section of an income statement, this helps --sort-amount know
-- how to sort negative numbers.
,color_ :: Bool ,color_ :: Bool
} deriving (Show, Data, Typeable) } deriving (Show, Data, Typeable)
@ -128,6 +134,16 @@ defreportopts = ReportOpts
def def
def def
def def
def
-- | Whether an account's balance is normally a positive number (in accounting terms,
-- normally a debit balance), as for asset and expense accounts, or a negative number
-- (in accounting terms, normally a credit balance), as for liability, equity and
-- income accounts. Cf https://en.wikipedia.org/wiki/Normal_balance .
data NormalBalance =
NormalPositive -- ^ normally debit - assets, expenses...
| NormalNegative -- ^ normally credit - liabilities, equity, income...
deriving (Show, Data, Eq)
rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts = checkReportOpts <$> do rawOptsToReportOpts rawopts = checkReportOpts <$> do

View File

@ -29,8 +29,8 @@ It assumes that these accounts are under a top-level `asset` or `liability`
account (case insensitive, plural forms also allowed). account (case insensitive, plural forms also allowed).
|], |],
cbctitle = "Balance Sheet", cbctitle = "Balance Sheet",
cbcqueries = [ ("Assets" , journalAssetAccountQuery), cbcqueries = [ ("Assets" , journalAssetAccountQuery, Just NormalPositive),
("Liabilities", journalLiabilityAccountQuery) ("Liabilities", journalLiabilityAccountQuery, Just NormalNegative)
], ],
cbctype = HistoricalBalance cbctype = HistoricalBalance
} }

View File

@ -26,9 +26,9 @@ It assumes that these accounts are under a top-level `asset`, `liability` and `e
account (plural forms also allowed). account (plural forms also allowed).
|], |],
cbctitle = "Balance Sheet With Equity", cbctitle = "Balance Sheet With Equity",
cbcqueries = [ ("Assets" , journalAssetAccountQuery), cbcqueries = [("Assets", journalAssetAccountQuery, Just NormalPositive),
("Liabilities", journalLiabilityAccountQuery), ("Liabilities", journalLiabilityAccountQuery, Just NormalNegative),
("Equity", journalEquityAccountQuery) ("Equity", journalEquityAccountQuery, Just NormalNegative)
], ],
cbctype = HistoricalBalance cbctype = HistoricalBalance
} }

View File

@ -32,7 +32,7 @@ in "cash" accounts. It assumes that these accounts are under a top-level
contain `receivable` or `A/R` in their name. contain `receivable` or `A/R` in their name.
|], |],
cbctitle = "Cashflow Statement", cbctitle = "Cashflow Statement",
cbcqueries = [("Cash flows", journalCashAccountQuery)], cbcqueries = [("Cash flows", journalCashAccountQuery, Just NormalPositive)],
cbctype = PeriodChange cbctype = PeriodChange
} }

View File

@ -29,8 +29,8 @@ top-level `revenue` or `income` or `expense` account (case insensitive,
plural forms also allowed). plural forms also allowed).
|], |],
cbctitle = "Income Statement", cbctitle = "Income Statement",
cbcqueries = [ ("Revenues", journalIncomeAccountQuery), cbcqueries = [ ("Revenues", journalIncomeAccountQuery, Just NormalNegative),
("Expenses", journalExpenseAccountQuery) ("Expenses", journalExpenseAccountQuery, Just NormalPositive)
], ],
cbctype = PeriodChange cbctype = PeriodChange
} }

View File

@ -15,6 +15,7 @@ module Hledger.Cli.CompoundBalanceCommand (
import Data.List (intercalate, foldl') import Data.List (intercalate, foldl')
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Monoid (Sum(..), (<>)) import Data.Monoid (Sum(..), (<>))
import Data.Tuple.HT (uncurry3)
import System.Console.CmdArgs.Explicit as C import System.Console.CmdArgs.Explicit as C
import Text.CSV import Text.CSV
import Text.Tabular as T import Text.Tabular as T
@ -35,7 +36,9 @@ data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
cbcaliases :: [String], -- ^ command aliases cbcaliases :: [String], -- ^ command aliases
cbchelp :: String, -- ^ command line help cbchelp :: String, -- ^ command line help
cbctitle :: String, -- ^ overall report title cbctitle :: String, -- ^ overall report title
cbcqueries :: [(String, Journal -> Query)], -- ^ title and (journal-parameterised) query for each subreport cbcqueries :: [(String, Journal -> Query, Maybe NormalBalance)],
-- ^ title, journal-parameterised query, and expected normal balance 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) cbctype :: BalanceType -- ^ the type of "balance" this report shows (overrides command line flags)
} }
@ -123,7 +126,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd,
let let
-- concatenate the rendering and sum the totals from each subreport -- concatenate the rendering and sum the totals from each subreport
(subreportstr, total) = (subreportstr, total) =
foldMap (uncurry (compoundBalanceCommandSingleColumnReport ropts' userq j)) cbcqueries foldMap (uncurry3 (compoundBalanceCommandSingleColumnReport ropts' userq j)) cbcqueries
writeOutput opts $ unlines $ writeOutput opts $ unlines $
[title ++ "\n"] ++ [title ++ "\n"] ++
@ -145,8 +148,8 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd,
let let
-- make a CompoundBalanceReport -- make a CompoundBalanceReport
namedsubreports = namedsubreports =
map (\(subreporttitle, subreportq) -> map (\(subreporttitle, subreportq, subreportnormalsign) ->
(subreporttitle, compoundBalanceSubreport ropts' userq j subreportq)) (subreporttitle, compoundBalanceSubreport ropts' userq j subreportq subreportnormalsign))
cbcqueries cbcqueries
subtotalrows = [coltotals | MultiBalanceReport (_,_,(coltotals,_,_)) <- map snd namedsubreports] subtotalrows = [coltotals | MultiBalanceReport (_,_,(coltotals,_,_)) <- map snd namedsubreports]
overalltotals = case subtotalrows of overalltotals = case subtotalrows of
@ -185,17 +188,19 @@ compoundBalanceCommandSingleColumnReport
-> Journal -> Journal
-> String -> String
-> (Journal -> Query) -> (Journal -> Query)
-> Maybe NormalBalance
-> ([String], Sum MixedAmount) -> ([String], Sum MixedAmount)
compoundBalanceCommandSingleColumnReport ropts userq j subreporttitle subreportqfn = compoundBalanceCommandSingleColumnReport ropts userq j subreporttitle subreportqfn subreportnormalsign =
([subreportstr], Sum total) ([subreportstr], Sum total)
where where
q = And [subreportqfn j, userq] q = And [subreportqfn j, userq]
ropts' = ropts{normalbalance_=subreportnormalsign}
r@(_,total) r@(_,total)
-- XXX For --historical/--cumulative, we must use singleBalanceReport; -- XXX For --historical/--cumulative, we must use singleBalanceReport;
-- otherwise we use balanceReport -- because it supports eliding boring parents. -- otherwise we use balanceReport -- because it supports eliding boring parents.
-- See also compoundBalanceCommand, Balance.hs -> balance. -- See also compoundBalanceCommand, Balance.hs -> balance.
| balancetype_ ropts `elem` [CumulativeChange, HistoricalBalance] = singleBalanceReport ropts q j | balancetype_ ropts `elem` [CumulativeChange, HistoricalBalance] = singleBalanceReport ropts' q j
| otherwise = balanceReport ropts q j | otherwise = balanceReport ropts' q j
subreportstr = intercalate "\n" [subreporttitle <> ":", balanceReportAsText ropts r] subreportstr = intercalate "\n" [subreporttitle <> ":", balanceReportAsText ropts r]
-- | A compound balance report has: -- | A compound balance report has:
@ -216,11 +221,11 @@ type CompoundBalanceReport =
-- | 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) -> MultiBalanceReport compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> Maybe NormalBalance -> MultiBalanceReport
compoundBalanceSubreport ropts userq j subreportqfn = r' compoundBalanceSubreport ropts userq j subreportqfn subreportnormalsign = r'
where where
-- force --empty to ensure same columns in all sections -- force --empty to ensure same columns in all sections
ropts' = ropts { empty_ = True } ropts' = ropts { empty_=True, normalbalance_=subreportnormalsign }
-- run the report -- run the report
q = And [subreportqfn j, userq] q = And [subreportqfn j, userq]
r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j

View File

@ -90,6 +90,7 @@ library
, temporary , temporary
, tabular >=0.2 && <0.3 , tabular >=0.2 && <0.3
, time >=1.5 , time >=1.5
, utility-ht >= 0.0.13
, hledger-lib >= 1.3.99 && < 1.4 , hledger-lib >= 1.3.99 && < 1.4
, bytestring , bytestring
, containers , containers
@ -170,6 +171,7 @@ executable hledger
, temporary , temporary
, tabular >=0.2 && <0.3 , tabular >=0.2 && <0.3
, time >=1.5 , time >=1.5
, utility-ht >= 0.0.13
, hledger-lib >= 1.3.99 && < 1.4 , hledger-lib >= 1.3.99 && < 1.4
, hledger , hledger
, bytestring , bytestring
@ -218,6 +220,7 @@ test-suite test
, temporary , temporary
, tabular >=0.2 && <0.3 , tabular >=0.2 && <0.3
, time >=1.5 , time >=1.5
, utility-ht >= 0.0.13
, hledger-lib >= 1.3.99 && < 1.4 , hledger-lib >= 1.3.99 && < 1.4
, hledger , hledger
, bytestring , bytestring
@ -265,6 +268,7 @@ benchmark bench
, temporary , temporary
, tabular >=0.2 && <0.3 , tabular >=0.2 && <0.3
, time >=1.5 , time >=1.5
, utility-ht >= 0.0.13
, hledger-lib >= 1.3.99 && < 1.4 , hledger-lib >= 1.3.99 && < 1.4
, hledger , hledger
, criterion , criterion

View File

@ -86,6 +86,7 @@ dependencies:
- temporary - temporary
- tabular >=0.2 && <0.3 - tabular >=0.2 && <0.3
- time >=1.5 - time >=1.5
- utility-ht >= 0.0.13
- hledger-lib >= 1.3.99 && < 1.4 - hledger-lib >= 1.3.99 && < 1.4
when: when: