83 lines
2.8 KiB
Haskell
83 lines
2.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{- |
|
|
HTML writing helpers using lucid.
|
|
-}
|
|
|
|
module Hledger.Write.Html.Lucid (
|
|
Html,
|
|
L.toHtml,
|
|
styledTableHtml,
|
|
formatRow,
|
|
formatCell,
|
|
) where
|
|
|
|
import Data.Foldable (traverse_)
|
|
import Data.Text qualified as Text
|
|
import Lucid.Base qualified as L
|
|
import Lucid qualified as L
|
|
|
|
import Hledger.Write.Html.Attribute qualified as Attr
|
|
import Hledger.Write.Html.HtmlCommon
|
|
import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
|
|
import Hledger.Write.Spreadsheet qualified as Spr
|
|
|
|
|
|
type Html = L.Html ()
|
|
|
|
-- | Export spreadsheet table data as HTML table.
|
|
-- This is derived from <https://hackage.haskell.org/package/classify-frog-0.2.4.3/src/src/Spreadsheet/Format.hs>
|
|
styledTableHtml :: (Lines border) => [[Cell border Html]] -> Html
|
|
styledTableHtml table = do
|
|
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 = L.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 L.a_ [L.href_ $ cellAnchor cell] str in
|
|
let style =
|
|
case borderStyles cell of
|
|
[] -> []
|
|
ss -> [L.style_ $ Attr.concatStyles ss] in
|
|
let 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 (L.colspan_ (Text.pack $ show n) : attrs) cont
|
|
Spr.SpanVertical n ->
|
|
makeCell (L.rowspan_ (Text.pack $ show n) : attrs) cont
|
|
in
|
|
case cellStyle cell of
|
|
Head -> span_ L.th_ (style++class_) content
|
|
Body emph ->
|
|
let align =
|
|
case cellType cell of
|
|
TypeString -> []
|
|
TypeDate -> []
|
|
_ -> [L.makeAttribute "align" "right"]
|
|
valign =
|
|
case Spr.cellSpan cell of
|
|
Spr.SpanVertical n ->
|
|
if n>1
|
|
then [L.makeAttribute "valign" "top"]
|
|
else []
|
|
_ -> []
|
|
withEmph =
|
|
case emph of
|
|
Item -> id
|
|
Total -> L.b_
|
|
in span_ L.td_ (style++align++valign++class_) $
|
|
withEmph content
|
|
|