diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs index 0bb4a7249..0f1191a64 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. + -} + +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Write.Html ( - Lines(..), - borderStyles, - ) where + L.toHtml, + Html, + formatRow, + htmlAsText, + htmlAsLazyText, + styledTableHtml, + tests_Hledger_Write_Html + ) where -import qualified Hledger.Write.Spreadsheet as Spr -import Hledger.Write.Spreadsheet (Cell(..)) +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) -import Data.Text (Text) +import Hledger.Write.Html.Lucid (Html, formatRow, styledTableHtml) -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 +htmlAsText :: Html -> T.Text +htmlAsText = TL.toStrict . L.renderText +htmlAsLazyText :: Html -> TL.Text +htmlAsLazyText = L.renderText -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"] +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 6d356d23e..86b456f56 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 000000000..76139732c --- /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 15f36c60d..a9a8be805 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 qualified Hledger.Write.Html.Attribute as Attr -import qualified Hledger.Write.Spreadsheet as Spr -import Hledger.Write.Html (Lines, borderStyles) -import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) - +import Data.Foldable (traverse_) import qualified Data.Text as Text -import qualified Lucid.Base as HtmlBase -import qualified Lucid as Html -import Data.Foldable (traverse_) +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 -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 356c6bb9f..8ef36d797 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 c9a2538b9..7c6e4d898 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 f69662d17..d79a74a81 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.Write.Csv (CSV, printCSV, printTSV) -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 +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 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 f8bc4cad7..844676ab1 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 86aeacf21..363a68d91 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