{-# LANGUAGE OverloadedStrings #-}
module Hledger.Write.Html (
printHtml,
) where
import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
import qualified Lucid.Base as LucidBase
import qualified Lucid
import Data.Foldable (for_)
printHtml :: [[Cell (Lucid.Html ())]] -> Lucid.Html ()
printHtml :: [[Cell (Html ())]] -> Html ()
printHtml [[Cell (Html ())]]
table =
Html () -> Html ()
forall arg result. Term arg result => arg -> result
Lucid.table_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [[Cell (Html ())]] -> ([Cell (Html ())] -> Html ()) -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [[Cell (Html ())]]
table (([Cell (Html ())] -> Html ()) -> Html ())
-> ([Cell (Html ())] -> Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ \[Cell (Html ())]
row ->
Html () -> Html ()
forall arg result. Term arg result => arg -> result
Lucid.tr_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Cell (Html ())] -> (Cell (Html ()) -> Html ()) -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Cell (Html ())]
row ((Cell (Html ()) -> Html ()) -> Html ())
-> (Cell (Html ()) -> Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ \Cell (Html ())
cell ->
Cell (Html ()) -> Html ()
formatCell Cell (Html ())
cell
formatCell :: Cell (Lucid.Html ()) -> Lucid.Html ()
formatCell :: Cell (Html ()) -> Html ()
formatCell Cell (Html ())
cell =
let str :: Html ()
str = Cell (Html ()) -> Html ()
forall text. Cell text -> text
cellContent Cell (Html ())
cell in
case Cell (Html ()) -> Style
forall text. Cell text -> Style
cellStyle Cell (Html ())
cell of
Style
Head -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
Lucid.th_ Html ()
str
Body Emphasis
emph ->
let align :: [Attribute]
align =
case Cell (Html ()) -> Type
forall text. Cell text -> Type
cellType Cell (Html ())
cell of
Type
TypeString -> []
Type
TypeDate -> []
Type
_ -> [Text -> Text -> Attribute
LucidBase.makeAttribute Text
"align" Text
"right"]
withEmph :: Html () -> Html ()
withEmph =
case Emphasis
emph of
Emphasis
Item -> Html () -> Html ()
forall a. a -> a
id
Emphasis
Total -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
Lucid.b_
in [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
Lucid.td_ [Attribute]
align (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Html () -> Html ()
withEmph Html ()
str