lib: Generalise CBCSubreportSpec to allow more subreport control.

2020-09-23 11:51:40 +10:00 · 2020-09-23 11:51:40 +10:00 · affc8d10f2
commit affc8d10f2
parent 6e65d4e071
7 changed files with 39 additions and 36 deletions
--- 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
--- 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
  }

--- 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
     }
    ],
--- 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
     }
    ],
--- 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
     }
    ],
--- 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
     }
    ],
--- 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