slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -16,6 +16,10 @@ module Hledger.Reports.MultiBalanceReport (
multiBalanceReport, multiBalanceReport,
multiBalanceReportWith, multiBalanceReportWith,
balanceReportFromMultiBalanceReport, balanceReportFromMultiBalanceReport,
CompoundBalanceReport,
compoundBalanceReportWith,
tableAsText, tableAsText,
sortAccountItemsLike, sortAccountItemsLike,
@ -28,6 +32,7 @@ where
import Control.Monad (guard) import Control.Monad (guard)
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.List (sortBy, transpose) import Data.List (sortBy, transpose)
import Data.List.NonEmpty (NonEmpty(..))
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Map (Map) import Data.Map (Map)
@ -37,6 +42,7 @@ import Data.Ord (comparing)
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>)) import Data.Semigroup ((<>))
#endif #endif
import Data.Semigroup (sconcat)
import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Time.Calendar (Day, addDays, fromGregorian)
import Safe (headDef, headMay, lastMay) import Safe (headDef, headMay, lastMay)
import Text.Tabular as T import Text.Tabular as T
@ -70,10 +76,13 @@ 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
-- | Generate a multicolumn balance report for the matched accounts, -- | Generate a multicolumn balance report for the matched accounts,
-- showing the change of balance, accumulated balance, or historical balance -- showing the change of balance, accumulated balance, or historical balance
-- in each of the specified periods. Does not support tree-mode boring parent eliding. -- 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 -- Postprocess the report, negating balances and taking percentages if needed
report = dbg' "report" $ generateMultiBalanceReport ropts' reportq j priceoracle reportspan colspans colps 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. -- | Calculate the span of the report to be generated.
setDefaultAccountListMode :: AccountListMode -> ReportOpts -> ReportOpts setDefaultAccountListMode :: AccountListMode -> ReportOpts -> ReportOpts

57
hledger-lib/Hledger/Reports/ReportTypes.hs
View File

