499c626e48
cli: Commands.Balance: new option --base-url It adds hledger-web-compatible hyperlinks to account names.
84 lines
2.8 KiB
Haskell
84 lines
2.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{- |
|
|
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>
|
|
-}
|
|
module Hledger.Write.Html (
|
|
printHtml,
|
|
formatRow,
|
|
formatCell,
|
|
) 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 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_ $ Text.unlines $
|
|
"" :
|
|
"table {border-collapse:collapse}" :
|
|
"th, td {padding-left:1em}" :
|
|
"th.account, td.account {padding-left:0;}" :
|
|
[]
|
|
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
|
|
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 -> [Attr.styles_ 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
|
|
|
|
|
|
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"]
|