{-# 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,
    ) 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