lib: Generalise CBCSubreportSpec to allow more subreport control.
This commit is contained in:
parent
6e65d4e071
commit
affc8d10f2
@ -16,7 +16,6 @@ module Hledger.Reports.MultiBalanceReport (
|
|||||||
multiBalanceReport,
|
multiBalanceReport,
|
||||||
multiBalanceReportWith,
|
multiBalanceReportWith,
|
||||||
|
|
||||||
CompoundBalanceReport,
|
|
||||||
compoundBalanceReport,
|
compoundBalanceReport,
|
||||||
compoundBalanceReportWith,
|
compoundBalanceReportWith,
|
||||||
|
|
||||||
@ -86,7 +85,6 @@ import Hledger.Reports.ReportTypes
|
|||||||
|
|
||||||
type MultiBalanceReport = PeriodicReport DisplayName MixedAmount
|
type MultiBalanceReport = PeriodicReport DisplayName MixedAmount
|
||||||
type MultiBalanceReportRow = PeriodicReportRow 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 alias just to remind us which AccountNames might be depth-clipped, below.
|
||||||
type ClippedAccountName = AccountName
|
type ClippedAccountName = AccountName
|
||||||
@ -131,14 +129,15 @@ multiBalanceReportWith rspec' j priceoracle = report
|
|||||||
|
|
||||||
-- | Generate a compound balance report from a list of CBCSubreportSpec. This
|
-- | Generate a compound balance report from a list of CBCSubreportSpec. This
|
||||||
-- shares postings between the subreports.
|
-- shares postings between the subreports.
|
||||||
compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec]
|
compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec a]
|
||||||
-> CompoundBalanceReport
|
-> CompoundPeriodicReport a MixedAmount
|
||||||
compoundBalanceReport rspec j = compoundBalanceReportWith rspec j (journalPriceOracle infer j)
|
compoundBalanceReport rspec j = compoundBalanceReportWith rspec j (journalPriceOracle infer j)
|
||||||
where infer = infer_value_ $ rsOpts rspec
|
where infer = infer_value_ $ rsOpts rspec
|
||||||
|
|
||||||
-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
|
-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
|
||||||
compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
|
compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
|
||||||
-> [CBCSubreportSpec] -> CompoundBalanceReport
|
-> [CBCSubreportSpec a]
|
||||||
|
-> CompoundPeriodicReport a MixedAmount
|
||||||
compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
|
compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
|
||||||
where
|
where
|
||||||
-- Queries, report/column dates.
|
-- Queries, report/column dates.
|
||||||
@ -160,16 +159,16 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
|
|||||||
generateSubreport CBCSubreportSpec{..} =
|
generateSubreport CBCSubreportSpec{..} =
|
||||||
( cbcsubreporttitle
|
( cbcsubreporttitle
|
||||||
-- Postprocess the report, negating balances and taking percentages if needed
|
-- Postprocess the report, negating balances and taking percentages if needed
|
||||||
, prNormaliseSign cbcsubreportnormalsign $
|
, cbcsubreporttransform $
|
||||||
generateMultiBalanceReport rspec' j valuation colspans colps' startbals'
|
generateMultiBalanceReport rspec{rsOpts=ropts} j valuation colspans colps' startbals'
|
||||||
, cbcsubreportincreasestotal
|
, cbcsubreportincreasestotal
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
rspec' = rspec{rsOpts=ropts}
|
|
||||||
ropts = (rsOpts rspec){normalbalance_=Just cbcsubreportnormalsign}
|
|
||||||
-- Filter the column postings according to each subreport
|
-- Filter the column postings according to each subreport
|
||||||
colps' = filter (matchesPosting $ cbcsubreportquery j) <$> colps
|
colps' = filter (matchesPosting q) <$> colps
|
||||||
startbals' = HM.filterWithKey (\k _ -> matchesAccount (cbcsubreportquery j) k) startbals
|
startbals' = HM.filterWithKey (\k _ -> matchesAccount q k) startbals
|
||||||
|
ropts = cbcsubreportoptions $ rsOpts rspec
|
||||||
|
q = cbcsubreportquery j
|
||||||
|
|
||||||
-- Sum the subreport totals by column. Handle these cases:
|
-- Sum the subreport totals by column. Handle these cases:
|
||||||
-- - no subreports
|
-- - no subreports
|
||||||
|
|||||||
@ -17,7 +17,6 @@ module Hledger.Reports.ReportTypes
|
|||||||
, Average
|
, Average
|
||||||
|
|
||||||
, periodicReportSpan
|
, periodicReportSpan
|
||||||
, prNormaliseSign
|
|
||||||
, prMapName
|
, prMapName
|
||||||
, prMapMaybeName
|
, prMapMaybeName
|
||||||
|
|
||||||
@ -40,8 +39,10 @@ import Data.Maybe (mapMaybe)
|
|||||||
import Data.Semigroup (Semigroup(..))
|
import Data.Semigroup (Semigroup(..))
|
||||||
#endif
|
#endif
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Query (Query)
|
import Hledger.Query (Query)
|
||||||
|
import Hledger.Reports.ReportOptions (ReportOpts)
|
||||||
|
|
||||||
type Percentage = Decimal
|
type Percentage = Decimal
|
||||||
|
|
||||||
@ -109,12 +110,6 @@ periodicReportSpan :: PeriodicReport a b -> DateSpan
|
|||||||
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
|
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
|
||||||
periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
|
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.
|
-- | Map a function over the row names.
|
||||||
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
|
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
|
||||||
prMapName f report = report{prRows = map (prrMapName f) $ prRows report}
|
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.
|
-- | Description of one subreport within a compound balance report.
|
||||||
-- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib.
|
-- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib.
|
||||||
data CBCSubreportSpec = CBCSubreportSpec
|
data CBCSubreportSpec a = CBCSubreportSpec
|
||||||
{ cbcsubreporttitle :: String
|
{ cbcsubreporttitle :: String
|
||||||
, cbcsubreportquery :: Journal -> Query
|
, cbcsubreportquery :: Journal -> Query
|
||||||
, cbcsubreportnormalsign :: NormalSign
|
, cbcsubreportoptions :: ReportOpts -> ReportOpts
|
||||||
|
, cbcsubreporttransform :: PeriodicReport DisplayName MixedAmount -> PeriodicReport a MixedAmount
|
||||||
, cbcsubreportincreasestotal :: Bool
|
, cbcsubreportincreasestotal :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@ -24,13 +24,15 @@ balancesheetSpec = CompoundBalanceCommandSpec {
|
|||||||
CBCSubreportSpec{
|
CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Assets"
|
cbcsubreporttitle="Assets"
|
||||||
,cbcsubreportquery=journalAssetAccountQuery
|
,cbcsubreportquery=journalAssetAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyPositive
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive})
|
||||||
|
,cbcsubreporttransform=id
|
||||||
,cbcsubreportincreasestotal=True
|
,cbcsubreportincreasestotal=True
|
||||||
}
|
}
|
||||||
,CBCSubreportSpec{
|
,CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Liabilities"
|
cbcsubreporttitle="Liabilities"
|
||||||
,cbcsubreportquery=journalLiabilityAccountQuery
|
,cbcsubreportquery=journalLiabilityAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyNegative
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
|
,cbcsubreporttransform=fmap negate
|
||||||
,cbcsubreportincreasestotal=False
|
,cbcsubreportincreasestotal=False
|
||||||
}
|
}
|
||||||
],
|
],
|
||||||
|
|||||||
@ -24,19 +24,22 @@ balancesheetequitySpec = CompoundBalanceCommandSpec {
|
|||||||
CBCSubreportSpec{
|
CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Assets"
|
cbcsubreporttitle="Assets"
|
||||||
,cbcsubreportquery=journalAssetAccountQuery
|
,cbcsubreportquery=journalAssetAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyPositive
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive})
|
||||||
|
,cbcsubreporttransform=id
|
||||||
,cbcsubreportincreasestotal=True
|
,cbcsubreportincreasestotal=True
|
||||||
}
|
}
|
||||||
,CBCSubreportSpec{
|
,CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Liabilities"
|
cbcsubreporttitle="Liabilities"
|
||||||
,cbcsubreportquery=journalLiabilityAccountQuery
|
,cbcsubreportquery=journalLiabilityAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyNegative
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
|
,cbcsubreporttransform=fmap negate
|
||||||
,cbcsubreportincreasestotal=False
|
,cbcsubreportincreasestotal=False
|
||||||
}
|
}
|
||||||
,CBCSubreportSpec{
|
,CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Equity"
|
cbcsubreporttitle="Equity"
|
||||||
,cbcsubreportquery=journalEquityAccountQuery
|
,cbcsubreportquery=journalEquityAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyNegative
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
|
,cbcsubreporttransform=fmap negate
|
||||||
,cbcsubreportincreasestotal=False
|
,cbcsubreportincreasestotal=False
|
||||||
}
|
}
|
||||||
],
|
],
|
||||||
|
|||||||
@ -27,7 +27,8 @@ cashflowSpec = CompoundBalanceCommandSpec {
|
|||||||
CBCSubreportSpec{
|
CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Cash flows"
|
cbcsubreporttitle="Cash flows"
|
||||||
,cbcsubreportquery=journalCashAccountQuery
|
,cbcsubreportquery=journalCashAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyPositive
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_= Just NormallyPositive})
|
||||||
|
,cbcsubreporttransform=id
|
||||||
,cbcsubreportincreasestotal=True
|
,cbcsubreportincreasestotal=True
|
||||||
}
|
}
|
||||||
],
|
],
|
||||||
|
|||||||
@ -23,13 +23,15 @@ incomestatementSpec = CompoundBalanceCommandSpec {
|
|||||||
CBCSubreportSpec{
|
CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Revenues"
|
cbcsubreporttitle="Revenues"
|
||||||
,cbcsubreportquery=journalRevenueAccountQuery
|
,cbcsubreportquery=journalRevenueAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyNegative
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
|
,cbcsubreporttransform=fmap negate
|
||||||
,cbcsubreportincreasestotal=True
|
,cbcsubreportincreasestotal=True
|
||||||
}
|
}
|
||||||
,CBCSubreportSpec{
|
,CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Expenses"
|
cbcsubreporttitle="Expenses"
|
||||||
,cbcsubreportquery=journalExpenseAccountQuery
|
,cbcsubreportquery=journalExpenseAccountQuery
|
||||||
,cbcsubreportnormalsign=NormallyPositive
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive})
|
||||||
|
,cbcsubreporttransform=id
|
||||||
,cbcsubreportincreasestotal=False
|
,cbcsubreportincreasestotal=False
|
||||||
}
|
}
|
||||||
],
|
],
|
||||||
|
|||||||
@ -41,11 +41,11 @@ import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutput)
|
|||||||
-- it should be added to or subtracted from the grand total.
|
-- it should be added to or subtracted from the grand total.
|
||||||
--
|
--
|
||||||
data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
|
data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
|
||||||
cbcdoc :: CommandDoc, -- ^ the command's name(s) and documentation
|
cbcdoc :: CommandDoc, -- ^ the command's name(s) and documentation
|
||||||
cbctitle :: String, -- ^ overall report title
|
cbctitle :: String, -- ^ overall report title
|
||||||
cbcqueries :: [CBCSubreportSpec], -- ^ subreport details
|
cbcqueries :: [CBCSubreportSpec DisplayName], -- ^ subreport details
|
||||||
cbctype :: BalanceType -- ^ the "balance" type (change, cumulative, historical)
|
cbctype :: BalanceType -- ^ the "balance" type (change, cumulative, historical)
|
||||||
-- this report shows (overrides command line flags)
|
-- this report shows (overrides command line flags)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Generate a cmdargs option-parsing mode from a compound balance command
|
-- | Generate a cmdargs option-parsing mode from a compound balance command
|
||||||
@ -186,7 +186,7 @@ Balance Sheet
|
|||||||
Total || 1 1 1
|
Total || 1 1 1
|
||||||
|
|
||||||
-}
|
-}
|
||||||
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
|
compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> String
|
||||||
compoundBalanceReportAsText ropts
|
compoundBalanceReportAsText ropts
|
||||||
(CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
|
(CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
|
||||||
title ++ "\n\n" ++
|
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
|
-- Subreports' CSV is concatenated, with the headings rows replaced by a
|
||||||
-- subreport title row, and an overall title row, one headings row, and an
|
-- subreport title row, and an overall title row, one headings row, and an
|
||||||
-- optional overall totals row is added.
|
-- 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)) =
|
compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
|
||||||
addtotals $
|
addtotals $
|
||||||
padRow title :
|
padRow title :
|
||||||
@ -262,7 +262,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor
|
|||||||
])
|
])
|
||||||
|
|
||||||
-- | Render a compound balance report as HTML.
|
-- | Render a compound balance report as HTML.
|
||||||
compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
|
compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> Html ()
|
||||||
compoundBalanceReportAsHtml ropts cbr =
|
compoundBalanceReportAsHtml ropts cbr =
|
||||||
let
|
let
|
||||||
CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr
|
CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user