@ -1,6 +1,7 @@
{- | {- |
New common report types, used by the BudgetReport for now, perhaps all reports later. New common report types, used by the BudgetReport for now, perhaps all reports later.
-} -}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
@ -17,10 +18,14 @@ module Hledger.Reports.ReportTypes
, periodicReportSpan , periodicReportSpan
, prNegate , prNegate
, prNormaliseSign , prNormaliseSign
, prMapName , prMapName
, prMapMaybeName , prMapMaybeName
, prrNegate
, CompoundPeriodicReport(..)
, CBCSubreportSpec(..)
, DisplayName(..) , DisplayName(..)
, flatDisplayName , flatDisplayName
, treeDisplayName , treeDisplayName
@ -33,8 +38,12 @@ module Hledger.Reports.ReportTypes
import Data.Aeson import Data.Aeson
import Data.Decimal import Data.Decimal
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Hledger.Data import Hledger.Data
import Hledger.Query (Query)
type Percentage = Decimal type Percentage = Decimal
@ -89,6 +98,14 @@ data PeriodicReportRow a b =
, prrAverage :: b -- The average of this row's values. , prrAverage :: b -- The average of this row's values.
} deriving (Show, Generic, ToJSON) } 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 -- | Figure out the overall date span of a PeridicReport
periodicReportSpan :: PeriodicReport a b -> DateSpan periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
@ -103,9 +120,11 @@ prNormaliseSign _ = id
-- | Flip the sign of all amounts in a PeriodicReport. -- | Flip the sign of all amounts in a PeriodicReport.
prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b
prNegate (PeriodicReport colspans rows totalsrow) = prNegate (PeriodicReport colspans rows totalsrow) =
PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow) PeriodicReport colspans (map prrNegate rows) (prrNegate totalsrow)
where
rowNegate (PeriodicReportRow name amts tot avg) = -- | 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) PeriodicReportRow name (map negate amts) (-tot) (-avg)
-- | Map a function over the row names. -- | Map a function over the row names.
@ -127,6 +146,36 @@ prrMapMaybeName f row = case f $ prrName row of
Just a -> Just row{prrName = a} 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. -- | A full name, display name, and depth for an account.
data DisplayName = DisplayName data DisplayName = DisplayName
{ displayFull :: AccountName { displayFull :: AccountName

119
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -8,7 +8,6 @@ like balancesheet, cashflow, and incomestatement.
module Hledger.Cli.CompoundBalanceCommand ( module Hledger.Cli.CompoundBalanceCommand (
CompoundBalanceCommandSpec(..) CompoundBalanceCommandSpec(..)
,CBCSubreportSpec(..)
,compoundBalanceCommandMode ,compoundBalanceCommandMode
,compoundBalanceCommand ,compoundBalanceCommand
) where ) where
@ -49,36 +48,6 @@ data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
-- this report shows (overrides command line flags) -- 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 -- | Generate a cmdargs option-parsing mode from a compound balance command
-- specification. -- specification.
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
@ -147,46 +116,6 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
-- make a CompoundBalanceReport. -- make a CompoundBalanceReport.
-- For efficiency, generate a price oracle here and reuse it with each subreport. -- For efficiency, generate a price oracle here and reuse it with each subreport.
priceoracle = journalPriceOracle infer_value_ j 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 = title =
cbctitle cbctitle
@ -201,11 +130,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
-- column heading(s) (not the date span of the transactions). -- column heading(s) (not the date span of the transactions).
-- Also the dates should not be simplified (it should show -- Also the dates should not be simplified (it should show
-- "2008/01/01-2008/12/31", not "2008"). -- "2008/01/01-2008/12/31", not "2008").
titledatestr titledatestr = case balancetype of
| balancetype == HistoricalBalance = showEndDates enddates HistoricalBalance -> showEndDates enddates
| otherwise = showDateSpan requestedspan _ -> showDateSpan requestedspan
where 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 requestedspan = queryDateSpan date2_ userq `spanDefaultsFrom` journalDateSpan date2_ j
-- when user overrides, add an indication to the report title -- when user overrides, add an indication to the report title
@ -226,12 +155,9 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
Nothing -> "" Nothing -> ""
where where
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
cbr =
(title cbr' = compoundBalanceReportWith ropts' userq j priceoracle cbcqueries
,colspans cbr = cbr'{cbrTitle=title}
,subreports
,overalltotals
)
-- render appropriately -- render appropriately
writeOutput opts $ writeOutput opts $
@ -254,30 +180,6 @@ showEndDates es = case es of
where where
showdate = show 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. -- | Render a compound balance report as plain text suitable for console output.
{- Eg: {- Eg:
Balance Sheet Balance Sheet
@ -299,7 +201,8 @@ Balance Sheet
-} -}
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, grandtotal, grandavg)) = compoundBalanceReportAsText ropts
(CompoundPeriodicReport title _colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
title ++ "\n\n" ++ title ++ "\n\n" ++
balanceReportTableAsText ropts bigtable' balanceReportTableAsText ropts bigtable'
where where
@ -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 -- 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 -> CompoundBalanceReport -> CSV
compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grandtotal, grandavg)) = compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) =
addtotals $ addtotals $
padRow title : padRow title :
("Account" : ("Account" :
@ -376,7 +279,7 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand
compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html () compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
compoundBalanceReportAsHtml ropts cbr = compoundBalanceReportAsHtml ropts cbr =
let let
(title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr
colspanattr = colspan_ $ TS.pack $ show $ colspanattr = colspan_ $ TS.pack $ show $
1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0) 1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0)
leftattr = style_ "text-align:left" leftattr = style_ "text-align:left"

20
tests/balancesheet.test
View File

@ -97,24 +97,23 @@ hledger -f sample.journal balancesheet -p 'monthly in 2008' --tree
Balance Sheet 2008-01-31..2008-12-31 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 || 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 ||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------ -------------------++------------------------------------------------------------------------------------------------------------------------------------------------
assets || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1 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 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 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 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 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 || $1 $1 $1 $1 $1 0 0 0 0 0 0 $-1
==============++================================================================================================================================================ ===================++================================================================================================================================================
Liabilities || Liabilities ||
--------------++------------------------------------------------------------------------------------------------------------------------------------------------ -------------------++------------------------------------------------------------------------------------------------------------------------------------------------
liabilities || 0 0 0 0 0 0 0 0 0 0 0 $-1 liabilities:debts || 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 || 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 Net: || $1 $1 $1 $1 $1 0 0 0 0 0 0 0
>>>= 0 >>>= 0
@ -150,8 +149,7 @@ Balance Sheet 2017-01-01
=============++============ =============++============
Assets || Assets ||
-------------++------------ -------------++------------
assets || 1 assets:b || 1
b || 1
-------------++------------ -------------++------------
|| 1 || 1
=============++============ =============++============

6
tests/journal/directives-account.test
View File

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