diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 7e28f8f8c..eb82fb0ac 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -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 diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index e4ee6541f..9912bf309 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -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 diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 920a35cb1..24c1584ce 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -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" diff --git a/tests/balancesheet.test b/tests/balancesheet.test index 98caf2550..ee87e2402 100644 --- a/tests/balancesheet.test +++ b/tests/balancesheet.test @@ -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 =============++============ diff --git a/tests/journal/directives-account.test b/tests/journal/directives-account.test index f4bf0463d..a2b6c44ee 100644 --- a/tests/journal/directives-account.test +++ b/tests/journal/directives-account.test @@ -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