diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index b4015d143fa..1eae780ed1f 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -119,6 +119,7 @@ instance Default AccountListMode where def = ALFlat data Layout = LayoutWide (Maybe Int) | LayoutTall | LayoutBare + | LayoutBareWide | LayoutTidy deriving (Eq, Show) @@ -373,6 +374,7 @@ layoutopt rawopts = fromMaybe (LayoutWide Nothing) $ layout <|> column , ("tall", LayoutTall) , ("bare", LayoutBare) , ("tidy", LayoutTidy) + , ("bare-wide", LayoutBareWide) ] -- For `--layout=elided,n`, elide to the given width (s,n) = break (==',') $ map toLower opt @@ -381,7 +383,7 @@ layoutopt rawopts = fromMaybe (LayoutWide Nothing) $ layout <|> column c | Just w' <- readMay c -> Just w' _ -> usageError "width in --layout=wide,WIDTH must be an integer" - err = usageError "--layout's argument should be \"wide[,WIDTH]\", \"tall\", \"bare\", or \"tidy\"" + err = usageError "--layout's argument should be \"wide[,WIDTH]\", \"tall\", \"bare\", \"bare-wide\", or \"tidy\"" -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period -- options appearing in the command line. diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 7e746f95029..91c6c3430f6 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -641,6 +641,9 @@ headerDateSpanCell base query spn = Ods.cellAnchor = composeAnchor base $ replaceDate prd query } +headerWithoutBorders :: [Ods.Cell () text] -> [Ods.Cell Ods.NumLines text] +headerWithoutBorders = map (\c -> c {Ods.cellBorder = Ods.noBorder}) + addHeaderBorders :: [Ods.Cell () text] -> [Ods.Cell Ods.NumLines text] addHeaderBorders = map (\c -> c {Ods.cellBorder = @@ -689,8 +692,11 @@ balanceReportAsSpreadsheet opts (items, total) = headers = addHeaderBorders $ map headerCell $ "account" : case layout_ opts of + LayoutBareWide -> allCommodities LayoutBare -> ["commodity", "balance"] _ -> ["balance"] + allCommodities = + S.toAscList $ foldMap (\(_,_,_,ma) -> maCommodities ma) items rows :: RowClass -> BalanceReportItem -> [[Ods.Cell Ods.NumLines Text]] @@ -702,6 +708,15 @@ balanceReportAsSpreadsheet opts (items, total) = cell $ renderBalanceAcct opts nbsp (name, dispName, dep) in addRowSpanHeader accountCell $ case layout_ opts of + LayoutBareWide -> + let bopts = + machineFmt { + displayCommodity = False, + displayCommodityOrder = Just allCommodities + } in + [map (\bldAmt -> + fmap wbToText $ cellFromAmount bopts (amountClass rc, bldAmt)) $ + showMixedAmountLinesPartsB bopts ma] LayoutBare -> map (\a -> [cell $ acommodity a, renderAmount rc $ mixedAmount a]) . amounts $ mixedAmountStripCosts ma @@ -739,6 +754,15 @@ cellsFromMixedAmount bopts (cls, mixedAmt) = }) (showMixedAmountLinesPartsB bopts mixedAmt) +cellFromAmount :: + (Ods.Lines border) => + AmountFormat -> (Ods.Class, (wb, Amount)) -> Ods.Cell border wb +cellFromAmount bopts (cls, (str,amt)) = + (Ods.defaultCell str) { + Ods.cellClass = cls, + Ods.cellType = amountType bopts amt + } + amountType :: AmountFormat -> Amount -> Ods.Type amountType bopts amt = Ods.TypeAmount $ @@ -756,29 +780,41 @@ amountType bopts amt = multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV multiBalanceReportAsCsv opts@ReportOpts{..} report = (if transpose_ then transpose else id) $ - rawTableContent $ header : body ++ totals + rawTableContent $ header ++ body ++ totals where (header, body, totals) = - multiBalanceReportAsSpreadsheetParts machineFmt opts report + multiBalanceReportAsSpreadsheetParts machineFmt opts + (allCommoditiesFromPeriodicReport $ prRows report) report -- | Render the Spreadsheet table rows (CSV, ODS, HTML) for a MultiBalanceReport. -- Returns the heading row, 0 or more body rows, and the totals row if enabled. multiBalanceReportAsSpreadsheetParts :: - AmountFormat -> ReportOpts -> MultiBalanceReport -> - ([Ods.Cell Ods.NumLines Text], + AmountFormat -> ReportOpts -> + [CommoditySymbol] -> MultiBalanceReport -> + ([[Ods.Cell Ods.NumLines Text]], [[Ods.Cell Ods.NumLines Text]], [[Ods.Cell Ods.NumLines Text]]) -multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..} (PeriodicReport colspans items tr) = - (headers, concatMap fullRowAsTexts items, addTotalBorders totalrows) +multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..} + allCommodities (PeriodicReport colspans items tr) = + (allHeaders, concatMap fullRowAsTexts items, addTotalBorders totalrows) where accountCell label = (Ods.defaultCell label) {Ods.cellClass = Ods.Class "account"} hCell cls label = (headerCell label) {Ods.cellClass = Ods.Class cls} + allHeaders = + case layout_ of + LayoutBareWide -> + [headerWithoutBorders $ + Ods.emptyCell : + concatMap (Ods.horizontalSpan allCommodities) dateHeaders, + headers] + _ -> [headers] headers = addHeaderBorders $ hCell "account" "account" : case layout_ of LayoutTidy -> map headerCell tidyColumnLabels + LayoutBareWide -> dateHeaders >> map headerCell allCommodities LayoutBare -> headerCell "commodity" : dateHeaders _ -> dateHeaders dateHeaders = @@ -799,7 +835,7 @@ multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..} (PeriodicReport col rowAsText Total simpleDateSpanCell tr rowAsText rc dsCell = map (map (fmap wbToText)) . - multiBalanceRowAsCellBuilders fmt opts colspans rc dsCell + multiBalanceRowAsCellBuilders fmt opts colspans allCommodities rc dsCell tidyColumnLabels :: [Text] tidyColumnLabels = @@ -819,10 +855,12 @@ multiBalanceReportAsSpreadsheet :: ((Maybe Int, Maybe Int), [[Ods.Cell Ods.NumLines Text]]) multiBalanceReportAsSpreadsheet ropts mbr = let (header,body,total) = - multiBalanceReportAsSpreadsheetParts oneLineNoCostFmt ropts mbr + multiBalanceReportAsSpreadsheetParts oneLineNoCostFmt ropts + (allCommoditiesFromPeriodicReport $ prRows mbr) mbr in (if transpose_ ropts then swap *** Ods.transpose else id) $ - ((Just 1, case layout_ ropts of LayoutWide _ -> Just 1; _ -> Nothing), - header : body ++ total) + ((Just $ case layout_ ropts of LayoutBareWide -> 2; _ -> 1, + case layout_ ropts of LayoutWide _ -> Just 1; _ -> Nothing), + header ++ body ++ total) -- | Render a multi-column balance report as plain text suitable for console output. @@ -893,19 +931,24 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, balanceaccum_ (concat rows) where colheadings = ["Commodity" | layout_ opts == LayoutBare] - ++ (if not summary_only_ then map (reportPeriodName balanceaccum_ spans) spans else []) + ++ (if not summary_only_ + then case layout_ opts of + LayoutBareWide -> spans >> allCommodities + _ -> map (reportPeriodName balanceaccum_ spans) spans + else []) ++ [" Total" | multiBalanceHasTotalsColumn opts] ++ ["Average" | average_] + allCommodities = allCommoditiesFromPeriodicReport items (accts, rows) = unzip $ fmap fullRowAsTexts items where fullRowAsTexts row = (replicate (length rs) (renderacct row), rs) where - rs = multiBalanceRowAsText opts row + rs = multiBalanceRowAsText opts allCommodities row renderacct row' = T.replicate (prrIndent row' * 2) " " <> prrDisplayName row' addtotalrow | no_total_ opts = id | otherwise = - let totalrows = multiBalanceRowAsText opts tr + let totalrows = multiBalanceRowAsText opts allCommodities tr rowhdrs = Group NoLine $ map Header $ totalRowHeadingText : replicate (length totalrows - 1) "" colhdrs = Header [] -- unused, concatTables will discard in (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows) @@ -914,12 +957,17 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, balanceaccum_ multiColumnTableInterRowBorder = NoLine multiColumnTableInterColumnBorder = if pretty_ opts then SingleLine else NoLine +allCommoditiesFromPeriodicReport :: + [PeriodicReportRow a MixedAmount] -> [CommoditySymbol] +allCommoditiesFromPeriodicReport = + S.toAscList . foldMap (foldMap maCommodities . prrAmounts) + multiBalanceRowAsCellBuilders :: - AmountFormat -> ReportOpts -> [DateSpan] -> + AmountFormat -> ReportOpts -> [DateSpan] -> [CommoditySymbol] -> RowClass -> (DateSpan -> Ods.Cell Ods.NumLines Text) -> PeriodicReportRow a MixedAmount -> [[Ods.Cell Ods.NumLines WideBuilder]] -multiBalanceRowAsCellBuilders bopts ropts@ReportOpts{..} colspans +multiBalanceRowAsCellBuilders bopts ropts@ReportOpts{..} colspans allCommodities rc renderDateSpanCell (PeriodicReportRow _acct as rowtot rowavg) = case layout_ of LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) clsamts] @@ -930,6 +978,8 @@ multiBalanceRowAsCellBuilders bopts ropts@ReportOpts{..} colspans . transpose -- each row becomes a list of Text quantities . map (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) $ clsamts + LayoutBareWide -> [concatMap (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just allCommodities, displayMinWidth=Nothing}) + $ clsamts] LayoutTidy -> concat . zipWith (map . addDateColumns) colspans . map ( zipWith (\c a -> [wbCell c, a]) cs @@ -972,16 +1022,20 @@ multiBalanceHasTotalsColumn :: ReportOpts -> Bool multiBalanceHasTotalsColumn ropts = row_total_ ropts && balanceaccum_ ropts `notElem` [Cumulative, Historical] -multiBalanceRowAsText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] -multiBalanceRowAsText opts = +multiBalanceRowAsText :: + ReportOpts -> [CommoditySymbol] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] +multiBalanceRowAsText opts allCommodities = rawTableContent . - multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts} opts [] + multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts} + opts [] allCommodities Value simpleDateSpanCell -multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] -multiBalanceRowAsCsvText opts colspans = +multiBalanceRowAsCsvText :: + ReportOpts -> [DateSpan] -> [CommoditySymbol] -> + PeriodicReportRow a MixedAmount -> [[T.Text]] +multiBalanceRowAsCsvText opts colspans allCommodities = map (map (wbToText . Ods.cellContent)) . - multiBalanceRowAsCellBuilders machineFmt opts colspans + multiBalanceRowAsCellBuilders machineFmt opts colspans allCommodities Value simpleDateSpanCell diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index cfc7e8d5e4d..d63792c8623 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -23,6 +23,7 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB +import qualified Data.Set as Set import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq) import qualified System.IO as IO @@ -285,12 +286,14 @@ compoundBalanceReportAsText ropts (CompoundPeriodicReport title _colspans subrep -- [COL1LINE1, COL2LINE1] -- [COL1LINE2, COL2LINE2] -- ] - coltotalslines = multiBalanceRowAsText ropts totalsrow + coltotalslines = multiBalanceRowAsText ropts allCommodities totalsrow totalstable = Table (Group NoLine $ map Header $ "Net:" : replicate (length coltotalslines - 1) "") -- row headers (Header []) -- column headers, concatTables will discard these coltotalslines -- cell values + allCommodities = allCommoditiesFromSubreports subreports + -- | Convert a named multi balance report to a table suitable for -- concatenating with others to make a compound balance report table. subreportAsTable ropts1 (title1, r, _) = tablewithtitle @@ -355,14 +358,21 @@ compoundBalanceReportAsSpreadsheet fmt accountLabel maybeBlank ropts cbr = _ -> [] dataHeaders = (guard (layout_ ropts /= LayoutTidy) >>) $ - map (Spr.headerCell . reportPeriodName (balanceaccum_ ropts) colspans) + map (dataHeaderCell . reportPeriodName (balanceaccum_ ropts) colspans) colspans ++ - (guard (multiBalanceHasTotalsColumn ropts) >> [Spr.headerCell "Total"]) ++ - (guard (average_ ropts) >> [Spr.headerCell "Average"]) + (guard (multiBalanceHasTotalsColumn ropts) >> [dataHeaderCell "Total"]) ++ + (guard (average_ ropts) >> [dataHeaderCell "Average"]) + dataHeaderCell label = + (Spr.headerCell label) {Spr.cellSpan = Spr.SpanHorizontal numSubColumns} headerrow = leadingHeaders ++ dataHeaders blankrow = fmap (Spr.horizontalSpan headerrow . Spr.defaultCell) maybeBlank + numSubColumns = + case layout_ ropts of + LayoutBareWide -> length allCommodities + _ -> 1 + allCommodities = allCommoditiesFromSubreports subreports -- Make rows for a subreport: its title row, not the headings row, -- the data rows, any totals row, and a blank row for whitespace. @@ -371,14 +381,18 @@ compoundBalanceReportAsSpreadsheet fmt accountLabel maybeBlank ropts cbr = subreportrows (subreporttitle, mbr, _increasestotal) = let (_, bodyrows, mtotalsrows) = - multiBalanceReportAsSpreadsheetParts fmt ropts mbr - - in - Spr.horizontalSpan headerrow - ((Spr.defaultCell subreporttitle){ + multiBalanceReportAsSpreadsheetParts fmt ropts allCommodities mbr + accountCell = + (Spr.defaultCell subreporttitle) { Spr.cellStyle = Spr.Body Spr.Total, Spr.cellClass = Spr.Class "account" - }) : + } + + in + (case layout_ ropts of + LayoutBareWide -> + accountCell : map Spr.headerCell (dataHeaders >> allCommodities) + _ -> Spr.horizontalSpan headerrow accountCell) : bodyrows ++ mtotalsrows ++ maybeToList blankrow ++ @@ -387,7 +401,7 @@ compoundBalanceReportAsSpreadsheet fmt accountLabel maybeBlank ropts cbr = totalrows = if no_total_ ropts || length subreports == 1 then [] else - multiBalanceRowAsCellBuilders fmt ropts colspans + multiBalanceRowAsCellBuilders fmt ropts colspans allCommodities Total simpleDateSpanCell totalrow -- make a table of rendered lines of the report totals row & map (map (fmap wbToText)) @@ -399,3 +413,10 @@ compoundBalanceReportAsSpreadsheet fmt accountLabel maybeBlank ropts cbr = in (title, ((Just 1, Just 1), headerrow :| concatMap subreportrows subreports ++ totalrows)) + +allCommoditiesFromSubreports :: + [(text, PeriodicReport a MixedAmount, bool)] -> [CommoditySymbol] +allCommoditiesFromSubreports = + Set.toAscList . + foldMap (\(_,mbr,_) -> + foldMap (foldMap maCommodities . prrAmounts) $ prRows mbr)