bal/bs/bse/cf/is: basic HTML output

hledger/Hledger/Cli/CliOptions.hs

@@ -161,7 +161,7 @@ reportflags = [
 
 -- | Common output-related flags: --output-file, --output-format...
 outputflags = [outputFormatFlag, outputFileFlag]
-outputFormatFlag = flagReq  ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats:\ntxt, csv."
+outputFormatFlag = flagReq  ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats:\ntxt, csv, html."
 outputFileFlag   = flagReq  ["output-file","o"]   (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE. A file extension matching one of the above formats selects that format."
 
 argsFlag :: FlagHelp -> Arg RawOpts
@@ -524,6 +524,7 @@ defaultOutputFormat = "txt"
 outputFormats =
   [defaultOutputFormat] ++
   ["csv"
+  ,"html"
   ]
 
 -- | Get the output format from the --output-format option,

hledger/Hledger/Cli/Commands/Balance.hs

@@ -233,6 +233,8 @@ Currently, empty cells show 0.
 -}
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Hledger.Cli.Commands.Balance (
   balancemode
@@ -241,6 +243,8 @@ module Hledger.Cli.Commands.Balance (
  ,balanceReportItemAsText
  ,multiBalanceReportAsText
  ,multiBalanceReportAsCsv
+ ,multiBalanceReportAsHtml
+ ,multiBalanceReportHtmlRows
  ,renderBalanceReportTable
  ,balanceReportAsTable
  ,tests_Hledger_Cli_Commands_Balance
@@ -249,10 +253,11 @@ module Hledger.Cli.Commands.Balance (
 import Data.List (intercalate, nub)
 import Data.Maybe
 import qualified Data.Map as Map
--- import Data.Monoid
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
 import System.Console.CmdArgs.Explicit as C
 import Data.Decimal (roundTo)
+import Lucid as L
 import Text.CSV
 import Test.HUnit
 import Text.Printf (printf)
@@ -321,6 +326,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
                 | otherwise = balanceReport ropts (queryFromOpts d ropts) j
               render = case format of
                 "csv"  -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
+                "html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report."  -- TODO
                 _      -> balanceReportAsText
           writeOutput opts $ render ropts report
           
@@ -332,6 +338,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
               render = case format of
                 -- XXX: implement csv rendering
                 "csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
+                "html" -> const $ error' "Sorry, HTML output is not yet implemented for this kind of report."  -- TODO
                 _     -> multiBalanceReportWithBudgetAsText ropts budgetReport
           writeOutput opts $ render report
           
@@ -339,6 +346,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
           let report = multiBalanceReport ropts (queryFromOpts d ropts) j
               render = case format of
                 "csv"  -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
+                "html" ->  (++ "\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts
                 _      -> multiBalanceReportAsText ropts
           writeOutput opts $ render report
 
@@ -509,11 +517,13 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
 -- multi-column balance reports
 
 -- | Render a multi-column balance report as CSV.
+-- The CSV will always include the initial headings row,
+-- and will include the final totals row unless --no-total is set.
 multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
 multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
-  ("account" : map showDateSpan colspans
-   ++ (if row_total_ opts then ["total"] else [])
-   ++ (if average_ opts then ["average"] else [])
+  ("Account" : map showDateSpan colspans
+   ++ (if row_total_ opts then ["Total"] else [])
+   ++ (if average_ opts then ["Average"] else [])
   ) :
   [T.unpack a :
    map showMixedAmountOneLineWithoutPrice
@@ -524,13 +534,49 @@ multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,to
   ++
   if no_total_ opts
   then []
-  else [["totals"]
+  else [["Total:"]
         ++ map showMixedAmountOneLineWithoutPrice (
            coltotals
            ++ (if row_total_ opts then [tot] else [])
            ++ (if average_ opts then [avg] else [])
            )]
 
+-- | Render a multi-column balance report as HTML.
+multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html ()
+multiBalanceReportAsHtml ropts mbr =
+  let
+    (headingsrow,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
+  in
+    table_ $ mconcat $
+         [headingsrow]
+      ++ bodyrows
+      ++ maybe [] (:[]) mtotalsrow
+
+-- | Render the HTML table rows for a MultiBalanceReport.
+-- Returns the heading row, 0 or more body rows, and the totals row if enabled.
+multiBalanceReportHtmlRows :: ReportOpts -> MultiBalanceReport -> (Html (), [Html ()], Maybe (Html ()))
+multiBalanceReportHtmlRows ropts mbr =
+  let
+    headingsrow:rest = multiBalanceReportAsCsv ropts mbr
+    (bodyrows, mtotalsrow) | no_total_ ropts = (rest,      Nothing)
+                           | otherwise       = (init rest, Just $ last rest)
+  in
+    (thRow headingsrow
+    ,map multiBalanceReportHtmlBodyRow bodyrows
+    ,thRow <$> mtotalsrow
+    )
+
+-- | Render one MultiBalanceReport data row as a HTML table row.
+multiBalanceReportHtmlBodyRow :: [String] -> Html ()
+multiBalanceReportHtmlBodyRow [] = mempty  -- shouldn't happen
+multiBalanceReportHtmlBodyRow (acct:amts) =
+  tr_ $ mconcat $
+    td_ (toHtml acct) :
+    [td_ [style_ "text-align:right"] (toHtml amt) | amt <- amts]
+
+thRow :: [String] -> Html ()
+thRow = tr_ . mconcat . map (th_ . toHtml)
+
 -- | Render a multi-column balance report as plain text suitable for console output.
 multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
 multiBalanceReportAsText opts r =

hledger/Hledger/Cli/Commands/Print.hs

@@ -60,6 +60,7 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do
       fmt = outputFormatFromOpts opts
       (render, ropts') = case fmt of
         "csv"  -> ((++"\n") . printCSV . entriesReportAsCsv, ropts{accountlistmode_=ALFlat})
+        "html" -> (const $ error' "Sorry, HTML output is not yet implemented for this kind of report.", ropts{accountlistmode_=ALFlat})  -- TODO
         _      -> (entriesReportAsText opts,                 ropts)
   writeOutput opts $ render $ entriesReport ropts' q j
 

hledger/Hledger/Cli/Commands/Register.hs

@@ -62,6 +62,7 @@ register opts@CliOpts{reportopts_=ropts} j = do
   d <- getCurrentDay
   let fmt = outputFormatFromOpts opts
       render | fmt=="csv"  = const ((++"\n") . printCSV . postingsReportAsCsv)
+             | fmt=="html" = const $ error' "Sorry, HTML output is not yet implemented for this kind of report."  -- TODO
              | otherwise   = postingsReportAsText
   writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
 

hledger/Hledger/Cli/CompoundBalanceCommand.hs

@@ -15,9 +15,12 @@ module Hledger.Cli.CompoundBalanceCommand (
 import Data.List (intercalate, foldl')
 import Data.Maybe (fromMaybe)
 import Data.Monoid (Sum(..), (<>))
+import qualified Data.Text
+import qualified Data.Text.Lazy as TL
 import Data.Tuple.HT (uncurry3)
 import System.Console.CmdArgs.Explicit as C
 import Text.CSV
+import Lucid as L
 import Text.Tabular as T
 
 import Hledger
@@ -182,6 +185,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd,
         writeOutput opts $
           case format of
             "csv"  -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
+            "html" -> (++ "\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
             _      -> compoundBalanceReportAsText ropts' cbr
 
 -- | Run one subreport for a compound balance command in single-column mode.
@@ -348,3 +352,54 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand
              ++ (if average_ ropts   then [grandavg]   else [])
              )
           ])
+
+-- | Render a compound balance report as HTML.
+compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
+compoundBalanceReportAsHtml ropts cbr =
+  let
+    (title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr
+    colspanattr = colspan_ $ Data.Text.pack $ show $ length colspans + 1
+    leftattr = style_ "text-align:left"
+    blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw ("&nbsp;"::String)
+
+    titlerows =
+         [tr_ $ th_ [colspanattr, leftattr] $ toHtml title]
+      ++ [thRow $
+          "" :
+          map showDateSpan colspans
+          ++ (if row_total_ ropts then ["Total"] else [])
+          ++ (if average_ ropts then ["Average"] else [])
+          ]
+
+    -- Make rows for a subreport: its title row, not the headings row,
+    -- the data rows, any totals row, and a blank row for whitespace.
+    subreportrows :: (String, MultiBalanceReport) -> [Html ()]
+    subreportrows (subreporttitle, mbr) =
+      let
+        (_,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
+      in
+           [tr_ $ th_ [colspanattr, leftattr] $ toHtml subreporttitle]
+        ++ bodyrows
+        ++ maybe [] (:[]) mtotalsrow
+        ++ [blankrow]
+
+    totalrows | no_total_ ropts || length subreports == 1 = []
+              | otherwise =
+                  [thRow $
+                    "Grand Total:" :
+                    map showMixedAmountOneLineWithoutPrice (
+                       coltotals
+                       ++ (if row_total_ ropts then [grandtotal] else [])
+                       ++ (if average_ ropts   then [grandavg]   else [])
+                       )
+                  ]
+  in
+    table_ $ mconcat $
+         titlerows
+      ++ [blankrow]
+      ++ concatMap subreportrows subreports
+      ++ totalrows
+
+thRow :: [String] -> Html ()
+thRow = tr_ . mconcat . map (th_ . toHtml)
+

hledger/hledger.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b3929eebc33ec5bd2e240d49c003aba48ddc1d4f0e9a09ca2e8161d531bd9fb3
+-- hash: cb1407ac28a973e8fc74c9e78c06c2c29715873a64eb4586417cf02d12bfa60f
 
 name:           hledger
 version:        1.5.99
@@ -97,6 +97,7 @@ library
     , haskeline >=0.6
     , here
     , hledger-lib >=1.5.99 && <1.6
+    , lucid
     , megaparsec >=5.0
     , mtl
     , mtl-compat

hledger/package.yaml

@@ -138,6 +138,7 @@ library:
   - hashable >=1.2.4
   - haskeline >=0.6
   - HUnit
+  - lucid
   - mtl
   - mtl-compat
   - old-time