imp: lib: Write.Html: use Lucid to generate HTML

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 Lucid.Base as LucidBase
-import qualified Data.Text as T
+import qualified Lucid
-
+import Data.Foldable (for_)
-import Text.Printf (printf)
 
 
-printHtml :: [[Cell]] -> TL.Text
+printHtml :: [[Cell]] -> Lucid.Html ()
 printHtml table =
-    TL.unlines $ map (TL.fromStrict . T.pack) $
+    Lucid.table_ $ for_ table $ \row ->
-    "<table>" :
+    Lucid.tr_ $ for_ row $ \cell ->
-    (table >>= \row ->
+    formatCell cell
-        "<tr>" :
-        (row >>= formatCell) ++
-        "</tr>" :
-        []) ++
-    "</table>" :
-    []
 
-formatCell :: Cell -> [String]
+formatCell :: Cell -> Lucid.Html ()
 formatCell cell =
-    (let str = escape $ T.unpack $ cellContent cell in
+    let str = Lucid.toHtml $ cellContent cell in
-     case cellStyle cell of
+    case cellStyle cell of
-        Head -> printf "<th>%s</th>" str
+        Head -> Lucid.th_ str
         Body emph ->
             let align =
                     case cellType cell of
-                        TypeString -> ""
+                        TypeString -> []
-                        _ -> " align=right"
+                        _ -> [LucidBase.makeAttribute "align" "right"]
-                (emphOpen, emphClose) =
+                withEmph =
                     case emph of
-                        Item -> ("", "")
+                        Item -> id
-                        Total -> ("<b>", "</b>")
+                        Total -> Lucid.b_
-            in  printf "<td%s>%s%s%s</td>" align emphOpen str emphClose) :
+            in  Lucid.td_ align $ withEmph str
-    []
-
-
-escape :: String -> String
-escape =
-    concatMap $ \c ->
-        case c of
-            '\n' -> "<br>"
-            '&' -> "&amp;"
-            '<' -> "&lt;"
-            '>' -> "&gt;"
-            '"' -> "&quot;"
-            '\'' -> "&apos;"
-            _ -> [c]

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

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

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: