aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
authorOleg Grenrus <oleg.grenrus@iki.fi>2017-12-26 17:13:14 +0200
committerAlexander Biehl <alexbiehl@gmail.com>2018-02-01 14:58:18 +0100
commit088b1993fb6c6ed014a95e93d7c07f68218c7777 (patch)
tree47d7c1c85657bf7670ff154ad9a9bc1d1538b0d0 /haddock-api/src/Haddock/Backends/Xhtml
parent2e0d7aef60fbb17f29ffa1f363ffc423f31185fc (diff)
Grid Tables (#718)
* Add table examples * Add table types and adopt simple parser Simple parser is done by Giovanni Cappellotto (@potomak) in https://github.com/haskell/haddock/pull/577 It seems to support single fine full tables, so far from full RST-grid tables, but it's good start. Table type support row- and colspans, but obviously parser is lacking. Still TODO: - Latex backend. Should we use multirow package https://ctan.org/pkg/multirow?lang=en? - Hoogle backend: ? * Implement grid-tables * Refactor table parser * Add two ill-examples * Update CHANGES.md * Basic documentation for tables * Fix documentation example
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs19
1 files changed, 18 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index e63667b0..2990e1e4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -73,7 +73,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
markupMathDisplay = \mathjax -> toHtml ("\\[" ++ mathjax ++ "\\]"),
markupProperty = pre . toHtml,
markupExample = examplesToHtml,
- markupHeader = \(Header l t) -> makeHeader l t
+ markupHeader = \(Header l t) -> makeHeader l t,
+ markupTable = \(Table h r) -> makeTable h r
}
where
makeHeader :: Int -> Html -> Html
@@ -85,6 +86,22 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
makeHeader 6 mkup = h6 mkup
makeHeader l _ = error $ "Somehow got a header level `" ++ show l ++ "' in DocMarkup!"
+ makeTable :: [TableRow Html] -> [TableRow Html] -> Html
+ makeTable hs bs = table (concatHtml (hs' ++ bs'))
+ where
+ hs' | null hs = []
+ | otherwise = [thead (concatHtml (map (makeTableRow th) hs))]
+
+ bs' = [tbody (concatHtml (map (makeTableRow td) bs))]
+
+ makeTableRow :: (Html -> Html) -> TableRow Html -> Html
+ makeTableRow thr (TableRow cs) = tr (concatHtml (map (makeTableCell thr) cs))
+
+ makeTableCell :: (Html -> Html) -> TableCell Html -> Html
+ makeTableCell thr (TableCell i j c) = thr c ! (i' ++ j')
+ where
+ i' = if i == 1 then [] else [ colspan i ]
+ j' = if j == 1 then [] else [ rowspan j ]
examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]