imp: balcmds: improve html output; refactor

The Total: row headings are now configurable in one place,
and currently disabled for text output and enabled for csv & html.

The balance commands' HTML output no longer repeats the "total" and
"Net" headings when the totals row has multiple lines.
And the layout has been improved and made more consistent with the
text output.

hledger/Hledger/Cli/Commands/Balance.hs

@@ -233,16 +233,19 @@ Currently, empty cells show 0.
 
 -}
 
-{-# LANGUAGE ExtendedDefaultRules #-}
-{-# LANGUAGE NamedFieldPuns       #-}
 {-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ExtendedDefaultRules #-}  -- for lucid_
+{-# LANGUAGE FlexibleContexts #-}      -- for stylesheet_
+{-# LANGUAGE NamedFieldPuns       #-}
 {-# LANGUAGE RecordWildCards      #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TemplateHaskell      #-}
 
 module Hledger.Cli.Commands.Balance (
+  -- ** balance command
   balancemode
  ,balance
+  -- ** balance output rendering
  ,balanceReportAsText
  ,balanceReportAsCsv
  ,balanceReportItemAsText
@@ -255,6 +258,22 @@ module Hledger.Cli.Commands.Balance (
  ,multiBalanceReportHtmlFootRow
  ,multiBalanceReportAsTable
  ,multiBalanceReportTableAsText
+  -- ** HTML output helpers
+ ,stylesheet_
+ ,styles_
+ ,bold
+ ,doubleborder
+ ,topdoubleborder
+ ,bottomdoubleborder
+ ,alignright
+ ,alignleft
+ ,aligncenter
+ ,collapse
+ ,lpad
+ ,rpad
+ ,hpad
+ ,vpad
+  -- ** Tests
  ,tests_Balance
 ) where
 
@@ -389,41 +408,22 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
     delimited   = fmt == "csv" || fmt == "tsv"
     fmt         = outputFormatFromOpts opts
 
--- XXX this allows rough HTML rendering of a flat BalanceReport, but it can't handle tree mode etc.
+-- Rendering
--- -- | Convert a BalanceReport to a MultiBalanceReport.
--- balanceReportAsMultiBalanceReport :: ReportOpts -> BalanceReport -> MultiBalanceReport 
--- balanceReportAsMultiBalanceReport _ropts (britems, brtotal) = 
---   let
---     mbrrows = 
---       [PeriodicReportRow{
---           prrName    = flatDisplayName brfullname
---         , prrAmounts = [bramt]
---         , prrTotal   = bramt
---         , prrAverage = bramt
---         }
---       | (brfullname, _, _, bramt) <- britems
---       ]
---   in
---     PeriodicReport{
---         prDates  = [nulldatespan]
---       , prRows   = mbrrows
---       , prTotals = PeriodicReportRow{
---            prrName=()
---           ,prrAmounts=[brtotal]
---           ,prrTotal=brtotal
---           ,prrAverage=brtotal
---           }
---       }
 
--- XXX should all the per-report, per-format rendering code live in the command module,
+-- What to show as heading for the totals row in balance reports ?
--- like the below, or in the report module, like budgetReportAsText/budgetReportAsCsv ?
+-- Currently nothing in terminal, Total: in html and xSV output.
+totalRowHeadingText       = ""
+totalRowHeadingBudgetText = ""
+totalRowHeadingHtml       = "Total:"
+totalRowHeadingCsv        = "Total:"
+totalRowHeadingBudgetCsv  = "Total:"
 
--- rendering single-column balance reports
+-- Single-column balance reports
 
 -- | Render a single-column balance report as CSV.
 balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
 balanceReportAsCsv opts (items, total) =
-    headers : concatMap (\(a, _, _, b) -> rows a b) items ++ if no_total_ opts then [] else rows "Total:" total
+    headers : concatMap (\(a, _, _, b) -> rows a b) items ++ if no_total_ opts then [] else rows totalRowHeadingCsv total
   where
     headers = "account" : case layout_ opts of
       LayoutBare -> ["commodity", "balance"]
@@ -552,7 +552,7 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus
                   ,displayColour    = color_ opts
                   }
 
--- rendering multi-column balance reports
+-- Multi-column balance reports
 
 -- | Render a multi-column balance report as CSV.
 -- The CSV will always include the initial headings row,
@@ -580,16 +580,34 @@ multiBalanceReportAsCsvHelper ishtml opts@ReportOpts{..} (PeriodicReport colspan
       where showName = accountNameDrop drop_ . prrFullName
     totalrows
       | no_total_ = mempty
-      | ishtml    = zipWith (:) ("Total:":repeat "") $ rowAsText opts colspans tr
+      | ishtml    = zipWith (:) (totalRowHeadingHtml : repeat "") $ rowAsText opts colspans tr
-      | otherwise = map ("Total:" :)                 $ rowAsText opts colspans tr
+      | otherwise = map (totalRowHeadingCsv :)                    $ rowAsText opts colspans tr
     rowAsText = if ishtml then multiBalanceRowAsHtmlText else multiBalanceRowAsCsvText
 
+-- Helpers and CSS styles for HTML output.
+
+stylesheet_ elstyles = style_ $ T.unlines $ "" : [el<>" {"<>styles<>"}" | (el,styles) <- elstyles]
+styles_ = style_ . T.intercalate "; "
+bold = "font-weight:bold"
+doubleborder = "double black"
+topdoubleborder    = "border-top:"<>doubleborder
+bottomdoubleborder = "border-bottom:"<>doubleborder
+alignright  = "text-align:right"
+alignleft   = "text-align:left"
+aligncenter = "text-align:center"
+collapse = "border-collapse:collapse"
+lpad = "padding-left:1em"
+rpad = "padding-right:1em"
+hpad = "padding-left:1em; padding-right:1em"
+vpad = "padding-top:1em;  padding-bottom:1em"
+
 -- | Render a multi-column balance report as HTML.
 multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html ()
 multiBalanceReportAsHtml ropts mbr =
   let
     (headingsrow,bodyrows,mtotalsrows) = multiBalanceReportHtmlRows ropts mbr
-  in
+  in do
+    stylesheet_ [("table",collapse), ("th, td",lpad), ("th.account, td.account","padding-left:0;")]
     table_ $ mconcat $
          [headingsrow]
       ++ bodyrows
@@ -607,7 +625,11 @@ multiBalanceReportHtmlRows ropts mbr =
   in
     (multiBalanceReportHtmlHeadRow ropts headingsrow
     ,map (multiBalanceReportHtmlBodyRow ropts) bodyrows
-    ,multiBalanceReportHtmlFootRow ropts <$> mtotalsrows -- TODO pad totals row with zeros when there are
+    ,zipWith3 ($)
+      (repeat (multiBalanceReportHtmlFootRow ropts))
+      (True : repeat False)  -- mark the first html table row for special styling
+      mtotalsrows
+      -- TODO pad totals row with zeros when there are
     )
 
 -- | Render one MultiBalanceReport heading row as a HTML table row.
@@ -615,7 +637,6 @@ multiBalanceReportHtmlHeadRow :: ReportOpts -> [T.Text] -> Html ()
 multiBalanceReportHtmlHeadRow _ [] = mempty  -- shouldn't happen
 multiBalanceReportHtmlHeadRow ropts (acct:cells) =
   let
-    defstyle = style_ ""
     (amts,tot,avg)
       | row_total_ ropts && average_ ropts = (ini2,  sndlst2, lst2)
       | row_total_ ropts                   = (ini1,  lst1,    [])
@@ -629,17 +650,16 @@ multiBalanceReportHtmlHeadRow ropts (acct:cells) =
 
   in
     tr_ $ mconcat $
-          td_ [class_ "account"]              (toHtml acct)
+          th_ [styles_ [bottomdoubleborder,alignleft], class_ "account"]    (toHtml acct)
-       : [td_ [class_ "", defstyle]           (toHtml a) | a <- amts]
+       : [th_ [styles_ [bottomdoubleborder,alignright], class_ ""]           (toHtml a) | a <- amts]
-      ++ [td_ [class_ "rowtotal", defstyle]   (toHtml a) | a <- tot]
+      ++ [th_ [styles_ [bottomdoubleborder,alignright], class_ "rowtotal"]   (toHtml a) | a <- tot]
-      ++ [td_ [class_ "rowaverage", defstyle] (toHtml a) | a <- avg]
+      ++ [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
-    defstyle = style_ "text-align:right"
     (amts,tot,avg)
       | row_total_ ropts && average_ ropts = (ini2,  sndlst2, lst2)
       | row_total_ ropts                   = (ini1,  lst1,    [])
@@ -652,23 +672,22 @@ multiBalanceReportHtmlBodyRow ropts (label:cells) =
         (sndlst2,lst2) = splitAt 1 rest
   in
     tr_ $ mconcat $
-          td_ [class_ "account", style_ "text-align:left"]  (toHtml label)
+          td_ [styles_ [],  class_ "account"]           (toHtml label)
-       : [td_ [class_ "amount", defstyle]            (toHtml a) | a <- amts]
+       : [td_ [styles_ [alignright], class_ "amount"]            (toHtml a) | a <- amts]
-      ++ [td_ [class_ "amount rowtotal", defstyle]   (toHtml a) | a <- tot]
+      ++ [td_ [styles_ [alignright], class_ "amount rowtotal"]   (toHtml a) | a <- tot]
-      ++ [td_ [class_ "amount rowaverage", defstyle] (toHtml a) | a <- avg]
+      ++ [td_ [styles_ [alignright], class_ "amount rowaverage"] (toHtml a) | a <- avg]
 
 -- | Render one MultiBalanceReport totals row as a HTML table row.
-multiBalanceReportHtmlFootRow :: ReportOpts -> [T.Text] -> Html ()
+multiBalanceReportHtmlFootRow :: ReportOpts -> Bool -> [T.Text] -> Html ()
-multiBalanceReportHtmlFootRow _ropts [] = mempty
+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 (acct:cells) =
+multiBalanceReportHtmlFootRow ropts isfirstline (hdr:cells) =
   let
-    defstyle = style_ "text-align:right"
     (amts,tot,avg)
       | row_total_ ropts && average_ ropts = (ini2,  sndlst2, lst2)
       | row_total_ ropts                   = (ini1,  lst1,    [])
@@ -681,10 +700,10 @@ multiBalanceReportHtmlFootRow ropts (acct:cells) =
         (sndlst2,lst2) = splitAt 1 rest
   in
     tr_ $ mconcat $
-          th_ [style_ "text-align:left"]             (toHtml acct)
+          td_ [styles_ $ [topdoubleborder | isfirstline] ++ [bold], class_ "account"]                 (toHtml hdr)
-       : [th_ [class_ "amount coltotal", defstyle]   (toHtml a) | a <- amts]
+       : [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount coltotal"]   (toHtml a) | a <- amts]
-      ++ [th_ [class_ "amount coltotal", defstyle]   (toHtml a) | a <- tot]
+      ++ [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount coltotal"]   (toHtml a) | a <- tot]
-      ++ [th_ [class_ "amount colaverage", defstyle] (toHtml a) | a <- avg]
+      ++ [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount colaverage"] (toHtml a) | a <- avg]
 
 --thRow :: [String] -> Html ()
 --thRow = tr_ . mconcat . map (th_ . toHtml)
@@ -771,7 +790,7 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, b
       | no_total_ opts = id
       | otherwise =
         let totalrows = multiBalanceRowAsText opts tr
-            rowhdrs = Group NoLine $ map Header $ "Total:" : replicate (length totalrows - 1) ""
+            rowhdrs = Group NoLine $ map Header $ totalRowHeadingText : replicate (length totalrows - 1) ""
             colhdrs = Header [] -- unused, concatTables will discard
         in (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows)
     maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals)
@@ -830,6 +849,7 @@ multiBalanceRowAsCsvText opts colspans = fmap (fmap wbToText) . multiBalanceRowA
 multiBalanceRowAsHtmlText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]]
 multiBalanceRowAsHtmlText opts colspans = fmap (fmap wbToText) . multiBalanceRowAsTextBuilders oneLineNoCostFmt opts colspans
 
+-- Budget reports
 
 -- A BudgetCell's data values rendered for display - the actual change amount,
 -- the budget goal amount if any, and the corresponding goal percentage if possible.
@@ -883,7 +903,7 @@ budgetReportAsTable ReportOpts{..} (PeriodicReport spans items totrow) =
       | no_total_ = id
       | otherwise =
         let 
-          rowhdrs = Group NoLine . replicate (length totalrows) $ Header ""
+          rowhdrs = Group NoLine $ map Header $ totalRowHeadingBudgetText : replicate (length totalrows - 1) ""
           colhdrs = Header [] -- ignored by concatTables
         in
           (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows)  -- XXX ?
@@ -1099,7 +1119,7 @@ budgetReportAsCsv
   concatMap (rowAsTexts prrFullName) items
 
   -- totals row
-  ++ concat [ rowAsTexts (const "Total:") totrow | not no_total_ ]
+  ++ concat [ rowAsTexts (const totalRowHeadingBudgetCsv) totrow | not no_total_ ]
 
   where
     flattentuples tups = concat [[a,b] | (a,b) <- tups]

hledger/Hledger/Cli/CompoundBalanceCommand.hs

@@ -30,6 +30,7 @@ import Hledger.Cli.Commands.Balance
 import Hledger.Cli.CliOptions
 import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText)
 import Data.Function ((&))
+import Control.Monad (when)
 
 -- | Description of a compound balance report command,
 -- from which we generate the command's cmdargs mode and IO action.
@@ -315,16 +316,14 @@ compoundBalanceReportAsHtml ropts cbr =
     blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw (" "::String)
 
     titlerows =
-      (tr_ $ th_ [colspanattr, leftattr] $ h2_ $ toHtml title)
+      [tr_ $ th_ [colspanattr, leftattr] $ h2_ $ toHtml title
-      : [thRow $
+      ,tr_ $ do
-         "" : ["Commodity" | layout_ ropts == LayoutBare] ++
+          th_ ""
-         map (reportPeriodName (balanceaccum_ ropts) colspans) colspans
+          when (layout_ ropts == LayoutBare) $ th_ "Commodity"
-         ++ (if row_total_ ropts then ["Total"] else [])
+          mconcat $ map (th_ [style_ alignright] . toHtml . reportPeriodName (balanceaccum_ ropts) colspans) colspans
-         ++ (if average_ ropts then ["Average"] else [])
+          th_ $ if row_total_ ropts then "Total"   else ""
-        ]
+          th_ $ if average_ ropts   then "Average" else ""
-
+      ]
-    thRow :: [T.Text] -> Html ()
-    thRow = tr_ . mconcat . map (th_ . toHtml)
 
     -- Make rows for a subreport: its title row, not the headings row,
     -- the data rows, any totals row, and a blank row for whitespace.
@@ -333,7 +332,7 @@ compoundBalanceReportAsHtml ropts cbr =
       let
         (_,bodyrows,mtotalsrows) = multiBalanceReportHtmlRows ropts mbr
       in
-           [tr_ $ th_ [colspanattr, leftattr] $ toHtml subreporttitle]
+           [tr_ $ th_ [colspanattr, leftattr, class_ "account"] $ toHtml subreporttitle]
         ++ bodyrows
         ++ mtotalsrows
         ++ [blankrow]
@@ -343,15 +342,20 @@ compoundBalanceReportAsHtml ropts cbr =
       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
-        & map (multiBalanceReportHtmlFootRow ropts)       -- convert to a list of HTML totals rows
+        & 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)
 
   in do
-    style_ (T.unlines [""
-      ,"td { padding:0 0.5em; }"
-      ,"td:nth-child(1) { white-space:nowrap; }"
-      ,"tr:nth-child(even) td { background-color:#eee; }"
-      ])
     link_ [rel_ "stylesheet", href_ "hledger.css"]
+    stylesheet_ [
+      ("table",collapse),
+      ("th, td",lpad),
+      ("th.account, td.account","padding-left:0;"),
+      ("td:nth-child(1)", "white-space:nowrap"),
+      ("tr:nth-child(even) td", "background-color:#eee")
+      ]
     table_ $ mconcat $
          titlerows
       ++ [blankrow]