From bc92ea4f4e5aef9d0fb14b1b4fa9f8dd9d397012 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 23 Jan 2025 06:42:29 -1000 Subject: [PATCH 1/2] dev: rename printHtml -> styledTableHtml --- hledger-lib/Hledger/Write/Html/Blaze.hs | 6 +++--- hledger-lib/Hledger/Write/Html/Lucid.hs | 6 +++--- hledger/Hledger/Cli/Commands/Balance.hs | 8 ++++---- hledger/Hledger/Cli/Commands/Print.hs | 4 ++-- hledger/Hledger/Cli/Commands/Register.hs | 4 ++-- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 4 ++-- 6 files changed, 16 insertions(+), 16 deletions(-) diff --git a/hledger-lib/Hledger/Write/Html/Blaze.hs b/hledger-lib/Hledger/Write/Html/Blaze.hs index 79c5e1b6f6c..6d356d23ee7 100644 --- a/hledger-lib/Hledger/Write/Html/Blaze.hs +++ b/hledger-lib/Hledger/Write/Html/Blaze.hs @@ -5,7 +5,7 @@ Export spreadsheet table data as HTML table. This is derived from -} module Hledger.Write.Html.Blaze ( - printHtml, + styledTableHtml, formatRow, formatCell, ) where @@ -22,8 +22,8 @@ import Text.Blaze.Html4.Transitional (Html, toHtml, (!)) import Data.Foldable (traverse_) -printHtml :: (Lines border) => [[Cell border Html]] -> Html -printHtml table = do +styledTableHtml :: (Lines border) => [[Cell border Html]] -> Html +styledTableHtml table = do Html.style $ toHtml $ Attr.tableStylesheet Html.table $ traverse_ formatRow table diff --git a/hledger-lib/Hledger/Write/Html/Lucid.hs b/hledger-lib/Hledger/Write/Html/Lucid.hs index d7eed9a8d74..15f36c60d4c 100644 --- a/hledger-lib/Hledger/Write/Html/Lucid.hs +++ b/hledger-lib/Hledger/Write/Html/Lucid.hs @@ -5,7 +5,7 @@ Export spreadsheet table data as HTML table. This is derived from -} module Hledger.Write.Html.Lucid ( - printHtml, + styledTableHtml, formatRow, formatCell, ) where @@ -23,8 +23,8 @@ import Data.Foldable (traverse_) type Html = Html.Html () -printHtml :: (Lines border) => [[Cell border Html]] -> Html -printHtml table = do +styledTableHtml :: (Lines border) => [[Cell border Html]] -> Html +styledTableHtml table = do Html.link_ [Html.rel_ "stylesheet", Html.href_ "hledger.css"] Html.style_ Attr.tableStylesheet Html.table_ $ traverse_ formatRow table diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index f5b718c9775..f8bc4cad7b6 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -305,7 +305,7 @@ import Hledger.Cli.Utils import Hledger.Cli.Anchor (setAccountAnchor, dateSpanCell, headerDateSpanCell) import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Ods (printFods) -import Hledger.Write.Html.Lucid (printHtml) +import Hledger.Write.Html.Lucid (styledTableHtml) import Hledger.Write.Spreadsheet (rawTableContent, headerCell, addHeaderBorders, addRowSpanHeader, cellFromMixedAmount, cellsFromMixedAmount) @@ -392,7 +392,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of "csv" -> printCSV . budgetReportAsCsv ropts "tsv" -> printTSV . budgetReportAsCsv ropts "html" -> (<>"\n") . L.renderText . - printHtml . map (map (fmap L.toHtml)) . budgetReportAsSpreadsheet ropts + styledTableHtml . map (map (fmap L.toHtml)) . budgetReportAsSpreadsheet ropts "fods" -> printFods IO.localeEncoding . Map.singleton "Budget Report" . (,) (1,0) . budgetReportAsSpreadsheet ropts _ -> error' $ unsupportedOutputFormatError fmt @@ -418,7 +418,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of "csv" -> printCSV . balanceReportAsCsv ropts "tsv" -> printTSV . balanceReportAsCsv ropts "html" -> (<>"\n") . L.renderText . - printHtml . map (map (fmap L.toHtml)) . balanceReportAsSpreadsheet ropts + styledTableHtml . map (map (fmap L.toHtml)) . balanceReportAsSpreadsheet ropts "json" -> (<>"\n") . toJsonText "fods" -> printFods IO.localeEncoding . Map.singleton "Balance Report" . (,) (1,0) . balanceReportAsSpreadsheet ropts _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: @@ -711,7 +711,7 @@ tidyColumnLabels = -- | Render a multi-column balance report as HTML. multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html () multiBalanceReportAsHtml ropts mbr = - printHtml . map (map (fmap L.toHtml)) $ + styledTableHtml . map (map (fmap L.toHtml)) $ snd $ multiBalanceReportAsSpreadsheet ropts mbr -- | Render the ODS table rows for a MultiBalanceReport. diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index e8a83d87230..36966398bd4 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -37,7 +37,7 @@ import Hledger import Hledger.Write.Beancount (accountNameToBeancount, showTransactionBeancount, showBeancountMetadata) import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Ods (printFods) -import Hledger.Write.Html.Lucid (printHtml) +import Hledger.Write.Html.Lucid (styledTableHtml) import qualified Hledger.Write.Spreadsheet as Spr import Hledger.Cli.CliOptions import Hledger.Cli.Utils @@ -142,7 +142,7 @@ printEntries opts@CliOpts{rawopts_=rawopts, reportspec_=rspec} j = | fmt=="json" = toJsonText . styleAmounts styles | fmt=="sql" = entriesReportAsSql . styleAmounts styles | fmt=="html" = - (<>"\n") . Lucid.renderText . printHtml . + (<>"\n") . Lucid.renderText . styledTableHtml . map (map (fmap Lucid.toHtml)) . entriesReportAsSpreadsheet oneLineNoCostFmt baseUrl query . styleAmounts styles diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index c558055708f..8e5862ff9a9 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -31,7 +31,7 @@ import System.Console.CmdArgs.Explicit (flagNone, flagReq) import Hledger hiding (per) import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Ods (printFods) -import Hledger.Write.Html.Lucid (printHtml) +import Hledger.Write.Html.Lucid (styledTableHtml) import qualified Hledger.Write.Spreadsheet as Spr import Hledger.Cli.CliOptions import Hledger.Cli.Utils @@ -103,7 +103,7 @@ register opts@CliOpts{rawopts_=rawopts, reportspec_=rspec} j | fmt=="csv" = printCSV . postingsReportAsCsv | fmt=="tsv" = printTSV . postingsReportAsCsv | fmt=="html" = - (<>"\n") . Lucid.renderText . printHtml . + (<>"\n") . Lucid.renderText . styledTableHtml . map (map (fmap Lucid.toHtml)) . postingsReportAsSpreadsheet oneLineNoCostFmt baseUrl query | fmt=="fods" = diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index a61a2ac0661..86aeacf2103 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -28,7 +28,7 @@ import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq) import qualified System.IO as IO import Hledger.Write.Ods (printFods) import Hledger.Write.Csv (CSV, printCSV, printTSV) -import Hledger.Write.Html.Lucid (printHtml) +import Hledger.Write.Html.Lucid (styledTableHtml) import Hledger.Write.Html.Attribute (stylesheet, tableStyle, alignleft) import qualified Hledger.Write.Spreadsheet as Spr import Lucid as L hiding (value_) @@ -338,7 +338,7 @@ compoundBalanceReportAsHtml ropts cbr = ] table_ $ do tr_ $ th_ [colspanattr, style_ alignleft] $ h2_ $ toHtml title - printHtml $ NonEmpty.toList $ fmap (map (fmap L.toHtml)) cells + styledTableHtml $ NonEmpty.toList $ fmap (map (fmap L.toHtml)) cells -- | Render a compound balance report as Spreadsheet. compoundBalanceReportAsSpreadsheet :: From a0a23425af48facb98f0095b78c37bb78f87d3aa Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 23 Jan 2025 08:33:06 -1000 Subject: [PATCH 2/2] dev: refactor Hledger.Write.Html etc, reducing Lucid references Clarify the HTML lib situation a bit, and clean up some imports. Related: #2244 --- hledger-lib/Hledger/Write/Html.hs | 59 ++++++++++--------- hledger-lib/Hledger/Write/Html/Blaze.hs | 9 +-- hledger-lib/Hledger/Write/Html/HtmlCommon.hs | 39 ++++++++++++ hledger-lib/Hledger/Write/Html/Lucid.hs | 54 +++++++++-------- hledger-lib/hledger-lib.cabal | 1 + hledger-lib/package.yaml | 1 + hledger/Hledger/Cli/Commands/Aregister.hs | 17 +++--- hledger/Hledger/Cli/Commands/Balance.hs | 17 +++--- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 24 ++++---- 9 files changed, 134 insertions(+), 87 deletions(-) create mode 100644 hledger-lib/Hledger/Write/Html/HtmlCommon.hs diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs index 0bb4a724917..0f1191a6477 100644 --- a/hledger-lib/Hledger/Write/Html.hs +++ b/hledger-lib/Hledger/Write/Html.hs @@ -1,38 +1,41 @@ -{-# LANGUAGE OverloadedStrings #-} {- | -Common definitions for Html.Blaze and Html.Lucid +HTML writing helpers. +This module would ideally hide the details of which HTML library is used, but it doesn't yet. + +Currently hledger-web uses blaze-html, but hledger CLI reports use lucid. +lucid has a more usable API than blaze-html (https://chrisdone.com/posts/lucid). +lucid2's is even better. +Unfortunately lucid* can not render multi-line or indented text. +We want this so that humans can read and troubleshoot our HTML output. +So a transition to blaze-html may be coming. + -} -module Hledger.Write.Html ( - Lines(..), - borderStyles, - ) where -import qualified Hledger.Write.Spreadsheet as Spr -import Hledger.Write.Spreadsheet (Cell(..)) +{-# LANGUAGE OverloadedStrings #-} -import Data.Text (Text) +module Hledger.Write.Html ( + L.toHtml, + Html, + formatRow, + htmlAsText, + htmlAsLazyText, + styledTableHtml, + tests_Hledger_Write_Html + ) where +import qualified Data.Text as T (Text) +import qualified Data.Text.Lazy as TL (Text, toStrict) +import qualified Lucid as L (renderText, toHtml) +import Test.Tasty (testGroup) -borderStyles :: Lines border => Cell border text -> [Text] -borderStyles cell = - let border field access = - map (field<>) $ borderLines $ access $ cellBorder cell in - let leftBorder = border "border-left:" Spr.borderLeft in - let rightBorder = border "border-right:" Spr.borderRight in - let topBorder = border "border-top:" Spr.borderTop in - let bottomBorder = border "border-bottom:" Spr.borderBottom in - leftBorder++rightBorder++topBorder++bottomBorder +import Hledger.Write.Html.Lucid (Html, formatRow, styledTableHtml) -class (Spr.Lines border) => Lines border where - borderLines :: border -> [Text] +htmlAsText :: Html -> T.Text +htmlAsText = TL.toStrict . L.renderText -instance Lines () where - borderLines () = [] +htmlAsLazyText :: Html -> TL.Text +htmlAsLazyText = L.renderText -instance Lines Spr.NumLines where - borderLines prop = - case prop of - Spr.NoLine -> [] - Spr.SingleLine -> ["black"] - Spr.DoubleLine -> ["double black"] +tests_Hledger_Write_Html = testGroup "Write.Html" [ + ] diff --git a/hledger-lib/Hledger/Write/Html/Blaze.hs b/hledger-lib/Hledger/Write/Html/Blaze.hs index 6d356d23ee7..86b456f5691 100644 --- a/hledger-lib/Hledger/Write/Html/Blaze.hs +++ b/hledger-lib/Hledger/Write/Html/Blaze.hs @@ -1,9 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {- | -Export spreadsheet table data as HTML table. - -This is derived from +HTML writing helpers using blaze-html. -} + module Hledger.Write.Html.Blaze ( styledTableHtml, formatRow, @@ -12,7 +11,7 @@ module Hledger.Write.Html.Blaze ( import qualified Hledger.Write.Html.Attribute as Attr import qualified Hledger.Write.Spreadsheet as Spr -import Hledger.Write.Html (Lines, borderStyles) +import Hledger.Write.Html.HtmlCommon (Lines, borderStyles) import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) import qualified Text.Blaze.Html4.Transitional.Attributes as HtmlAttr @@ -22,6 +21,8 @@ import Text.Blaze.Html4.Transitional (Html, toHtml, (!)) import Data.Foldable (traverse_) +-- | Export spreadsheet table data as HTML table. +-- This is derived from styledTableHtml :: (Lines border) => [[Cell border Html]] -> Html styledTableHtml table = do Html.style $ toHtml $ Attr.tableStylesheet diff --git a/hledger-lib/Hledger/Write/Html/HtmlCommon.hs b/hledger-lib/Hledger/Write/Html/HtmlCommon.hs new file mode 100644 index 00000000000..76139732c93 --- /dev/null +++ b/hledger-lib/Hledger/Write/Html/HtmlCommon.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | +Common definitions used by both Html.Blaze and Html.Lucid. +-} + +module Hledger.Write.Html.HtmlCommon ( + Lines(..), + borderStyles, + ) where + +import Data.Text (Text) + +import Hledger.Write.Spreadsheet (Cell(..)) +import qualified Hledger.Write.Spreadsheet as Spr + + +borderStyles :: Lines border => Cell border text -> [Text] +borderStyles cell = + let border field access = + map (field<>) $ borderLines $ access $ cellBorder cell in + let leftBorder = border "border-left:" Spr.borderLeft in + let rightBorder = border "border-right:" Spr.borderRight in + let topBorder = border "border-top:" Spr.borderTop in + let bottomBorder = border "border-bottom:" Spr.borderBottom in + leftBorder++rightBorder++topBorder++bottomBorder + + +class (Spr.Lines border) => Lines border where + borderLines :: border -> [Text] + +instance Lines () where + borderLines () = [] + +instance Lines Spr.NumLines where + borderLines prop = + case prop of + Spr.NoLine -> [] + Spr.SingleLine -> ["black"] + Spr.DoubleLine -> ["double black"] diff --git a/hledger-lib/Hledger/Write/Html/Lucid.hs b/hledger-lib/Hledger/Write/Html/Lucid.hs index 15f36c60d4c..a9a8be80523 100644 --- a/hledger-lib/Hledger/Write/Html/Lucid.hs +++ b/hledger-lib/Hledger/Write/Html/Lucid.hs @@ -1,36 +1,39 @@ {-# LANGUAGE OverloadedStrings #-} {- | -Export spreadsheet table data as HTML table. - -This is derived from +HTML writing helpers using lucid. -} + module Hledger.Write.Html.Lucid ( + Html, + L.toHtml, styledTableHtml, formatRow, formatCell, ) where +import Data.Foldable (traverse_) +import qualified Data.Text as Text +import qualified Lucid.Base as L +import qualified Lucid as L + import qualified Hledger.Write.Html.Attribute as Attr +import Hledger.Write.Html.HtmlCommon +import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) import qualified Hledger.Write.Spreadsheet as Spr -import Hledger.Write.Html (Lines, borderStyles) -import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) - -import qualified Data.Text as Text -import qualified Lucid.Base as HtmlBase -import qualified Lucid as Html -import Data.Foldable (traverse_) -type Html = Html.Html () +type Html = L.Html () +-- | Export spreadsheet table data as HTML table. +-- This is derived from styledTableHtml :: (Lines border) => [[Cell border Html]] -> Html styledTableHtml table = do - Html.link_ [Html.rel_ "stylesheet", Html.href_ "hledger.css"] - Html.style_ Attr.tableStylesheet - Html.table_ $ traverse_ formatRow table + L.link_ [L.rel_ "stylesheet", L.href_ "hledger.css"] + L.style_ Attr.tableStylesheet + L.table_ $ traverse_ formatRow table formatRow:: (Lines border) => [Cell border Html] -> Html -formatRow = Html.tr_ . traverse_ formatCell +formatRow = L.tr_ . traverse_ formatCell formatCell :: (Lines border) => Cell border Html -> Html formatCell cell = @@ -38,41 +41,42 @@ formatCell cell = let content = if Text.null $ cellAnchor cell then str - else Html.a_ [Html.href_ $ cellAnchor cell] str in + else L.a_ [L.href_ $ cellAnchor cell] str in let style = case borderStyles cell of [] -> [] - ss -> [Html.style_ $ Attr.concatStyles ss] in + ss -> [L.style_ $ Attr.concatStyles ss] in let class_ = - map Html.class_ $ + map L.class_ $ filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in let span_ makeCell attrs cont = case Spr.cellSpan cell of Spr.NoSpan -> makeCell attrs cont Spr.Covered -> pure () Spr.SpanHorizontal n -> - makeCell (Html.colspan_ (Text.pack $ show n) : attrs) cont + makeCell (L.colspan_ (Text.pack $ show n) : attrs) cont Spr.SpanVertical n -> - makeCell (Html.rowspan_ (Text.pack $ show n) : attrs) cont + makeCell (L.rowspan_ (Text.pack $ show n) : attrs) cont in case cellStyle cell of - Head -> span_ Html.th_ (style++class_) content + Head -> span_ L.th_ (style++class_) content Body emph -> let align = case cellType cell of TypeString -> [] TypeDate -> [] - _ -> [HtmlBase.makeAttribute "align" "right"] + _ -> [L.makeAttribute "align" "right"] valign = case Spr.cellSpan cell of Spr.SpanVertical n -> if n>1 - then [HtmlBase.makeAttribute "valign" "top"] + then [L.makeAttribute "valign" "top"] else [] _ -> [] withEmph = case emph of Item -> id - Total -> Html.b_ - in span_ Html.td_ (style++align++valign++class_) $ + Total -> L.b_ + in span_ L.td_ (style++align++valign++class_) $ withEmph content + diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 356c6bb9f94..8ef36d79755 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -93,6 +93,7 @@ library Hledger.Write.Html.Attribute Hledger.Write.Html.Blaze Hledger.Write.Html.Lucid + Hledger.Write.Html.HtmlCommon Hledger.Write.Spreadsheet Hledger.Reports Hledger.Reports.ReportOptions diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index c9a2538b9d3..7c6e4d89848 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -162,6 +162,7 @@ library: - Hledger.Write.Html.Attribute - Hledger.Write.Html.Blaze - Hledger.Write.Html.Lucid + - Hledger.Write.Html.HtmlCommon - Hledger.Write.Spreadsheet - Hledger.Reports - Hledger.Reports.ReportOptions diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index f69662d17dd..d79a74a81b1 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -29,19 +29,18 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Control.Monad (when) -import Lucid (toHtml) -import qualified Lucid as L +import qualified Lucid as L hiding (Html) import System.Console.CmdArgs.Explicit (flagNone, flagReq) +import qualified System.IO as IO +import Text.Tabular.AsciiWide hiding (render) import Hledger +import Hledger.Cli.CliOptions +import Hledger.Cli.Utils import Hledger.Write.Csv (CSV, printCSV, printTSV) +import Hledger.Write.Html (formatRow, htmlAsLazyText, toHtml) import Hledger.Write.Ods (printFods) import qualified Hledger.Write.Spreadsheet as Spr -import qualified Hledger.Write.Html.Lucid as Html -import Hledger.Cli.CliOptions -import Hledger.Cli.Utils -import Text.Tabular.AsciiWide hiding (render) -import qualified System.IO as IO aregistermode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Aregister.txt") @@ -176,7 +175,7 @@ accountTransactionsReportItemAsRecord -- | Render a register report as a HTML snippet. accountTransactionsReportAsHTML :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text accountTransactionsReportAsHTML copts reportq thisacctq items = - L.renderText $ do + htmlAsLazyText $ do L.link_ [L.rel_ "stylesheet", L.href_ "hledger.css"] L.table_ $ do when (headingopt copts) $ L.thead_ $ L.tr_ $ do @@ -186,7 +185,7 @@ accountTransactionsReportAsHTML copts reportq thisacctq items = L.th_ "change" L.th_ "balance" L.tbody_ $ for_ items $ - Html.formatRow . map (fmap toHtml) . + formatRow . map (fmap toHtml) . accountTransactionsReportItemAsRecord oneLineNoCostFmt False (whichDate $ _rsReportOpts $ reportspec_ copts) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index f8bc4cad7b6..844676ab1d2 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -291,7 +291,6 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time (addDays, fromGregorian) import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt) -import Lucid as L hiding (value_) import Safe (headMay, maximumMay) import Text.Tabular.AsciiWide (Header(..), Align(..), Properties(..), Cell(..), Table(..), TableOpts(..), @@ -305,7 +304,7 @@ import Hledger.Cli.Utils import Hledger.Cli.Anchor (setAccountAnchor, dateSpanCell, headerDateSpanCell) import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Ods (printFods) -import Hledger.Write.Html.Lucid (styledTableHtml) +import Hledger.Write.Html (Html, styledTableHtml, htmlAsLazyText, toHtml) import Hledger.Write.Spreadsheet (rawTableContent, headerCell, addHeaderBorders, addRowSpanHeader, cellFromMixedAmount, cellsFromMixedAmount) @@ -391,8 +390,8 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of "json" -> (<>"\n") . toJsonText "csv" -> printCSV . budgetReportAsCsv ropts "tsv" -> printTSV . budgetReportAsCsv ropts - "html" -> (<>"\n") . L.renderText . - styledTableHtml . map (map (fmap L.toHtml)) . budgetReportAsSpreadsheet ropts + "html" -> (<>"\n") . htmlAsLazyText . + styledTableHtml . map (map (fmap toHtml)) . budgetReportAsSpreadsheet ropts "fods" -> printFods IO.localeEncoding . Map.singleton "Budget Report" . (,) (1,0) . budgetReportAsSpreadsheet ropts _ -> error' $ unsupportedOutputFormatError fmt @@ -404,7 +403,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of "txt" -> multiBalanceReportAsText ropts "csv" -> printCSV . multiBalanceReportAsCsv ropts "tsv" -> printTSV . multiBalanceReportAsCsv ropts - "html" -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts + "html" -> (<>"\n") . htmlAsLazyText . multiBalanceReportAsHtml ropts "json" -> (<>"\n") . toJsonText "fods" -> printFods IO.localeEncoding . Map.singleton "Multi-period Balance Report" . multiBalanceReportAsSpreadsheet ropts @@ -417,8 +416,8 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of "txt" -> TB.toLazyText . balanceReportAsText ropts "csv" -> printCSV . balanceReportAsCsv ropts "tsv" -> printTSV . balanceReportAsCsv ropts - "html" -> (<>"\n") . L.renderText . - styledTableHtml . map (map (fmap L.toHtml)) . balanceReportAsSpreadsheet ropts + "html" -> (<>"\n") . htmlAsLazyText . + styledTableHtml . map (map (fmap toHtml)) . balanceReportAsSpreadsheet ropts "json" -> (<>"\n") . toJsonText "fods" -> printFods IO.localeEncoding . Map.singleton "Balance Report" . (,) (1,0) . balanceReportAsSpreadsheet ropts _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: @@ -709,9 +708,9 @@ tidyColumnLabels = -- | Render a multi-column balance report as HTML. -multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html () +multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html multiBalanceReportAsHtml ropts mbr = - styledTableHtml . map (map (fmap L.toHtml)) $ + styledTableHtml . map (map (fmap toHtml)) $ snd $ multiBalanceReportAsSpreadsheet ropts mbr -- | Render the ODS table rows for a MultiBalanceReport. diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 86aeacf2103..363a68d91ef 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -14,9 +14,11 @@ module Hledger.Cli.CompoundBalanceCommand ( ,compoundBalanceCommand ) where -import Data.Maybe (fromMaybe, mapMaybe, maybeToList) -import Data.List.NonEmpty (NonEmpty((:|))) +import Control.Monad (guard) import Data.Bifunctor (second) +import Data.Function ((&)) +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import qualified Data.Map as Map import qualified Data.List as List import qualified Data.List.NonEmpty as NonEmpty @@ -24,22 +26,20 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, addDays) +import Lucid as L hiding (Html, value_) import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq) import qualified System.IO as IO -import Hledger.Write.Ods (printFods) -import Hledger.Write.Csv (CSV, printCSV, printTSV) -import Hledger.Write.Html.Lucid (styledTableHtml) -import Hledger.Write.Html.Attribute (stylesheet, tableStyle, alignleft) -import qualified Hledger.Write.Spreadsheet as Spr -import Lucid as L hiding (value_) import Text.Tabular.AsciiWide as Tabular hiding (render) import Hledger import Hledger.Cli.Commands.Balance import Hledger.Cli.CliOptions import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText) -import Data.Function ((&)) -import Control.Monad (guard) +import Hledger.Write.Csv (CSV, printCSV, printTSV) +import Hledger.Write.Html (htmlAsLazyText, styledTableHtml, Html) +import Hledger.Write.Html.Attribute (stylesheet, tableStyle, alignleft) +import Hledger.Write.Ods (printFods) +import qualified Hledger.Write.Spreadsheet as Spr -- | Description of a compound balance report command, -- from which we generate the command's cmdargs mode and IO action. @@ -202,7 +202,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r "txt" -> compoundBalanceReportAsText ropts' "csv" -> printCSV . compoundBalanceReportAsCsv ropts' "tsv" -> printTSV . compoundBalanceReportAsCsv ropts' - "html" -> L.renderText . compoundBalanceReportAsHtml ropts' + "html" -> htmlAsLazyText . compoundBalanceReportAsHtml ropts' "fods" -> printFods IO.localeEncoding . fmap (second NonEmpty.toList) . uncurry Map.singleton . compoundBalanceReportAsSpreadsheet @@ -323,7 +323,7 @@ compoundBalanceReportAsCsv ropts cbr = NonEmpty.toList spreadsheet -- | Render a compound balance report as HTML. -compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> Html () +compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> Html compoundBalanceReportAsHtml ropts cbr = let (title, (_fixed, cells)) = compoundBalanceReportAsSpreadsheet