diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs
index 2a3b0533b..0bb4a7249 100644
--- a/hledger-lib/Hledger/Write/Html.hs
+++ b/hledger-lib/Hledger/Write/Html.hs
@@ -1,67 +1,27 @@
{-# LANGUAGE OverloadedStrings #-}
{- |
-Export spreadsheet table data as HTML table.
-
-This is derived from
+Common definitions for Html.Blaze and Html.Lucid
-}
module Hledger.Write.Html (
- printHtml,
- formatRow,
- formatCell,
+ Lines(..),
+ borderStyles,
) where
-import qualified Hledger.Write.Html.Attribute as Attr
import qualified Hledger.Write.Spreadsheet as Spr
-import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
+import Hledger.Write.Spreadsheet (Cell(..))
-import qualified Data.Text as Text
-import qualified Lucid.Base as LucidBase
-import qualified Lucid
import Data.Text (Text)
-import Data.Foldable (traverse_)
-printHtml :: (Lines border) => [[Cell border (Lucid.Html ())]] -> Lucid.Html ()
-printHtml table = do
- Lucid.style_ Attr.tableStylesheet
- Lucid.table_ $ traverse_ formatRow table
-
-formatRow:: (Lines border) => [Cell border (Lucid.Html ())] -> Lucid.Html ()
-formatRow = Lucid.tr_ . traverse_ formatCell
-
-formatCell :: (Lines border) => Cell border (Lucid.Html ()) -> Lucid.Html ()
-formatCell cell =
- let str = cellContent cell in
- let content =
- if Text.null $ cellAnchor cell
- then str
- else Lucid.a_ [Lucid.href_ $ cellAnchor cell] str in
+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
- let style =
- case leftBorder++rightBorder++topBorder++bottomBorder of
- [] -> []
- ss -> [Lucid.style_ $ Attr.concatStyles ss] in
- let class_ =
- map Lucid.class_ $
- filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in
- case cellStyle cell of
- Head -> Lucid.th_ (style++class_) content
- Body emph ->
- let align =
- case cellType cell of
- TypeString -> []
- TypeDate -> []
- _ -> [LucidBase.makeAttribute "align" "right"]
- withEmph =
- case emph of
- Item -> id
- Total -> Lucid.b_
- in Lucid.td_ (style++align++class_) $ withEmph content
+ leftBorder++rightBorder++topBorder++bottomBorder
class (Spr.Lines border) => Lines border where
diff --git a/hledger-lib/Hledger/Write/Html/Blaze.hs b/hledger-lib/Hledger/Write/Html/Blaze.hs
index c1ae23121..4a99f5f5e 100644
--- a/hledger-lib/Hledger/Write/Html/Blaze.hs
+++ b/hledger-lib/Hledger/Write/Html/Blaze.hs
@@ -12,13 +12,13 @@ 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.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
import qualified Text.Blaze.Html4.Transitional.Attributes as HtmlAttr
import qualified Text.Blaze.Html4.Transitional as Html
import qualified Data.Text as Text
import Text.Blaze.Html4.Transitional (Html, toHtml, (!))
-import Data.Text (Text)
import Data.Foldable (traverse_)
@@ -38,14 +38,8 @@ formatCell cell =
then str
else Html.a str !
HtmlAttr.href (Html.textValue (cellAnchor cell)) in
- 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
let style =
- case leftBorder++rightBorder++topBorder++bottomBorder of
+ case borderStyles cell of
[] -> []
ss -> [HtmlAttr.style $ Html.textValue $
Attr.concatStyles ss] in
@@ -67,17 +61,3 @@ formatCell cell =
Total -> Html.b
in foldl (!) (Html.td $ withEmph content)
(style++align++valign++class_)
-
-
-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
new file mode 100644
index 000000000..d4bdea8ac
--- /dev/null
+++ b/hledger-lib/Hledger/Write/Html/Lucid.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+Export spreadsheet table data as HTML table.
+
+This is derived from
+-}
+module Hledger.Write.Html.Lucid (
+ printHtml,
+ 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 qualified Data.Text as Text
+import qualified Lucid.Base as HtmlBase
+import qualified Lucid as Html
+import Data.Foldable (traverse_)
+
+
+type Html = Html.Html ()
+
+printHtml :: (Lines border) => [[Cell border Html]] -> Html
+printHtml table = do
+ Html.style_ Attr.tableStylesheet
+ Html.table_ $ traverse_ formatRow table
+
+formatRow:: (Lines border) => [Cell border Html] -> Html
+formatRow = Html.tr_ . traverse_ formatCell
+
+formatCell :: (Lines border) => Cell border Html -> Html
+formatCell cell =
+ let str = cellContent cell in
+ let content =
+ if Text.null $ cellAnchor cell
+ then str
+ else Html.a_ [Html.href_ $ cellAnchor cell] str in
+ let style =
+ case borderStyles cell of
+ [] -> []
+ ss -> [Html.style_ $ Attr.concatStyles ss] in
+ let class_ =
+ map Html.class_ $
+ filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in
+ case cellStyle cell of
+ Head -> Html.th_ (style++class_) content
+ Body emph ->
+ let align =
+ case cellType cell of
+ TypeString -> []
+ TypeDate -> []
+ _ -> [HtmlBase.makeAttribute "align" "right"]
+ withEmph =
+ case emph of
+ Item -> id
+ Total -> Html.b_
+ in Html.td_ (style++align++class_) $ withEmph content
diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal
index 786aaf7c4..1092b960d 100644
--- a/hledger-lib/hledger-lib.cabal
+++ b/hledger-lib/hledger-lib.cabal
@@ -87,9 +87,9 @@ library
Hledger.Read.TimeclockReader
Hledger.Write.Csv
Hledger.Write.Ods
- Hledger.Write.Html
Hledger.Write.Html.Attribute
Hledger.Write.Html.Blaze
+ Hledger.Write.Html.Lucid
Hledger.Write.Spreadsheet
Hledger.Reports
Hledger.Reports.ReportOptions
@@ -110,6 +110,7 @@ library
Hledger.Utils.Text
Text.Tabular.AsciiWide
other-modules:
+ Hledger.Write.Html
Text.WideString
Paths_hledger_lib
hs-source-dirs:
diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml
index 7b0561074..dd56c63dd 100644
--- a/hledger-lib/package.yaml
+++ b/hledger-lib/package.yaml
@@ -151,9 +151,9 @@ library:
- Hledger.Read.TimeclockReader
- Hledger.Write.Csv
- Hledger.Write.Ods
- - Hledger.Write.Html
- Hledger.Write.Html.Attribute
- Hledger.Write.Html.Blaze
+ - Hledger.Write.Html.Lucid
- Hledger.Write.Spreadsheet
- Hledger.Reports
- Hledger.Reports.ReportOptions
@@ -173,7 +173,8 @@ library:
- Hledger.Utils.Test
- Hledger.Utils.Text
- Text.Tabular.AsciiWide
-# other-modules:
+ other-modules:
+ - Hledger.Write.Html
# - Ledger.Parser.Text
# "cabal test hledger-lib" currently fails, see doctest suite below
diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs
index 16f561ff2..6ce211879 100644
--- a/hledger/Hledger/Cli/Commands/Balance.hs
+++ b/hledger/Hledger/Cli/Commands/Balance.hs
@@ -297,9 +297,9 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods)
-import Hledger.Write.Html (printHtml)
+import Hledger.Write.Html.Lucid (printHtml)
import Hledger.Write.Html.Attribute (tableStylesheet)
-import qualified Hledger.Write.Html as Html
+import qualified Hledger.Write.Html.Lucid as Html
import qualified Hledger.Write.Spreadsheet as Ods
diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs
index 98e74ced8..5f42f87a0 100644
--- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs
+++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs
@@ -23,7 +23,7 @@ import Data.Time.Calendar (Day, addDays)
import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq)
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Html.Attribute (stylesheet, tableStyle, alignleft, alignright)
-import qualified Hledger.Write.Html as Html
+import qualified Hledger.Write.Html.Lucid as Html
import qualified Hledger.Write.Spreadsheet as Spr
import Lucid as L hiding (value_)
import Safe (tailDef)