cli: lib: Write.Spreadsheet: common data types for Write.Ods and Write.Html

Write.Html: write spreadsheet data to a HTML table

enables HTML export for the balance command

hledger-lib/Hledger/Write/Html.hs

@@ -0,0 +1,58 @@
+{- |
+Export spreadsheet table data as HTML table.
+
+This is derived from <https://hackage.haskell.org/package/classify-frog-0.2.4.3/src/src/Spreadsheet/Format.hs>
+-}
+module Hledger.Write.Html (
+    printHtml,
+    ) where
+
+import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
+
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text as T
+
+import Text.Printf (printf)
+
+
+printHtml :: [[Cell]] -> TL.Text
+printHtml table =
+    TL.unlines $ map (TL.fromStrict . T.pack) $
+    "<table>" :
+    (table >>= \row ->
+        "<tr>" :
+        (row >>= formatCell) ++
+        "</tr>" :
+        []) ++
+    "</table>" :
+    []
+
+formatCell :: Cell -> [String]
+formatCell cell =
+    (let str = escape $ T.unpack $ cellContent cell in
+     case cellStyle cell of
+        Head -> printf "<th>%s</th>" str
+        Body emph ->
+            let align =
+                    case cellType cell of
+                        TypeString -> ""
+                        _ -> " align=right"
+                (emphOpen, emphClose) =
+                    case emph of
+                        Item -> ("", "")
+                        Total -> ("<b>", "</b>")
+            in  printf "<td%s>%s%s%s</td>" align emphOpen str emphClose) :
+    []
+
+
+escape :: String -> String
+escape =
+    concatMap $ \c ->
+        case c of
+            '\n' -> "<br>"
+            '&' -> "&amp;"
+            '<' -> "&lt;"
+            '>' -> "&gt;"
+            '"' -> "&quot;"
+            '\'' -> "&apos;"
+            _ -> [c]

hledger-lib/Hledger/Write/Ods.hs

@@ -6,10 +6,14 @@ number formatting, text styles, merged cells, formulas, hyperlinks.
 Currently we support Flat ODS, a plain uncompressed XML format.
 
 This is derived from <https://hackage.haskell.org/package/classify-frog-0.2.4.3/src/src/Spreadsheet/Format.hs>
--}
-module Hledger.Write.Ods where
 
-import Hledger.Data.Types (CommoditySymbol, Amount, AmountPrecision(..))
+-}
+module Hledger.Write.Ods (
+    printFods,
+    ) where
+
+import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
+import Hledger.Data.Types (CommoditySymbol, AmountPrecision(..))
 import Hledger.Data.Types (acommodity, aquantity, astyle, asprecision)
 
 import qualified Data.Text.Lazy as TL
@@ -27,34 +31,6 @@ import qualified System.IO as IO
 import Text.Printf (printf)
 
 
-data Type =
-      TypeString
-    | TypeAmount !Amount
-    | TypeMixedAmount
-    deriving (Eq, Ord, Show)
-
-data Style = Body Emphasis | Head
-    deriving (Eq, Ord, Show)
-
-data Emphasis = Item | Total
-    deriving (Eq, Ord, Show)
-
-data Cell =
-    Cell {
-        cellType :: Type,
-        cellStyle :: Style,
-        cellContent :: Text
-    }
-
-defaultCell :: Cell
-defaultCell =
-    Cell {
-        cellType = TypeString,
-        cellStyle = Body Item,
-        cellContent = T.empty
-    }
-
-
 printFods ::
     IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Cell]]) -> TL.Text
 printFods encoding tables =

hledger-lib/Hledger/Write/Spreadsheet.hs

@@ -0,0 +1,44 @@
+{- |
+Rich data type to describe data in a table.
+This is the basis for ODS and HTML export.
+-}
+module Hledger.Write.Spreadsheet (
+    Type(..),
+    Style(..),
+    Emphasis(..),
+    Cell(..),
+    defaultCell,
+    ) where
+
+import Hledger.Data.Types (Amount)
+
+import qualified Data.Text as T
+import Data.Text (Text)
+
+
+data Type =
+      TypeString
+    | TypeAmount !Amount
+    | TypeMixedAmount
+    deriving (Eq, Ord, Show)
+
+data Style = Body Emphasis | Head
+    deriving (Eq, Ord, Show)
+
+data Emphasis = Item | Total
+    deriving (Eq, Ord, Show)
+
+data Cell =
+    Cell {
+        cellType :: Type,
+        cellStyle :: Style,
+        cellContent :: Text
+    }
+
+defaultCell :: Cell
+defaultCell =
+    Cell {
+        cellType = TypeString,
+        cellStyle = Body Item,
+        cellContent = T.empty
+    }

hledger-lib/hledger-lib.cabal

@@ -87,6 +87,8 @@ library
       Hledger.Read.TimeclockReader
       Hledger.Write.Csv
       Hledger.Write.Ods
+      Hledger.Write.Html
+      Hledger.Write.Spreadsheet
       Hledger.Reports
       Hledger.Reports.ReportOptions
       Hledger.Reports.ReportTypes

hledger-lib/package.yaml

@@ -150,6 +150,8 @@ library:
   - Hledger.Read.TimeclockReader
   - Hledger.Write.Csv
   - Hledger.Write.Ods
+  - Hledger.Write.Html
+  - Hledger.Write.Spreadsheet
   - Hledger.Reports
   - Hledger.Reports.ReportOptions
   - Hledger.Reports.ReportTypes

hledger/Hledger/Cli/Commands/Balance.hs

@@ -248,7 +248,7 @@ module Hledger.Cli.Commands.Balance (
   -- ** balance output rendering
  ,balanceReportAsText
  ,balanceReportAsCsv
- ,balanceReportAsFods
+ ,balanceReportAsSpreadsheet
  ,balanceReportItemAsText
  ,multiBalanceRowAsCsvText
  ,multiBalanceRowAsText
@@ -305,7 +305,8 @@ import Hledger.Cli.CliOptions
 import Hledger.Cli.Utils
 import Hledger.Write.Csv (CSV, printCSV, printTSV)
 import Hledger.Write.Ods (printFods)
-import qualified Hledger.Write.Ods as Ods
+import Hledger.Write.Html (printHtml)
+import qualified Hledger.Write.Spreadsheet as Ods
 
 
 -- | Command line options for this command.
@@ -402,9 +403,9 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
               "txt"  -> \ropts1 -> TB.toLazyText . balanceReportAsText ropts1
               "csv"  -> \ropts1 -> printCSV . balanceReportAsCsv ropts1
               "tsv"  -> \ropts1 -> printTSV . balanceReportAsCsv ropts1
-              -- "html" -> \ropts -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts . balanceReportAsMultiBalanceReport ropts
+              "html" -> \ropts1 -> printHtml . balanceReportAsSpreadsheet ropts1
               "json" -> const $ (<>"\n") . toJsonText
-              "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsFods ropts1
+              "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1
               _      -> error' $ unsupportedOutputFormatError fmt  -- PARTIAL:
         writeOutputLazyText opts $ render ropts report
   where
@@ -560,8 +561,8 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus
                   }
 
 -- | Render a single-column balance report as FODS.
-balanceReportAsFods :: ReportOpts -> BalanceReport -> [[Ods.Cell]]
-balanceReportAsFods opts (items, total) =
+balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell]]
+balanceReportAsSpreadsheet opts (items, total) =
     headers :
     concatMap (\(a, _, _, b) -> rows a b) items ++
     if no_total_ opts then []