{-# LANGUAGE OverloadedStrings, RecordWildCards #-} {-| Common helpers for making multi-section balance report commands like balancesheet, cashflow, and incomestatement. -} module Hledger.Cli.CompoundBalanceCommand ( CompoundBalanceCommandSpec(..) ,compoundBalanceCommandMode ,compoundBalanceCommand ) where import Data.List (intercalate, foldl') import Data.Maybe (fromMaybe) import Data.Monoid (Sum(..), (<>)) import Data.Tuple.HT (uncurry3) import System.Console.CmdArgs.Explicit as C import Text.CSV import Text.Tabular as T import Hledger import Hledger.Cli.Commands.Balance import Hledger.Cli.CliOptions import Hledger.Cli.Utils (writeOutput) -- | Description of a compound balance report command, -- from which we generate the command's cmdargs mode and IO action. -- A compound balance report command shows one or more sections/subreports, -- each with its own title and subtotals row, in a certain order, -- plus a grand totals row if there's more than one section. -- Examples are the balancesheet, cashflow and incomestatement commands. data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec { cbcname :: String, -- ^ command name cbcaliases :: [String], -- ^ command aliases cbchelp :: String, -- ^ command line help cbctitle :: String, -- ^ overall report title cbcqueries :: [(String, Journal -> Query, Maybe NormalBalance)], -- ^ title, journal-parameterised query, and expected normal balance for each subreport. -- The normal balance helps --sort-amount know how to sort negative amounts. cbctype :: BalanceType -- ^ the type of "balance" this report shows (overrides command line flags) } -- | Generate a cmdargs option-parsing mode from a compound balance command -- specification. compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = (defCommandMode $ cbcname : cbcaliases) { modeHelp = cbchelp `withAliases` cbcaliases ,modeGroupFlags = C.Group { groupUnnamed = [ flagNone ["change"] (\opts -> setboolopt "change" opts) ("show balance change in each period" ++ defType PeriodChange) ,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) ("show balance change accumulated across periods (in multicolumn reports)" ++ defType CumulativeChange ) ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) ("show historical ending balance in each period (includes postings before report start date)" ++ defType HistoricalBalance ) ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list" ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts" ,flagNone ["no-total","N"] (\opts -> setboolopt "no-total" opts) "omit the final total row" ,flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show accounts as a tree; amounts include subaccounts (default in simple reports)" ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a row average column (in multicolumn reports)" ,flagNone ["row-total","T"] (\opts -> setboolopt "row-total" opts) "show a row total column (in multicolumn reports)" ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't squash boring parent accounts (in tree mode)" ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)" ,flagNone ["pretty-tables"] (\opts -> setboolopt "pretty-tables" opts) "use unicode when displaying tables" ,flagNone ["sort-amount","S"] (\opts -> setboolopt "sort-amount" opts) "sort by amount instead of account name" ,outputFormatFlag ,outputFileFlag ] ,groupHidden = [] ,groupNamed = [generalflagsgroup1] } } where defType :: BalanceType -> String defType bt | bt == cbctype = " (default)" | otherwise = "" -- | Generate a runnable command from a compound balance command specification. compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd, reportopts_=ropts, rawopts_=rawopts} j = do d <- getCurrentDay let -- use the default balance type for this report, unless the user overrides mBalanceTypeOverride = case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst rawopts of "historical":_ -> Just HistoricalBalance "cumulative":_ -> Just CumulativeChange "change":_ -> Just PeriodChange _ -> Nothing balancetype = fromMaybe cbctype mBalanceTypeOverride -- when user overrides, add an indication to the report title title = cbctitle ++ maybe "" (' ':) mtitleclarification where mtitleclarification = flip fmap mBalanceTypeOverride $ \t -> case t of PeriodChange -> "(Balance Changes)" CumulativeChange -> "(Cumulative Ending Balances)" HistoricalBalance -> "(Historical Ending Balances)" -- Set balance type in the report options. -- XXX Also, use tree mode (by default, at least?) if --cumulative/--historical -- are used in single column mode, since in that situation we will be using -- singleBalanceReport which does not support eliding boring parents, -- and tree mode hides this.. or something.. -- see also compoundBalanceCommandSingleColumnReport, #565 ropts' | not (flat_ ropts) && interval_ ropts==NoInterval && balancetype `elem` [CumulativeChange, HistoricalBalance] = ropts{balancetype_=balancetype, accountlistmode_=ALTree} | otherwise = ropts{balancetype_=balancetype} userq = queryFromOpts d ropts' format = outputFormatFromOpts opts case interval_ ropts' of -- single-column report -- TODO refactor, support output format like multi column NoInterval -> do let -- concatenate the rendering and sum the totals from each subreport (subreportstr, total) = foldMap (uncurry3 (compoundBalanceCommandSingleColumnReport ropts' userq j)) cbcqueries writeOutput opts $ unlines $ [title ++ "\n"] ++ subreportstr ++ if (no_total_ ropts' || cmd=="cashflow") then [] else [ "Total:" , "--------------------" , padLeftWide 20 $ showamt (getSum total) , "" ] where showamt | color_ ropts' = cshowMixedAmountWithoutPrice | otherwise = showMixedAmountWithoutPrice -- multi-column report _ -> do let -- make a CompoundBalanceReport namedsubreports = map (\(subreporttitle, subreportq, subreportnormalsign) -> (subreporttitle, compoundBalanceSubreport ropts' userq j subreportq subreportnormalsign)) cbcqueries subtotalrows = [coltotals | MultiBalanceReport (_,_,(coltotals,_,_)) <- map snd namedsubreports] overalltotals = case subtotalrows of [] -> ([], nullmixedamt, nullmixedamt) rs -> -- Sum the subtotals in each column. -- A subreport might be empty and have no subtotals, count those as zeros (#588). -- Short subtotals rows are also implicitly padded with zeros, though that is not expected to happen. let numcols = maximum $ map length rs -- depends on non-null ts zeros = replicate numcols nullmixedamt rs' = [take numcols $ as ++ repeat nullmixedamt | as <- rs] coltotals = foldl' (zipWith (+)) zeros rs' grandtotal = sum coltotals grandavg | null coltotals = nullmixedamt | otherwise = grandtotal `divideMixedAmount` fromIntegral (length coltotals) in (coltotals, grandtotal, grandavg) cbr = (title ,namedsubreports ,overalltotals ) -- render appropriately writeOutput opts $ case format of "csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n" _ -> compoundBalanceReportAsText ropts' cbr -- | Run one subreport for a compound balance command in single-column mode. -- Currently this returns the plain text rendering of the subreport, and its total. -- The latter is wrapped in a Sum for easy monoidal combining. compoundBalanceCommandSingleColumnReport :: ReportOpts -> Query -> Journal -> String -> (Journal -> Query) -> Maybe NormalBalance -> ([String], Sum MixedAmount) compoundBalanceCommandSingleColumnReport ropts userq j subreporttitle subreportqfn subreportnormalsign = ([subreportstr], Sum total) where q = And [subreportqfn j, userq] ropts' = ropts{normalbalance_=subreportnormalsign} r@(_,total) -- XXX For --historical/--cumulative, we must use singleBalanceReport; -- otherwise we use balanceReport -- because it supports eliding boring parents. -- See also compoundBalanceCommand, Balance.hs -> balance. | balancetype_ ropts `elem` [CumulativeChange, HistoricalBalance] = singleBalanceReport ropts' q j | otherwise = balanceReport ropts' q j subreportstr = intercalate "\n" [subreporttitle <> ":", balanceReportAsText ropts r] -- | A compound balance report has: -- -- * an overall title -- -- * one or more named multi balance reports, with the same column headings -- -- * 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 , [(String, MultiBalanceReport)] , ([MixedAmount], MixedAmount, MixedAmount) ) -- | Run one subreport for a compound balance command in multi-column mode. -- This returns a MultiBalanceReport. compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> Maybe NormalBalance -> MultiBalanceReport compoundBalanceSubreport ropts userq j subreportqfn subreportnormalsign = r' where -- force --empty to ensure same columns in all sections ropts' = ropts { empty_=True, normalbalance_=subreportnormalsign } -- run the report q = And [subreportqfn j, userq] r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j -- if user didn't specify --empty, now remove the all-zero rows r' | empty_ ropts = r | otherwise = MultiBalanceReport (dates, rows', totals) where rows' = filter (not . emptyRow) rows where emptyRow (_,_,_,amts,_,_) = all isZeroMixedAmount amts -- | Render a compound balance report as plain text suitable for console output. {- Eg: Balance Sheet || 2017/12/31 Total Average =============++=============================== Assets || -------------++------------------------------- assets:b || 1 1 1 -------------++------------------------------- || 1 1 1 =============++=============================== Liabilities || -------------++------------------------------- -------------++------------------------------- || =============++=============================== Total || 1 1 1 -} compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String compoundBalanceReportAsText ropts (title, subreports, (coltotals, grandtotal, grandavg)) = title ++ "\n\n" ++ renderBalanceReportTable ropts bigtable' where singlesubreport = length subreports == 1 bigtable = case map (subreportAsTable ropts singlesubreport) subreports of [] -> T.empty r:rs -> foldl' concatTables r rs bigtable' | no_total_ ropts || singlesubreport = bigtable | otherwise = bigtable +====+ row "Total" ( coltotals ++ (if row_total_ ropts then [grandtotal] else []) ++ (if average_ ropts then [grandavg] else []) ) -- | Convert a named multi balance report to a table suitable for -- concatenating with others to make a compound balance report table. subreportAsTable ropts singlesubreport (title, r) = t where -- unless there's only one section, always show the subtotal row ropts' | singlesubreport = ropts | otherwise = ropts{ no_total_=False } -- convert to table Table lefthdrs tophdrs cells = balanceReportAsTable ropts' r -- tweak the layout t = Table (T.Group SingleLine [Header title, lefthdrs]) tophdrs ([]:cells) -- | Add the second table below the first, discarding its column headings. concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') = Table (T.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat') -- | Render a compound balance report as CSV. {- Eg: ghci> :main -f examples/sample.journal bs -Y -O csv -AT "Balance Sheet","","","","","" "Assets","","","","","" "account","short account","indent","2008","total","average" "assets:bank:saving","saving","3","$1","$1","$1" "assets:cash","cash","2","$-2","$-2","$-2" "totals","","","$-1","$-1","$-1" "Liabilities","","","","","" "account","short account","indent","2008","total","average" "liabilities:debts","debts","2","$1","$1","$1" "totals","","","$1","$1","$1" "Total","0","0","0" -} compoundBalanceReportAsCsv :: ReportOpts -> CompoundBalanceReport -> CSV compoundBalanceReportAsCsv ropts (title, subreports, (coltotals, grandtotal, grandavg)) = addtotals $ padRow title : concatMap (subreportAsCsv ropts singlesubreport) subreports where singlesubreport = length subreports == 1 subreportAsCsv ropts singlesubreport (subreporttitle, multibalreport) = padRow subreporttitle : multiBalanceReportAsCsv ropts' multibalreport where -- unless there's only one section, always show the subtotal row ropts' | singlesubreport = ropts | otherwise = ropts{ no_total_=False } padRow s = take numcols $ s : repeat "" where numcols | null subreports = 1 | otherwise = (3 +) $ -- account name & indent columns (if row_total_ ropts then (1+) else id) $ (if average_ ropts then (1+) else id) $ maximum $ -- depends on non-null subreports map (\(MultiBalanceReport (amtcolheadings, _, _)) -> length amtcolheadings) $ map snd subreports addtotals | no_total_ ropts || length subreports == 1 = id | otherwise = (++ ["Total" : map showMixedAmountOneLineWithoutPrice ( coltotals ++ (if row_total_ ropts then [grandtotal] else []) ++ (if average_ ropts then [grandavg] else []) ) ])