From ff397f79cc70a0ad061ec7b591dc9985a9ac16c6 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Thu, 5 Sep 2024 09:51:20 +0200 Subject: [PATCH] lib: Write.Spreadsheet.Cell: add cellClass field for HTML style class cmd: Commands.Balance.multiBalanceRowAsCellBuilders: add HTML style class attributes here This way we do not need to dissect table rows in multiBalanceReportHtmlHeadRow, multiBalanceReportHtmlBodyRow, multiBalanceReportHtmlFootRow Eventually removed these three functions. --- hledger-lib/Hledger/Write/Html.hs | 18 +- hledger-lib/Hledger/Write/Spreadsheet.hs | 13 +- hledger/Hledger/Cli/Commands/Balance.hs | 254 +++++++++--------- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 16 +- 4 files changed, 159 insertions(+), 142 deletions(-) diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs index fba93f362..90e147436 100644 --- a/hledger-lib/Hledger/Write/Html.hs +++ b/hledger-lib/Hledger/Write/Html.hs @@ -6,6 +6,8 @@ This is derived from [[Cell border (Lucid.Html ())]] -> Lucid.Html () @@ -26,9 +28,10 @@ printHtml table = do "th, td {padding-left:1em}" : "th.account, td.account {padding-left:0;}" : [] - Lucid.table_ $ for_ table $ \row -> - Lucid.tr_ $ for_ row $ \cell -> - formatCell cell + Lucid.table_ $ traverse_ formatRow table + +formatRow:: (Lines border) => [Cell border (Lucid.Html ())] -> Lucid.Html () +formatRow = Lucid.tr_ . traverse_ formatCell formatCell :: (Lines border) => Cell border (Lucid.Html ()) -> Lucid.Html () formatCell cell = @@ -43,8 +46,11 @@ formatCell cell = case leftBorder++rightBorder++topBorder++bottomBorder of [] -> [] ss -> [Lucid.style_ $ Text.intercalate "; " ss] in + let class_ = + map Lucid.class_ $ + filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in case cellStyle cell of - Head -> Lucid.th_ style str + Head -> Lucid.th_ (style++class_) str Body emph -> let align = case cellType cell of @@ -55,7 +61,7 @@ formatCell cell = case emph of Item -> id Total -> Lucid.b_ - in Lucid.td_ (style++align) $ withEmph str + in Lucid.td_ (style++align++class_) $ withEmph str class (Spr.Lines border) => Lines border where diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs index c3e4cb205..6c3a0e583 100644 --- a/hledger-lib/Hledger/Write/Spreadsheet.hs +++ b/hledger-lib/Hledger/Write/Spreadsheet.hs @@ -7,6 +7,7 @@ module Hledger.Write.Spreadsheet ( Style(..), Emphasis(..), Cell(..), + Class(Class), textFromClass, Border(..), Lines(..), NumLines(..), @@ -20,6 +21,7 @@ module Hledger.Write.Spreadsheet ( import Hledger.Data.Types (Amount) import qualified Data.List as List +import Data.Text (Text) data Type = @@ -75,17 +77,23 @@ transposeBorder (Border left right top bottom) = Border top bottom left right +newtype Class = Class Text + +textFromClass :: Class -> Text +textFromClass (Class cls) = cls + data Cell border text = Cell { cellType :: Type, cellBorder :: Border border, cellStyle :: Style, + cellClass :: Class, cellContent :: text } instance Functor (Cell border) where - fmap f (Cell typ border style content) = - Cell typ border style $ f content + fmap f (Cell typ border style class_ content) = + Cell typ border style class_ $ f content defaultCell :: (Lines border) => text -> Cell border text defaultCell text = @@ -93,6 +101,7 @@ defaultCell text = cellType = TypeString, cellBorder = noBorder, cellStyle = Body Item, + cellClass = Class mempty, cellContent = text } diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 53455b480..2c734ba7f 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -250,16 +250,18 @@ module Hledger.Cli.Commands.Balance ( ,balanceReportAsCsv ,balanceReportAsSpreadsheet ,balanceReportItemAsText + ,multiBalanceRowAsCellBuilders ,multiBalanceRowAsCsvText ,multiBalanceRowAsText ,multiBalanceReportAsText ,multiBalanceReportAsCsv ,multiBalanceReportAsHtml ,multiBalanceReportHtmlRows - ,multiBalanceReportHtmlFootRow ,multiBalanceReportAsTable ,multiBalanceReportTableAsText ,multiBalanceReportAsSpreadsheet + ,addTotalBorders + ,RowClass(..) -- ** HTML output helpers ,stylesheet_ ,styles_ @@ -279,14 +281,14 @@ module Hledger.Cli.Commands.Balance ( ,tests_Balance ) where -import Control.Arrow ((***)) +import Control.Arrow (second, (***)) import Data.Decimal (roundTo) import Data.Default (def) import Data.Function (on) import Data.List (find, transpose, foldl') import qualified Data.Map as Map import qualified Data.Set as S -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (mapMaybe, fromMaybe) import Data.Tuple (swap) import Data.Text (Text) import qualified Data.Text as T @@ -308,6 +310,7 @@ import Hledger.Cli.Utils import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Ods (printFods) import Hledger.Write.Html (printHtml) +import qualified Hledger.Write.Html as Html import qualified Hledger.Write.Spreadsheet as Ods @@ -427,6 +430,39 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of -- Rendering +data RowClass = Value | Total + deriving (Eq, Ord, Enum, Bounded, Show) + +amountClass :: RowClass -> Ods.Class +amountClass rc = + Ods.Class $ + case rc of Value -> "amount"; Total -> "amount coltotal" + +budgetClass :: RowClass -> Ods.Class +budgetClass rc = + Ods.Class $ + case rc of Value -> "budget"; Total -> "budget coltotal" + +rowTotalClass :: RowClass -> Ods.Class +rowTotalClass rc = + Ods.Class $ + case rc of Value -> "amount rowtotal"; Total -> "amount coltotal" + +rowAverageClass :: RowClass -> Ods.Class +rowAverageClass rc = + Ods.Class $ + case rc of Value -> "amount rowaverage"; Total -> "amount colaverage" + +budgetTotalClass :: RowClass -> Ods.Class +budgetTotalClass rc = + Ods.Class $ + case rc of Value -> "budget rowtotal"; Total -> "budget coltotal" + +budgetAverageClass :: RowClass -> Ods.Class +budgetAverageClass rc = + Ods.Class $ + case rc of Value -> "budget rowaverage"; Total -> "budget colaverage" + -- What to show as heading for the totals row in balance reports ? -- Currently nothing in terminal, Total: in html and xSV output. totalRowHeadingText = "" @@ -581,9 +617,9 @@ balanceReportAsSpreadsheet :: balanceReportAsSpreadsheet opts (items, total) = (if transpose_ opts then Ods.transpose else id) $ headers : - concatMap (\(a, _, _, b) -> rows a b) items ++ + concatMap (\(a, _, _, b) -> rows Value a b) items ++ if no_total_ opts then [] - else addTotalBorders $ rows totalRowHeadingCsv total + else addTotalBorders $ rows Total totalRowHeadingCsv total where cell = Ods.defaultCell headers = @@ -591,18 +627,21 @@ balanceReportAsSpreadsheet opts (items, total) = "account" : case layout_ opts of LayoutBare -> ["commodity", "balance"] _ -> ["balance"] - rows :: AccountName -> MixedAmount -> [[Ods.Cell Ods.NumLines Text]] - rows name ma = case layout_ opts of + rows :: + RowClass -> AccountName -> + MixedAmount -> [[Ods.Cell Ods.NumLines Text]] + rows rc name ma = case layout_ opts of LayoutBare -> map (\a -> [showName name, cell $ acommodity a, - renderAmount $ mixedAmount a]) + renderAmount rc $ mixedAmount a]) . amounts $ mixedAmountStripCosts ma - _ -> [[showName name, renderAmount ma]] + _ -> [[showName name, renderAmount rc ma]] showName = cell . accountNameDrop (drop_ opts) - renderAmount mixedAmt = wbToText <$> cellFromMixedAmount bopts mixedAmt + renderAmount rc mixedAmt = + wbToText <$> cellFromMixedAmount bopts (amountClass rc, mixedAmt) where bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder} (showcomm, commorder) @@ -611,9 +650,10 @@ balanceReportAsSpreadsheet opts (items, total) = cellFromMixedAmount :: (Ods.Lines border) => - AmountFormat -> MixedAmount -> Ods.Cell border WideBuilder -cellFromMixedAmount bopts mixedAmt = + AmountFormat -> (Ods.Class, MixedAmount) -> Ods.Cell border WideBuilder +cellFromMixedAmount bopts (cls, mixedAmt) = (Ods.defaultCell $ showMixedAmountB bopts mixedAmt) { + Ods.cellClass = cls, Ods.cellType = case unifyMixedAmount mixedAmt of Just amt -> amountType bopts amt @@ -622,11 +662,14 @@ cellFromMixedAmount bopts mixedAmt = cellsFromMixedAmount :: (Ods.Lines border) => - AmountFormat -> MixedAmount -> [Ods.Cell border WideBuilder] -cellsFromMixedAmount bopts mixedAmt = + AmountFormat -> (Ods.Class, MixedAmount) -> [Ods.Cell border WideBuilder] +cellsFromMixedAmount bopts (cls, mixedAmt) = map (\(str,amt) -> - (Ods.defaultCell str) {Ods.cellType = amountType bopts amt}) + (Ods.defaultCell str) { + Ods.cellClass = cls, + Ods.cellType = amountType bopts amt + }) (showMixedAmountLinesPartsB bopts mixedAmt) amountType :: AmountFormat -> Amount -> Ods.Type @@ -665,33 +708,42 @@ multiBalanceReportAsSpreadsheetHelper :: multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport colspans items tr) = (headers : concatMap fullRowAsTexts items, addTotalBorders totalrows) where - cell = Ods.defaultCell + accountCell label = + (Ods.defaultCell label) {Ods.cellClass = Ods.Class "account"} + hCell cls label = (headerCell label) {Ods.cellClass = Ods.Class cls} headers = - map headerCell $ - "account" : + hCell "account" "account" : case layout_ of - LayoutTidy -> ["period", "start_date", "end_date", "commodity", "value"] - LayoutBare -> "commodity" : dateHeaders + LayoutTidy -> + map headerCell + ["period", "start_date", "end_date", "commodity", "value"] + LayoutBare -> headerCell "commodity" : dateHeaders _ -> dateHeaders - dateHeaders = map showDateSpan colspans ++ ["total" | row_total_] ++ ["average" | average_] - fullRowAsTexts row = map (cell (showName row) :) $ rowAsText row + dateHeaders = + map (headerCell . showDateSpan) colspans ++ + [hCell "rowtotal" "total" | row_total_] ++ + [hCell "rowaverage" "average" | average_] + fullRowAsTexts row = + map (accountCell (showName row) :) $ rowAsText Value row where showName = accountNameDrop drop_ . prrFullName totalrows | no_total_ = [] - | ishtml = zipWith (:) (cell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText tr - | otherwise = map (cell totalRowHeadingCsv :) $ rowAsText tr - rowAsText = + | ishtml = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText Total tr + | otherwise = map (accountCell totalRowHeadingCsv :) $ rowAsText Total tr + rowAsText rc = let fmt = if ishtml then oneLineNoCostFmt else machineFmt - in map (map (fmap wbToText)) . multiBalanceRowAsCellBuilders fmt opts colspans + in map (map (fmap wbToText)) . multiBalanceRowAsCellBuilders fmt opts colspans rc -- Helpers and CSS styles for HTML output. stylesheet_ elstyles = style_ $ T.unlines $ "" : [el<>" {"<>styles<>"}" | (el,styles) <- elstyles] +styles_ :: [Text] -> L.Attribute styles_ = style_ . T.intercalate "; " bold = "font-weight:bold" doubleborder = "double black" topdoubleborder = "border-top:"<>doubleborder bottomdoubleborder = "border-bottom:"<>doubleborder +alignright, alignleft, aligncenter :: Text alignright = "text-align:right" alignleft = "text-align:left" aligncenter = "text-align:center" @@ -721,92 +773,21 @@ multiBalanceReportHtmlRows ropts mbr = -- TODO: should the commodity_column be displayed as a subaccount in this case as well? (headingsrow:bodyrows, mtotalsrows) | transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported" -- PARTIAL: - | otherwise = multiBalanceReportAsCsvHelper True ropts mbr + | otherwise = multiBalanceReportAsSpreadsheetHelper True ropts mbr + formatRow = Html.formatRow . map (fmap L.toHtml) in - (multiBalanceReportHtmlHeadRow ropts headingsrow - ,map (multiBalanceReportHtmlBodyRow ropts) bodyrows - ,zipWith3 ($) - (repeat (multiBalanceReportHtmlFootRow ropts)) - (True : repeat False) -- mark the first html table row for special styling - mtotalsrows + (formatRow headingsrow + ,map formatRow bodyrows + ,map formatRow mtotalsrows -- TODO pad totals row with zeros when there are ) --- | Render one MultiBalanceReport heading row as a HTML table row. -multiBalanceReportHtmlHeadRow :: ReportOpts -> [T.Text] -> Html () -multiBalanceReportHtmlHeadRow _ [] = mempty -- shouldn't happen -multiBalanceReportHtmlHeadRow ropts (acct:cells) = - let - (amts,tot,avg) - | row_total_ ropts && average_ ropts = (ini2, sndlst2, lst2) - | row_total_ ropts = (ini1, lst1, []) - | average_ ropts = (ini1, [], lst1) - | otherwise = (cells, [], []) - where - n = length cells - (ini1,lst1) = splitAt (n-1) cells - (ini2, rest) = splitAt (n-2) cells - (sndlst2,lst2) = splitAt 1 rest - - in - tr_ $ mconcat $ - th_ [styles_ [bottomdoubleborder,alignleft], class_ "account"] (toHtml acct) - : [th_ [styles_ [bottomdoubleborder,alignright], class_ ""] (toHtml a) | a <- amts] - ++ [th_ [styles_ [bottomdoubleborder,alignright], class_ "rowtotal"] (toHtml a) | a <- tot] - ++ [th_ [styles_ [bottomdoubleborder,alignright], class_ "rowaverage"] (toHtml a) | a <- avg] - --- | Render one MultiBalanceReport data row as a HTML table row. -multiBalanceReportHtmlBodyRow :: ReportOpts -> [T.Text] -> Html () -multiBalanceReportHtmlBodyRow _ [] = mempty -- shouldn't happen -multiBalanceReportHtmlBodyRow ropts (label:cells) = - let - (amts,tot,avg) - | row_total_ ropts && average_ ropts = (ini2, sndlst2, lst2) - | row_total_ ropts = (ini1, lst1, []) - | average_ ropts = (ini1, [], lst1) - | otherwise = (cells, [], []) - where - n = length cells - (ini1,lst1) = splitAt (n-1) cells - (ini2, rest) = splitAt (n-2) cells - (sndlst2,lst2) = splitAt 1 rest - in - tr_ $ mconcat $ - td_ [styles_ [], class_ "account"] (toHtml label) - : [td_ [styles_ [alignright], class_ "amount"] (toHtml a) | a <- amts] - ++ [td_ [styles_ [alignright], class_ "amount rowtotal"] (toHtml a) | a <- tot] - ++ [td_ [styles_ [alignright], class_ "amount rowaverage"] (toHtml a) | a <- avg] - --- | Render one MultiBalanceReport totals row as a HTML table row. -multiBalanceReportHtmlFootRow :: ReportOpts -> Bool -> [T.Text] -> Html () -multiBalanceReportHtmlFootRow _ _ [] = mempty -- TODO pad totals row with zeros when subreport is empty -- multiBalanceReportHtmlFootRow ropts $ -- "" -- : repeat nullmixedamt zeros -- ++ (if row_total_ ropts then [nullmixedamt] else []) -- ++ (if average_ ropts then [nullmixedamt] else []) -multiBalanceReportHtmlFootRow ropts isfirstline (hdr:cells) = - let - (amts,tot,avg) - | row_total_ ropts && average_ ropts = (ini2, sndlst2, lst2) - | row_total_ ropts = (ini1, lst1, []) - | average_ ropts = (ini1, [], lst1) - | otherwise = (cells, [], []) - where - n = length cells - (ini1,lst1) = splitAt (n-1) cells - (ini2, rest) = splitAt (n-2) cells - (sndlst2,lst2) = splitAt 1 rest - in - tr_ $ mconcat $ - td_ [styles_ $ [topdoubleborder | isfirstline] ++ [bold], class_ "account"] (toHtml hdr) - : [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount coltotal"] (toHtml a) | a <- amts] - ++ [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount coltotal"] (toHtml a) | a <- tot] - ++ [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount colaverage"] (toHtml a) | a <- avg] - ---thRow :: [String] -> Html () ---thRow = tr_ . mconcat . map (th_ . toHtml) -- | Render the ODS table rows for a MultiBalanceReport. @@ -912,37 +893,42 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, b multiColumnTableInterColumnBorder = if pretty_ opts then SingleLine else NoLine multiBalanceRowAsTextBuilders :: AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] -multiBalanceRowAsTextBuilders bopts ropts colspans row = - rawTableContent $ - multiBalanceRowAsCellBuilders bopts ropts colspans row +multiBalanceRowAsTextBuilders bopts ropts colspans = + rawTableContent . + multiBalanceRowAsCellBuilders bopts ropts colspans Value multiBalanceRowAsCellBuilders :: AmountFormat -> ReportOpts -> [DateSpan] -> - PeriodicReportRow a MixedAmount -> [[Ods.Cell Ods.NumLines WideBuilder]] -multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = + RowClass -> PeriodicReportRow a MixedAmount -> + [[Ods.Cell Ods.NumLines WideBuilder]] +multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans + rc (PeriodicReportRow _ as rowtot rowavg) = case layout_ of - LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) allamts] + LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) clsamts] LayoutTall -> paddedTranspose Ods.emptyCell - . fmap (cellsFromMixedAmount bopts{displayMaxWidth=Nothing}) - $ allamts + . map (cellsFromMixedAmount bopts{displayMaxWidth=Nothing}) + $ clsamts LayoutBare -> zipWith (:) (map wbCell cs) -- add symbols . transpose -- each row becomes a list of Text quantities - . fmap (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) - $ allamts + . map (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) + $ clsamts LayoutTidy -> concat . zipWith (map . addDateColumns) colspans - . fmap ( zipWith (\c a -> [wbCell c, a]) cs + . map ( zipWith (\c a -> [wbCell c, a]) cs . cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) - $ as -- Do not include totals column or average for tidy output, as this + $ classified + -- Do not include totals column or average for tidy output, as this -- complicates the data representation and can be easily calculated where wbCell = Ods.defaultCell . wbFromText wbDate content = (wbCell content) {Ods.cellType = Ods.TypeDate} totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts - allamts = (if not summary_only_ then as else []) ++ - [rowtot | totalscolumn && not (null as)] ++ - [rowavg | average_ && not (null as)] + classified = map ((,) (amountClass rc)) as + allamts = map snd clsamts + clsamts = (if not summary_only_ then classified else []) ++ + [(rowTotalClass rc, rowtot) | totalscolumn && not (null as)] ++ + [(rowAverageClass rc, rowavg) | average_ && not (null as)] addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :) . (wbDate (maybe "" showEFDate s) :) . (wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :) @@ -1242,33 +1228,45 @@ budgetReportAsSpreadsheet ) : -- account rows - concatMap (rowAsTexts prrFullName) items + concatMap (rowAsTexts Value prrFullName) items -- totals row ++ addTotalBorders - (concat [ rowAsTexts (const totalRowHeadingBudgetCsv) totrow | not no_total_ ]) + (concat [ rowAsTexts Total (const totalRowHeadingBudgetCsv) totrow | not no_total_ ]) where cell = Ods.defaultCell - flattentuples tups = concat [[a,b] | (a,b) <- tups] - showNorm = maybe Ods.emptyCell (fmap wbToText . cellFromMixedAmount oneLineNoCostFmt) + {- + ToDo: The chosen HTML cell class names are not put in stone. + If you find you need more systematic names, + feel free to develop a more sophisticated scheme. + -} + flattentuples rc tups = + concat [[(amountClass rc, a),(budgetClass rc, b)] | (a,b) <- tups] + showNorm (cls,mval) = + maybe Ods.emptyCell (fmap wbToText . curry (cellFromMixedAmount oneLineNoCostFmt) cls) mval - rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text) + rowAsTexts :: RowClass + -> (PeriodicReportRow a BudgetCell -> Text) -> PeriodicReportRow a BudgetCell -> [[Ods.Cell Ods.NumLines Text]] - rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) + rowAsTexts rc render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) | layout_ /= LayoutBare = [cell (render row) : map showNorm vals] | otherwise = joinNames . zipWith (:) (map cell cs) -- add symbols and names . transpose -- each row becomes a list of Text quantities - . map (map (fmap wbToText) . cellsFromMixedAmount dopts . fromMaybe nullmixedamt) + . map (map (fmap wbToText) . cellsFromMixedAmount dopts . second (fromMaybe nullmixedamt)) $ vals where - cs = S.toList . mconcat . map maCommodities $ catMaybes vals + cs = S.toList . mconcat . map maCommodities $ mapMaybe snd vals dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing} - vals = flattentuples as - ++ concat [[rowtot, budgettot] | row_total_] - ++ concat [[rowavg, budgetavg] | average_] + vals = flattentuples rc as + ++ concat [[(rowTotalClass rc, rowtot), + (budgetTotalClass rc, budgettot)] + | row_total_] + ++ concat [[(rowAverageClass rc, rowavg), + (budgetAverageClass rc, budgetavg)] + | average_] joinNames = map (cell (render row) :) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 5500fe738..1e07d9b20 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -22,6 +22,8 @@ import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq) import Hledger.Write.Csv (CSV, printCSV, printTSV) +import qualified Hledger.Write.Html as Html +import qualified Hledger.Write.Spreadsheet as Spr import Lucid as L hiding (value_) import Safe (tailDef) import Text.Tabular.AsciiWide as Tabular hiding (render) @@ -362,12 +364,14 @@ compoundBalanceReportAsHtml ropts cbr = totalrows = if no_total_ ropts || length subreports == 1 then [] else - multiBalanceRowAsCsvText ropts colspans totalrow -- make a table of rendered lines of the report totals row - & zipWith (:) ("Net:":repeat "") -- insert a headings column, with Net: on the first line only - & zipWith3 -- convert to a list of HTML totals rows, marking the first for special styling - (\f isfirstline r -> f isfirstline r) - (repeat (multiBalanceReportHtmlFootRow ropts)) - (True : repeat False) + multiBalanceRowAsCellBuilders machineFmt ropts colspans Total totalrow + -- make a table of rendered lines of the report totals row + & map (map (fmap wbToText)) + & zipWith (:) (Spr.defaultCell "Net:" : repeat Spr.emptyCell) + -- insert a headings column, with Net: on the first line only + & addTotalBorders -- marking the first for special styling + & map (Html.formatRow . map (fmap L.toHtml)) + -- convert to a list of HTML totals rows in do link_ [rel_ "stylesheet", href_ "hledger.css"]