    {-# 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 :: forall border. Lines border => [[Cell border Html]] -> Html
    styledTableHtml [[Cell border Html]]
    table = do
        [Attribute] -> Html
    forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
    L.link_ [Text -> Attribute
    L.rel_ Text
    "stylesheet", Text -> Attribute
    L.href_ Text
    "hledger.css"]
        Text -> Html
    forall arg result. TermRaw arg result => arg -> result
    L.style_ Text
    Attr.tableStylesheet
        Html -> Html
    forall arg result. Term arg result => arg -> result
    L.table_ (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ ([Cell border Html] -> Html) -> [[Cell border Html]] -> Html
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ [Cell border Html] -> Html
    forall border. Lines border => [Cell border Html] -> Html
    formatRow [[Cell border Html]]
    table

    formatRow:: (Lines border) => [Cell border Html] -> Html
    formatRow :: forall border. Lines border => [Cell border Html] -> Html
    formatRow = Html -> Html
    forall arg result. Term arg result => arg -> result
    L.tr_ (Html -> Html)
    -> ([Cell border Html] -> Html) -> [Cell border Html] -> Html
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Cell border Html -> Html) -> [Cell border Html] -> Html
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ Cell border Html -> Html
    forall border. Lines border => Cell border Html -> Html
    formatCell

    formatCell :: (Lines border) => Cell border Html -> Html
    formatCell :: forall border. Lines border => Cell border Html -> Html
    formatCell Cell border Html
    cell =
        let str :: Html
    str = Cell border Html -> Html
    forall border text. Cell border text -> text
    cellContent Cell border Html
    cell in
        let content :: Html
    content =
                if Text -> Bool
    Text.null (Text -> Bool) -> Text -> Bool
    forall a b. (a -> b) -> a -> b
    $ Cell border Html -> Text
    forall border text. Cell border text -> Text
    cellAnchor Cell border Html
    cell
                    then Html
    str
                    else [Attribute] -> Html -> Html
    forall arg result. Term arg result => arg -> result
    L.a_ [Text -> Attribute
    L.href_ (Text -> Attribute) -> Text -> Attribute
    forall a b. (a -> b) -> a -> b
    $ Cell border Html -> Text
    forall border text. Cell border text -> Text
    cellAnchor Cell border Html
    cell] Html
    str in
        let style :: [Attribute]
    style =
                case Cell border Html -> [Text]
    forall border text. Lines border => Cell border text -> [Text]
    borderStyles Cell border Html
    cell of
                    [] -> []
                    [Text]
    ss -> [Text -> Attribute
    forall arg result. TermRaw arg result => arg -> result
    L.style_ (Text -> Attribute) -> Text -> Attribute
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    Attr.concatStyles [Text]
    ss] in
        let class_ :: [Attribute]
    class_ =
                (Text -> Attribute) -> [Text] -> [Attribute]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Attribute
    L.class_ ([Text] -> [Attribute]) -> [Text] -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $
                (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    Text.null) [Class -> Text
    Spr.textFromClass (Class -> Text) -> Class -> Text
    forall a b. (a -> b) -> a -> b
    $ Cell border Html -> Class
    forall border text. Cell border text -> Class
    cellClass Cell border Html
    cell] in
        let span_ :: ([Attribute] -> t -> f ()) -> [Attribute] -> t -> f ()
    span_ [Attribute] -> t -> f ()
    makeCell [Attribute]
    attrs t
    cont =
                case Cell border Html -> Span
    forall border text. Cell border text -> Span
    Spr.cellSpan Cell border Html
    cell of
                    Span
    Spr.NoSpan -> [Attribute] -> t -> f ()
    makeCell [Attribute]
    attrs t
    cont
                    Span
    Spr.Covered -> () -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                    Spr.SpanHorizontal Int
    n ->
                        [Attribute] -> t -> f ()
    makeCell (Text -> Attribute
    L.colspan_ (String -> Text
    Text.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    n) Attribute -> [Attribute] -> [Attribute]
    forall a. a -> [a] -> [a]
    : [Attribute]
    attrs) t
    cont
                    Spr.SpanVertical Int
    n ->
                        [Attribute] -> t -> f ()
    makeCell (Text -> Attribute
    L.rowspan_ (String -> Text
    Text.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    n) Attribute -> [Attribute] -> [Attribute]
    forall a. a -> [a] -> [a]
    : [Attribute]
    attrs) t
    cont
                in
        case Cell border Html -> Style
    forall border text. Cell border text -> Style
    cellStyle Cell border Html
    cell of
            Style
    Head -> ([Attribute] -> Html -> Html) -> [Attribute] -> Html -> Html
    forall {f :: * -> *} {t}.
    Applicative f =>
    ([Attribute] -> t -> f ()) -> [Attribute] -> t -> f ()
    span_ [Attribute] -> Html -> Html
    forall arg result. Term arg result => arg -> result
    L.th_ ([Attribute]
    style[Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++[Attribute]
    class_) Html
    content
            Body Emphasis
    emph ->
                let align :: [Attribute]
    align =
                        case Cell border Html -> Type
    forall border text. Cell border text -> Type
    cellType Cell border Html
    cell of
                            Type
    TypeString -> []
                            Type
    TypeDate -> []
                            Type
    _ -> [Text -> Text -> Attribute
    L.makeAttribute Text
    "align" Text
    "right"]
                    valign :: [Attribute]
    valign =
                        case Cell border Html -> Span
    forall border text. Cell border text -> Span
    Spr.cellSpan Cell border Html
    cell of
                            Spr.SpanVertical Int
    n ->
                                if Int
    nInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >Int
    1
                                    then [Text -> Text -> Attribute
    L.makeAttribute Text
    "valign" Text
    "top"]
                                    else []
                            Span
    _ -> []
                    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
    L.b_
                in  ([Attribute] -> Html -> Html) -> [Attribute] -> Html -> Html
    forall {f :: * -> *} {t}.
    Applicative f =>
    ([Attribute] -> t -> f ()) -> [Attribute] -> t -> f ()
    span_ [Attribute] -> Html -> Html
    forall arg result. Term arg result => arg -> result
    L.td_ ([Attribute]
    style[Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++[Attribute]
    align[Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++[Attribute]
    valign[Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++[Attribute]
    class_) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $
                    Html -> Html
    withEmph Html
    content