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)
@@ -320,8 +325,9 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
                     in singleBalanceReport ropts' (queryFromOpts d ropts) j
                 | otherwise = balanceReport ropts (queryFromOpts d ropts) j
               render = case format of
-                "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
+                "csv"  -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
-                _     -> balanceReportAsText
+                "html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report."  -- TODO
+                _      -> balanceReportAsText
           writeOutput opts $ render ropts report
           
         _ | boolopt "budget" rawopts -> do
@@ -332,14 +338,16 @@ 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
           
           | otherwise -> do
           let report = multiBalanceReport ropts (queryFromOpts d ropts) j
               render = case format of
-                "csv" -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
+                "csv"  -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts
-                _     -> multiBalanceReportAsText ropts
+                "html" ->  (++ "\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts
+                _      -> multiBalanceReportAsText ropts
           writeOutput opts $ render report
 
 -- | Re-map account names to closet parent with periodic transaction from budget.
@@ -503,17 +511,19 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
   TotalField       -> fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showamt total))
     where
       showamt | color_ opts = cshowMixedAmountWithoutPrice
-              | otherwise   = showMixedAmountWithoutPrice 
+              | otherwise   = showMixedAmountWithoutPrice
   _                -> ""
 
 -- 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
+  ("Account" : map showDateSpan colspans
-   ++ (if row_total_ opts then ["total"] else [])
+   ++ (if row_total_ opts then ["Total"] else [])
-   ++ (if average_ opts then ["average"] 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 =
@@ -559,16 +605,16 @@ multiBalanceReportWithBudgetAsText opts budget r =
         CumulativeChange -> "Ending balances (cumulative)"
         HistoricalBalance -> "Ending balances (historical)"
     showcell (real, Nothing)     = showamt real
-    showcell (real, Just budget) = 
+    showcell (real, Just budget) =
       case percentage real budget of
         Just pct -> printf "%s [%s%% of %s]" (showamt real) (show $ roundTo 0 pct) (showamt budget)
         Nothing  -> printf "%s [%s]" (showamt real) (showamt budget)
     percentage real budget =
       -- percentage of budget consumed is always computed in the cost basis
       case (toCost real, toCost budget) of
-        (Mixed [a1], Mixed [a2]) 
+        (Mixed [a1], Mixed [a2])
           | isReallyZeroAmount a1 -> Just 0 -- if there are no postings, we consumed 0% of budget
-          | acommodity a1 == acommodity a2 && aquantity a2 /= 0 -> 
+          | acommodity a1 == acommodity a2 && aquantity a2 /= 0 ->
             Just $ 100 * aquantity a1 / aquantity a2
         _ -> Nothing
         where
@@ -582,11 +628,11 @@ multiBalanceReportWithBudgetAsText opts budget r =
     -- Both of these are satisfied by construction of budget report and process of rolling up
     -- account names.
     combine (Table l t d) (Table l' t' d') = Table l t combinedRows
-      where 
+      where
         -- For all accounts that are present in the budget, zip real amounts with budget amounts
-        combinedRows = [ combineRow row budgetRow 
+        combinedRows = [ combineRow row budgetRow
                        | (acct, row) <- zip (headerContents l) d
-                       , let budgetRow = 
+                       , let budgetRow =
                                if acct == "" then [] -- "" is totals row
                                else fromMaybe [] $ Map.lookup acct budgetAccts
                        ]
@@ -594,26 +640,26 @@ multiBalanceReportWithBudgetAsText opts budget r =
         -- Headers for budget row will always be a sublist of headers of row
         combineRow r br =
           let reportRow = zip (headerContents t) r
-              budgetRow = Map.fromList $ zip (headerContents t') br 
+              budgetRow = Map.fromList $ zip (headerContents t') br
-              findBudgetVal hdr = Map.lookup hdr budgetRow 
+              findBudgetVal hdr = Map.lookup hdr budgetRow
           in map (\(hdr, val) -> (val, findBudgetVal hdr)) reportRow
         budgetAccts = Map.fromList $ zip (headerContents l') d'
-                                                           
+
 -- | Given a table representing a multi-column balance report (for example,
 -- made using 'balanceReportAsTable'), render it in a format suitable for
 -- console output.
 renderBalanceReportTable :: ReportOpts -> Table String String MixedAmount -> String
-renderBalanceReportTable ropts = 
+renderBalanceReportTable ropts =
   renderBalanceReportTable' ropts showamt
   where
     showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice
             | otherwise    = showMixedAmountOneLineWithoutPrice
-  
+
 renderBalanceReportTable' :: ReportOpts -> (a -> String) -> Table String String a -> String
-renderBalanceReportTable' (ReportOpts { pretty_tables_ = pretty}) showCell = 
+renderBalanceReportTable' (ReportOpts { pretty_tables_ = pretty}) showCell =
   unlines
   . addtrailingblank
-  . trimborder 
+  . trimborder
   . lines
   . render pretty id id showCell
   . align

hledger/Hledger/Cli/Commands/Print.hs

@@ -59,8 +59,9 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do
   let q = queryFromOpts d ropts
       fmt = outputFormatFromOpts opts
       (render, ropts') = case fmt of
-        "csv" -> ((++"\n") . printCSV . entriesReportAsCsv, ropts{accountlistmode_=ALFlat})
+        "csv"  -> ((++"\n") . printCSV . entriesReportAsCsv, ropts{accountlistmode_=ALFlat})
-        _     -> (entriesReportAsText opts,                 ropts)
+        "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
 
 entriesReportAsText :: CliOpts -> EntriesReport -> String

hledger/Hledger/Cli/Commands/Register.hs

@@ -61,8 +61,9 @@ register :: CliOpts -> Journal -> IO ()
 register opts@CliOpts{reportopts_=ropts} j = do
   d <- getCurrentDay
   let fmt = outputFormatFromOpts opts
-      render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
+      render | fmt=="csv"  = const ((++"\n") . printCSV . postingsReportAsCsv)
-             | otherwise  = postingsReportAsText
+             | 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
 
 postingsReportAsCsv :: PostingsReport -> CSV

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
@@ -181,8 +184,9 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{command_=cmd,
         -- render appropriately
         writeOutput opts $
           case format of
-            "csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
+            "csv"  -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
-            _     -> compoundBalanceReportAsText ropts' cbr
+            "html" -> (++ "\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
+            _      -> 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.
@@ -347,4 +351,55 @@ compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grand
              ++ (if row_total_ ropts then [grandtotal] else [])
              ++ (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