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:
		
							parent
							
								
									35e2e94228
								
							
						
					
					
						commit
						d9d92b3bf1
					
				| @ -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" $ | ||||||
|  | |||||||
| @ -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" $ | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
| } | } | ||||||
|  | |||||||
| @ -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 | ||||||
| } | } | ||||||
|  | |||||||
| @ -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 | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 | ||||||
| } | } | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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: | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user