From f306df6d612b231f1af73429499e57c7c112e5da Mon Sep 17 00:00:00 2001
From: Henning Thielemann <git@henning-thielemann.de>
Date: Sat, 10 Aug 2024 12:04:13 +0200
Subject: [PATCH] imp: lib: Write.Html: use Lucid to generate HTML

---
 hledger-lib/Hledger/Write/Html.hs       | 56 ++++++++-----------------
 hledger-lib/hledger-lib.cabal           |  1 +
 hledger-lib/package.yaml                |  1 +
 hledger/Hledger/Cli/Commands/Balance.hs |  3 +-
 4 files changed, 22 insertions(+), 39 deletions(-)

diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs
index fcbf16cdf..282caa468 100644
--- a/hledger-lib/Hledger/Write/Html.hs
+++ b/hledger-lib/Hledger/Write/Html.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {- |
 Export spreadsheet table data as HTML table.
 
@@ -9,50 +10,29 @@ module Hledger.Write.Html (
 
 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)
+import qualified Lucid.Base as LucidBase
+import qualified Lucid
+import Data.Foldable (for_)
 
 
-printHtml :: [[Cell]] -> TL.Text
+printHtml :: [[Cell]] -> Lucid.Html ()
 printHtml table =
-    TL.unlines $ map (TL.fromStrict . T.pack) $
-    "<table>" :
-    (table >>= \row ->
-        "<tr>" :
-        (row >>= formatCell) ++
-        "</tr>" :
-        []) ++
-    "</table>" :
-    []
+    Lucid.table_ $ for_ table $ \row ->
+    Lucid.tr_ $ for_ row $ \cell ->
+    formatCell cell
 
-formatCell :: Cell -> [String]
+formatCell :: Cell -> Lucid.Html ()
 formatCell cell =
-    (let str = escape $ T.unpack $ cellContent cell in
-     case cellStyle cell of
-        Head -> printf "<th>%s</th>" str
+    let str = Lucid.toHtml $ cellContent cell in
+    case cellStyle cell of
+        Head -> Lucid.th_ str
         Body emph ->
             let align =
                     case cellType cell of
-                        TypeString -> ""
-                        _ -> " align=right"
-                (emphOpen, emphClose) =
+                        TypeString -> []
+                        _ -> [LucidBase.makeAttribute "align" "right"]
+                withEmph =
                     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]
+                        Item -> id
+                        Total -> Lucid.b_
+            in  Lucid.td_ align $ withEmph str
diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal
index 990ddc047..6efe19c8a 100644
--- a/hledger-lib/hledger-lib.cabal
+++ b/hledger-lib/hledger-lib.cabal
@@ -138,6 +138,7 @@ library
     , file-embed >=0.0.10
     , filepath
     , hashtables >=1.2.3.1
+    , lucid
     , megaparsec >=7.0.0 && <9.7
     , microlens >=0.4
     , microlens-th >=0.4
diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml
index 12b8a848c..a8a6f1c80 100644
--- a/hledger-lib/package.yaml
+++ b/hledger-lib/package.yaml
@@ -61,6 +61,7 @@ dependencies:
 - file-embed >=0.0.10
 - filepath
 - hashtables >=1.2.3.1
+- lucid
 - megaparsec >=7.0.0 && <9.7
 - microlens >=0.4
 - microlens-th >=0.4
diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs
index 6dc45ad58..77936e4bd 100644
--- a/hledger/Hledger/Cli/Commands/Balance.hs
+++ b/hledger/Hledger/Cli/Commands/Balance.hs
@@ -403,7 +403,8 @@ 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" -> \ropts1 -> printHtml . balanceReportAsSpreadsheet ropts1
+              "html" -> \ropts1 -> (<>"\n") . L.renderText .
+                                   printHtml . balanceReportAsSpreadsheet ropts1
               "json" -> const $ (<>"\n") . toJsonText
               "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1
               _      -> error' $ unsupportedOutputFormatError fmt  -- PARTIAL: