lib, cli: Move CompoundBalanceReport into ReportTypes, compoundReportWith into MultiBalanceReport, share postings amongst subreports.

This commit is contained in:
Stephen Morgan 2020-06-24 12:58:18 +10:00 committed by Simon Michael
parent d09a90b38b
commit 604868cea5
5 changed files with 142 additions and 142 deletions

View File

@ -16,6 +16,10 @@ module Hledger.Reports.MultiBalanceReport (
multiBalanceReport,
multiBalanceReportWith,
balanceReportFromMultiBalanceReport,
CompoundBalanceReport,
compoundBalanceReportWith,
tableAsText,
sortAccountItemsLike,
@ -28,6 +32,7 @@ where
import Control.Monad (guard)
import Data.Foldable (toList)
import Data.List (sortBy, transpose)
import Data.List.NonEmpty (NonEmpty(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Map (Map)
@ -37,6 +42,7 @@ import Data.Ord (comparing)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Semigroup (sconcat)
import Data.Time.Calendar (Day, addDays, fromGregorian)
import Safe (headDef, headMay, lastMay)
import Text.Tabular as T
@ -70,10 +76,13 @@ 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
-- | Generate a multicolumn balance report for the matched accounts,
-- showing the change of balance, accumulated balance, or historical balance
-- in each of the specified periods. Does not support tree-mode boring parent eliding.
@ -109,6 +118,49 @@ multiBalanceReportWith ropts q j priceoracle = report
-- Postprocess the report, negating balances and taking percentages if needed
report = dbg' "report" $ generateMultiBalanceReport ropts' reportq j priceoracle reportspan colspans colps
compoundBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle
-> [CBCSubreportSpec]
-> CompoundBalanceReport
compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr
where
-- Queries, report/column dates.
ropts' = dbg "ropts'" $ setDefaultAccountListMode ALFlat ropts
reportspan = dbg "reportspan" $ calculateReportSpan ropts' q j
reportq = dbg "reportq" $ makeReportQuery ropts' reportspan q
-- Group postings into their columns.
colps = dbg'' "colps" $ getPostingsByColumn ropts'{empty_=True} reportq j reportspan
colspans = dbg "colspans" $ M.keys colps
-- Filter the column postings according to each subreport
subreportcolps = map filterSubreport subreportspecs
where filterSubreport sr = filter (matchesPosting $ cbcsubreportquery sr j) <$> colps
subreports = zipWith generateSubreport subreportspecs subreportcolps
where
generateSubreport CBCSubreportSpec{..} colps' =
( cbcsubreporttitle
-- Postprocess the report, negating balances and taking percentages if needed
, prNormaliseSign cbcsubreportnormalsign $
generateMultiBalanceReport ropts'' reportq j priceoracle reportspan colspans colps'
, cbcsubreportincreasestotal
)
where
ropts'' = ropts'{normalbalance_=Just cbcsubreportnormalsign}
-- Sum the subreport totals by column. Handle these cases:
-- - no subreports
-- - empty subreports, having no subtotals (#588)
-- - subreports with a shorter subtotals row than the others
overalltotals = case subreports of
[] -> PeriodicReportRow () [] nullmixedamt nullmixedamt
(r:rs) -> sconcat $ fmap subreportTotal (r:|rs)
where
subreportTotal (_, sr, increasestotal) =
(if increasestotal then id else prrNegate) $ prTotals sr
cbr = CompoundPeriodicReport "" colspans subreports overalltotals
-- | Calculate the span of the report to be generated.
setDefaultAccountListMode :: AccountListMode -> ReportOpts -> ReportOpts

View File

@ -1,8 +1,9 @@
{- |
New common report types, used by the BudgetReport for now, perhaps all reports later.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
module Hledger.Reports.ReportTypes
( PeriodicReport(..)
@ -17,10 +18,14 @@ module Hledger.Reports.ReportTypes
, periodicReportSpan
, prNegate
, prNormaliseSign
, prMapName
, prMapMaybeName
, prrNegate
, CompoundPeriodicReport(..)
, CBCSubreportSpec(..)
, DisplayName(..)
, flatDisplayName
, treeDisplayName
@ -33,8 +38,12 @@ module Hledger.Reports.ReportTypes
import Data.Aeson
import Data.Decimal
import Data.Maybe (mapMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import GHC.Generics (Generic)
import Hledger.Data
import Hledger.Query (Query)
type Percentage = Decimal
@ -89,6 +98,14 @@ data PeriodicReportRow a b =
, prrAverage :: b -- The average of this row's values.
} deriving (Show, Generic, ToJSON)
instance Num b => Semigroup (PeriodicReportRow a b) where
(PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) =
PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 + t2) (a1 + a2)
where
sumPadded (a:as) (b:bs) = (a + b) : sumPadded as bs
sumPadded as [] = as
sumPadded [] bs = bs
-- | Figure out the overall date span of a PeridicReport
periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
@ -103,10 +120,12 @@ prNormaliseSign _ = id
-- | Flip the sign of all amounts in a PeriodicReport.
prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b
prNegate (PeriodicReport colspans rows totalsrow) =
PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow)
where
rowNegate (PeriodicReportRow name amts tot avg) =
PeriodicReportRow name (map negate amts) (-tot) (-avg)
PeriodicReport colspans (map prrNegate rows) (prrNegate totalsrow)
-- | Flip the sign of all amounts in a PeriodicReportRow.
prrNegate :: Num b => PeriodicReportRow a b -> PeriodicReportRow a b
prrNegate (PeriodicReportRow name amts tot avg) =
PeriodicReportRow name (map negate amts) (-tot) (-avg)
-- | Map a function over the row names.
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
@ -127,6 +146,36 @@ prrMapMaybeName f row = case f $ prrName row of
Just a -> Just row{prrName = a}
-- | A compound balance report has:
--
-- * an overall title
--
-- * the period (date span) of each column
--
-- * one or more named, normal-positive multi balance reports,
-- with columns corresponding to the above, and a flag indicating
-- whether they increased or decreased the overall totals
--
-- * a list of overall totals for each column, and their grand total and average
--
-- It is used in compound balance report commands like balancesheet,
-- cashflow and incomestatement.
data CompoundPeriodicReport a b = CompoundPeriodicReport
{ cbrTitle :: String
, cbrDates :: [DateSpan]
, cbrSubreports :: [(String, PeriodicReport a b, Bool)]
, cbrTotals :: PeriodicReportRow () b
} deriving (Show, Generic, ToJSON)
-- | Description of one subreport within a compound balance report.
data CBCSubreportSpec = CBCSubreportSpec
{ cbcsubreporttitle :: String
, cbcsubreportquery :: Journal -> Query
, cbcsubreportnormalsign :: NormalSign
, cbcsubreportincreasestotal :: Bool
}
-- | A full name, display name, and depth for an account.
data DisplayName = DisplayName
{ displayFull :: AccountName

View File

@ -8,7 +8,6 @@ like balancesheet, cashflow, and incomestatement.
module Hledger.Cli.CompoundBalanceCommand (
CompoundBalanceCommandSpec(..)
,CBCSubreportSpec(..)
,compoundBalanceCommandMode
,compoundBalanceCommand
) where
@ -49,36 +48,6 @@ data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
-- this report shows (overrides command line flags)
}
-- | Description of one subreport within a compound balance report.
data CBCSubreportSpec = CBCSubreportSpec {
cbcsubreporttitle :: String
,cbcsubreportquery :: Journal -> Query
,cbcsubreportnormalsign :: NormalSign
,cbcsubreportincreasestotal :: Bool
}
-- | A compound balance report has:
--
-- * an overall title
--
-- * the period (date span) of each column
--
-- * one or more named, normal-positive multi balance reports,
-- with columns corresponding to the above, and a flag indicating
-- whether they increased or decreased the overall totals
--
-- * a list of overall totals for each column, and their grand total and average
--
-- It is used in compound balance report commands like balancesheet,
-- cashflow and incomestatement.
type CompoundBalanceReport =
( String
, [DateSpan]
, [(String, MultiBalanceReport, Bool)]
, ([MixedAmount], MixedAmount, MixedAmount)
)
-- | Generate a cmdargs option-parsing mode from a compound balance command
-- specification.
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
@ -147,46 +116,6 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
-- make a CompoundBalanceReport.
-- For efficiency, generate a price oracle here and reuse it with each subreport.
priceoracle = journalPriceOracle infer_value_ j
subreports =
map (\CBCSubreportSpec{..} ->
(cbcsubreporttitle
,prNormaliseSign cbcsubreportnormalsign $ -- <- convert normal-negative to normal-positive
compoundBalanceSubreport ropts' userq j priceoracle cbcsubreportquery cbcsubreportnormalsign
,cbcsubreportincreasestotal
))
cbcqueries
subtotalrows =
[(prrAmounts $ prTotals report, increasesoveralltotal)
| (_, report, increasesoveralltotal) <- subreports
]
-- Sum the subreport totals by column. Handle these cases:
-- - no subreports
-- - empty subreports, having no subtotals (#588)
-- - subreports with a shorter subtotals row than the others
overalltotals = case subtotalrows of
[] -> ([], nullmixedamt, nullmixedamt)
rs ->
let
numcols = maximum $ map (length.fst) rs -- partial maximum is ok, rs is non-null
paddedsignedsubtotalrows =
[map (if increasesoveralltotal then id else negate) $ -- maybe flip the signs
take numcols $ as ++ repeat nullmixedamt -- pad short rows with zeros
| (as,increasesoveralltotal) <- rs
]
coltotals = foldl' (zipWith (+)) zeros paddedsignedsubtotalrows -- sum the columns
where zeros = replicate numcols nullmixedamt
grandtotal = sum coltotals
grandavg | null coltotals = nullmixedamt
| otherwise = fromIntegral (length coltotals) `divideMixedAmount` grandtotal
in
(coltotals, grandtotal, grandavg)
colspans =
case subreports of
(_, PeriodicReport ds _ _, _):_ -> ds
[] -> []
title =
cbctitle
@ -201,11 +130,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
-- column heading(s) (not the date span of the transactions).
-- Also the dates should not be simplified (it should show
-- "2008/01/01-2008/12/31", not "2008").
titledatestr
| balancetype == HistoricalBalance = showEndDates enddates
| otherwise = showDateSpan requestedspan
titledatestr = case balancetype of
HistoricalBalance -> showEndDates enddates
_ -> showDateSpan requestedspan
where
enddates = map (addDays (-1)) $ catMaybes $ map spanEnd colspans -- these spans will always have a definite end date
enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date
requestedspan = queryDateSpan date2_ userq `spanDefaultsFrom` journalDateSpan date2_ j
-- when user overrides, add an indication to the report title
@ -226,12 +155,9 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
Nothing -> ""
where
multiperiod = interval_ /= NoInterval
cbr =
(title
,colspans
,subreports
,overalltotals
)
cbr' = compoundBalanceReportWith ropts' userq j priceoracle cbcqueries
cbr = cbr'{cbrTitle=title}
-- render appropriately
writeOutput opts $
@ -254,30 +180,6 @@ showEndDates es = case es of
where
showdate = show
-- | Run one subreport for a compound balance command in multi-column mode.
-- This returns a MultiBalanceReport.
compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> PriceOracle -> (Journal -> Query) -> NormalSign -> MultiBalanceReport
compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn subreportnormalsign = r'
where
-- force --empty to ensure same columns in all sections
ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign }
-- run the report
q = And [subreportqfn j, userq]
r@(PeriodicReport dates rows totals) = multiBalanceReportWith ropts' q j priceoracle
-- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts
-- in this report
r' | empty_ = r
| otherwise = PeriodicReport dates rows' totals
where
nonzeroaccounts =
dbg5 "nonzeroaccounts" $
mapMaybe (\(PeriodicReportRow act amts _ _) ->
if not (all mixedAmountLooksZero amts) then Just (displayFull act) else Nothing) rows
rows' = filter (not . emptyRow) rows
where
emptyRow (PeriodicReportRow act amts _ _) =
all mixedAmountLooksZero amts && not (any (displayFull act `isAccountNamePrefixOf`) nonzeroaccounts)
-- | Render a compound balance report as plain text suitable for console output.
{- Eg:
Balance Sheet
@ -299,9 +201,10 @@ Balance Sheet
-}
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, grandtotal, grandavg)) =
title ++ "\n\n" ++
balanceReportTableAsText ropts bigtable'
compoundBalanceReportAsText ropts
(CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
title ++ "\n\n" ++
balanceReportTableAsText ropts bigtable'
where
bigtable =
case map (subreportAsTable ropts) subreports of
@ -337,7 +240,7 @@ concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
-- subreport title row, and an overall title row, one headings row, and an
-- optional overall totals row is added.
compoundBalanceReportAsCsv :: ReportOpts -> CompoundBalanceReport -> CSV
compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grandtotal, grandavg)) =
compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
addtotals $
padRow title :
("Account" :
@ -376,7 +279,7 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand
compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
compoundBalanceReportAsHtml ropts cbr =
let
(title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr
CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr
colspanattr = colspan_ $ TS.pack $ show $
1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0)
leftattr = style_ "text-align:left"

View File

@ -96,26 +96,25 @@ hledger -f sample.journal balancesheet -p 'monthly in 2008' --tree
>>>
Balance Sheet 2008-01-31..2008-12-31
|| 2008-01-31 2008-02-29 2008-03-31 2008-04-30 2008-05-31 2008-06-30 2008-07-31 2008-08-31 2008-09-30 2008-10-31 2008-11-30 2008-12-31
==============++================================================================================================================================================
Assets ||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
assets || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
bank || $1 $1 $1 $1 $1 $2 $2 $2 $2 $2 $2 $1
checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0
saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1
cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
|| $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
==============++================================================================================================================================================
Liabilities ||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
liabilities || 0 0 0 0 0 0 0 0 0 0 0 $-1
debts || 0 0 0 0 0 0 0 0 0 0 0 $-1
--------------++------------------------------------------------------------------------------------------------------------------------------------------------
|| 0 0 0 0 0 0 0 0 0 0 0 $-1
==============++================================================================================================================================================
Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0
|| 2008-01-31 2008-02-29 2008-03-31 2008-04-30 2008-05-31 2008-06-30 2008-07-31 2008-08-31 2008-09-30 2008-10-31 2008-11-30 2008-12-31
===================++================================================================================================================================================
Assets ||
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
assets || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
bank || $1 $1 $1 $1 $1 $2 $2 $2 $2 $2 $2 $1
checking || $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 $1 0
saving || 0 0 0 0 0 $1 $1 $1 $1 $1 $1 $1
cash || 0 0 0 0 0 $-2 $-2 $-2 $-2 $-2 $-2 $-2
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
|| $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
===================++================================================================================================================================================
Liabilities ||
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
liabilities:debts || 0 0 0 0 0 0 0 0 0 0 0 $-1
-------------------++------------------------------------------------------------------------------------------------------------------------------------------------
|| 0 0 0 0 0 0 0 0 0 0 0 $-1
===================++================================================================================================================================================
Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0
>>>= 0
# 4. monthly balancesheet with average column and without overall totals row.
@ -150,8 +149,7 @@ Balance Sheet 2017-01-01
=============++============
Assets ||
-------------++------------
assets || 1
b || 1
assets:b || 1
-------------++------------
|| 1
=============++============

View File

@ -48,13 +48,11 @@ Balance Sheet 2018-01-01
=============++============
Assets ||
-------------++------------
b || 3
bb || 3
b:bb || 3
=============++============
Liabilities ||
-------------++------------
asset || -1
a || -1
asset:a || -1
b || -2
# TODO