From affc8d10f2324ea1459df817bb7e88ccd6144a31 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 23 Sep 2020 11:51:40 +1000 Subject: [PATCH] lib: Generalise CBCSubreportSpec to allow more subreport control. --- .../Hledger/Reports/MultiBalanceReport.hs | 21 +++++++++---------- hledger-lib/Hledger/Reports/ReportTypes.hs | 14 +++++-------- hledger/Hledger/Cli/Commands/Balancesheet.hs | 6 ++++-- .../Cli/Commands/Balancesheetequity.hs | 9 +++++--- hledger/Hledger/Cli/Commands/Cashflow.hs | 3 ++- .../Hledger/Cli/Commands/Incomestatement.hs | 6 ++++-- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 16 +++++++------- 7 files changed, 39 insertions(+), 36 deletions(-) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 30dd6df2a..0f9c4d93e 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -16,7 +16,6 @@ module Hledger.Reports.MultiBalanceReport ( multiBalanceReport, multiBalanceReportWith, - CompoundBalanceReport, compoundBalanceReport, compoundBalanceReportWith, @@ -86,7 +85,6 @@ import Hledger.Reports.ReportTypes type MultiBalanceReport = PeriodicReport DisplayName MixedAmount type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount -type CompoundBalanceReport = CompoundPeriodicReport DisplayName MixedAmount -- type alias just to remind us which AccountNames might be depth-clipped, below. type ClippedAccountName = AccountName @@ -131,14 +129,15 @@ multiBalanceReportWith rspec' j priceoracle = report -- | Generate a compound balance report from a list of CBCSubreportSpec. This -- shares postings between the subreports. -compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec] - -> CompoundBalanceReport +compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec a] + -> CompoundPeriodicReport a MixedAmount compoundBalanceReport rspec j = compoundBalanceReportWith rspec j (journalPriceOracle infer j) where infer = infer_value_ $ rsOpts rspec -- | A helper for compoundBalanceReport, similar to multiBalanceReportWith. compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle - -> [CBCSubreportSpec] -> CompoundBalanceReport + -> [CBCSubreportSpec a] + -> CompoundPeriodicReport a MixedAmount compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr where -- Queries, report/column dates. @@ -160,16 +159,16 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr generateSubreport CBCSubreportSpec{..} = ( cbcsubreporttitle -- Postprocess the report, negating balances and taking percentages if needed - , prNormaliseSign cbcsubreportnormalsign $ - generateMultiBalanceReport rspec' j valuation colspans colps' startbals' + , cbcsubreporttransform $ + generateMultiBalanceReport rspec{rsOpts=ropts} j valuation colspans colps' startbals' , cbcsubreportincreasestotal ) where - rspec' = rspec{rsOpts=ropts} - ropts = (rsOpts rspec){normalbalance_=Just cbcsubreportnormalsign} -- Filter the column postings according to each subreport - colps' = filter (matchesPosting $ cbcsubreportquery j) <$> colps - startbals' = HM.filterWithKey (\k _ -> matchesAccount (cbcsubreportquery j) k) startbals + colps' = filter (matchesPosting q) <$> colps + startbals' = HM.filterWithKey (\k _ -> matchesAccount q k) startbals + ropts = cbcsubreportoptions $ rsOpts rspec + q = cbcsubreportquery j -- Sum the subreport totals by column. Handle these cases: -- - no subreports diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 8ceb45742..9b6508f21 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -17,7 +17,6 @@ module Hledger.Reports.ReportTypes , Average , periodicReportSpan -, prNormaliseSign , prMapName , prMapMaybeName @@ -40,8 +39,10 @@ import Data.Maybe (mapMaybe) import Data.Semigroup (Semigroup(..)) #endif import GHC.Generics (Generic) + import Hledger.Data import Hledger.Query (Query) +import Hledger.Reports.ReportOptions (ReportOpts) type Percentage = Decimal @@ -109,12 +110,6 @@ periodicReportSpan :: PeriodicReport a b -> DateSpan periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) --- | Given a PeriodicReport and its normal balance sign, --- if it is known to be normally negative, convert it to normally positive. -prNormaliseSign :: Num b => NormalSign -> PeriodicReport a b -> PeriodicReport a b -prNormaliseSign NormallyNegative = fmap negate -prNormaliseSign NormallyPositive = id - -- | Map a function over the row names. prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c prMapName f report = report{prRows = map (prrMapName f) $ prRows report} @@ -157,10 +152,11 @@ data CompoundPeriodicReport a b = CompoundPeriodicReport -- | Description of one subreport within a compound balance report. -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib. -data CBCSubreportSpec = CBCSubreportSpec +data CBCSubreportSpec a = CBCSubreportSpec { cbcsubreporttitle :: String , cbcsubreportquery :: Journal -> Query - , cbcsubreportnormalsign :: NormalSign + , cbcsubreportoptions :: ReportOpts -> ReportOpts + , cbcsubreporttransform :: PeriodicReport DisplayName MixedAmount -> PeriodicReport a MixedAmount , cbcsubreportincreasestotal :: Bool } diff --git a/hledger/Hledger/Cli/Commands/Balancesheet.hs b/hledger/Hledger/Cli/Commands/Balancesheet.hs index dc618930c..cb5a42d1a 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheet.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheet.hs @@ -24,13 +24,15 @@ balancesheetSpec = CompoundBalanceCommandSpec { CBCSubreportSpec{ cbcsubreporttitle="Assets" ,cbcsubreportquery=journalAssetAccountQuery - ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) + ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=True } ,CBCSubreportSpec{ cbcsubreporttitle="Liabilities" ,cbcsubreportquery=journalLiabilityAccountQuery - ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) + ,cbcsubreporttransform=fmap negate ,cbcsubreportincreasestotal=False } ], diff --git a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs index f7d359691..0cacf504a 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs @@ -24,19 +24,22 @@ balancesheetequitySpec = CompoundBalanceCommandSpec { CBCSubreportSpec{ cbcsubreporttitle="Assets" ,cbcsubreportquery=journalAssetAccountQuery - ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) + ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=True } ,CBCSubreportSpec{ cbcsubreporttitle="Liabilities" ,cbcsubreportquery=journalLiabilityAccountQuery - ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) + ,cbcsubreporttransform=fmap negate ,cbcsubreportincreasestotal=False } ,CBCSubreportSpec{ cbcsubreporttitle="Equity" ,cbcsubreportquery=journalEquityAccountQuery - ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) + ,cbcsubreporttransform=fmap negate ,cbcsubreportincreasestotal=False } ], diff --git a/hledger/Hledger/Cli/Commands/Cashflow.hs b/hledger/Hledger/Cli/Commands/Cashflow.hs index 3cabe61af..3e87b3546 100644 --- a/hledger/Hledger/Cli/Commands/Cashflow.hs +++ b/hledger/Hledger/Cli/Commands/Cashflow.hs @@ -27,7 +27,8 @@ cashflowSpec = CompoundBalanceCommandSpec { CBCSubreportSpec{ cbcsubreporttitle="Cash flows" ,cbcsubreportquery=journalCashAccountQuery - ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_= Just NormallyPositive}) + ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=True } ], diff --git a/hledger/Hledger/Cli/Commands/Incomestatement.hs b/hledger/Hledger/Cli/Commands/Incomestatement.hs index c7706e2ef..c6e7a14cb 100644 --- a/hledger/Hledger/Cli/Commands/Incomestatement.hs +++ b/hledger/Hledger/Cli/Commands/Incomestatement.hs @@ -23,13 +23,15 @@ incomestatementSpec = CompoundBalanceCommandSpec { CBCSubreportSpec{ cbcsubreporttitle="Revenues" ,cbcsubreportquery=journalRevenueAccountQuery - ,cbcsubreportnormalsign=NormallyNegative + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) + ,cbcsubreporttransform=fmap negate ,cbcsubreportincreasestotal=True } ,CBCSubreportSpec{ cbcsubreporttitle="Expenses" ,cbcsubreportquery=journalExpenseAccountQuery - ,cbcsubreportnormalsign=NormallyPositive + ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) + ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=False } ], diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 08428b538..1fab250ed 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -41,11 +41,11 @@ import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutput) -- it should be added to or subtracted from the grand total. -- data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec { - cbcdoc :: CommandDoc, -- ^ the command's name(s) and documentation - cbctitle :: String, -- ^ overall report title - cbcqueries :: [CBCSubreportSpec], -- ^ subreport details - cbctype :: BalanceType -- ^ the "balance" type (change, cumulative, historical) - -- this report shows (overrides command line flags) + cbcdoc :: CommandDoc, -- ^ the command's name(s) and documentation + cbctitle :: String, -- ^ overall report title + cbcqueries :: [CBCSubreportSpec DisplayName], -- ^ subreport details + cbctype :: BalanceType -- ^ the "balance" type (change, cumulative, historical) + -- this report shows (overrides command line flags) } -- | Generate a cmdargs option-parsing mode from a compound balance command @@ -186,7 +186,7 @@ Balance Sheet Total || 1 1 1 -} -compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String +compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> String compoundBalanceReportAsText ropts (CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) = title ++ "\n\n" ++ @@ -225,7 +225,7 @@ concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') = -- Subreports' CSV is concatenated, with the headings rows replaced by a -- subreport title row, and an overall title row, one headings row, and an -- optional overall totals row is added. -compoundBalanceReportAsCsv :: ReportOpts -> CompoundBalanceReport -> CSV +compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) = addtotals $ padRow title : @@ -262,7 +262,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor ]) -- | Render a compound balance report as HTML. -compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html () +compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> Html () compoundBalanceReportAsHtml ropts cbr = let CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr