content: {-# 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
  
  