aboutsummaryrefslogtreecommitdiff
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
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
-rw-r--r--CHANGES.md2
-rw-r--r--doc/markup.rst20
-rw-r--r--haddock-api/resources/html/Classic.theme/xhaddock.css14
-rw-r--r--haddock-api/resources/html/Ocean.std-theme/ocean.css15
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs3
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs5
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs19
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs1
-rw-r--r--haddock-api/src/Haddock/InterfaceFile.hs32
-rw-r--r--haddock-api/src/Haddock/Types.hs9
-rw-r--r--haddock-library/fixtures/Fixtures.hs9
-rw-r--r--haddock-library/fixtures/examples/table-simple.input7
-rw-r--r--haddock-library/fixtures/examples/table-simple.parsed52
-rw-r--r--haddock-library/fixtures/examples/table1.input12
-rw-r--r--haddock-library/fixtures/examples/table1.parsed81
-rw-r--r--haddock-library/fixtures/examples/table2.input7
-rw-r--r--haddock-library/fixtures/examples/table2.parsed46
-rw-r--r--haddock-library/fixtures/examples/table3.input7
-rw-r--r--haddock-library/fixtures/examples/table3.parsed50
-rw-r--r--haddock-library/fixtures/examples/table4.input17
-rw-r--r--haddock-library/fixtures/examples/table4.parsed26
-rw-r--r--haddock-library/fixtures/examples/table5.input8
-rw-r--r--haddock-library/fixtures/examples/table5.parsed53
-rw-r--r--haddock-library/haddock-library.cabal3
-rw-r--r--haddock-library/src/Documentation/Haddock/Markup.hs4
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser.hs196
-rw-r--r--haddock-library/src/Documentation/Haddock/Types.hs20
-rw-r--r--html-test/ref/Table.html238
-rw-r--r--html-test/src/Table.hs47
29 files changed, 996 insertions, 7 deletions
diff --git a/CHANGES.md b/CHANGES.md
index b4d69ce4..7127df79 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,8 @@
* to be released
+ * Haddock now supports tables in documentation inspired by reSTs grid tables
+
* A --reexport flag, which can be used to add extra modules to the
top-level module tree
diff --git a/doc/markup.rst b/doc/markup.rst
index d0b9392d..acabaa28 100644
--- a/doc/markup.rst
+++ b/doc/markup.rst
@@ -1078,6 +1078,26 @@ If the output format supports it, the mathematics will be rendered
inside the documentation. For example, the HTML backend will display
the mathematics via `MathJax <https://www.mathjax.org>`__.
+Grid Tables
+~~~~~~~~~~~
+
+Inspired by reSTs grid tables Haddock supports a complete table representation via a grid-like "ASCII art". Grid tables are described with a visual grid made up of the characters "-", "=", "|", and "+". The hyphen ("-") is used for horizontal lines (row separators). The equals sign ("=") may be used to separate optional header rows from the table body. The vertical bar ("|") is used for vertical lines (column separators). The plus sign ("+") is used for intersections of horizontal and vertical lines. ::
+
+ -- | This is a grid table:
+ --
+ -- +------------------------+------------+----------+----------+
+ -- | Header row, column 1 | Header 2 | Header 3 | Header 4 |
+ -- | (header rows optional) | | | |
+ -- +========================+============+==========+==========+
+ -- | body row 1, column 1 | column 2 | column 3 | column 4 |
+ -- +------------------------+------------+----------+----------+
+ -- | body row 2 | Cells may span columns. |
+ -- +------------------------+------------+---------------------+
+ -- | body row 3 | Cells may | \[ |
+ -- +------------------------+ span rows. | f(n) = \sum_{i=1} |
+ -- | body row 4 | | \] |
+ -- +------------------------+------------+---------------------+
+
Anchors
~~~~~~~
diff --git a/haddock-api/resources/html/Classic.theme/xhaddock.css b/haddock-api/resources/html/Classic.theme/xhaddock.css
index 1bf668e9..b8164815 100644
--- a/haddock-api/resources/html/Classic.theme/xhaddock.css
+++ b/haddock-api/resources/html/Classic.theme/xhaddock.css
@@ -392,6 +392,20 @@ td.rdoc p {
}
+.doc table {
+ border-collapse: collapse;
+ border-spacing: 0px;
+}
+
+.doc th,
+.doc td {
+ padding: 5px;
+ border: 1px solid #ddd;
+}
+
+.doc th {
+ background-color: #f0f0f0;
+}
#footer {
background-color: #000099;
diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css
index 0852dea5..ba6af9ca 100644
--- a/haddock-api/resources/html/Ocean.std-theme/ocean.css
+++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css
@@ -443,6 +443,21 @@ div#style-menu-holder {
margin-top: 0.8em;
}
+.doc table {
+ border-collapse: collapse;
+ border-spacing: 0px;
+}
+
+.doc th,
+.doc td {
+ padding: 5px;
+ border: 1px solid #ddd;
+}
+
+.doc th {
+ background-color: #f0f0f0;
+}
+
.clearfix:after {
clear: both;
content: " ";
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index f1d8ddb2..fc71d4b5 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -328,7 +328,8 @@ markupTag dflags = Markup {
markupAName = const $ str "",
markupProperty = box TagPre . str,
markupExample = box TagPre . str . unlines . map exampleToString,
- markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h
+ markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h,
+ markupTable = \(Table _ _) -> str "TODO: table"
}
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index d79e0e6c..3ac3b405 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1140,7 +1140,8 @@ parLatexMarkup ppId = Markup {
markupAName = \_ _ -> empty,
markupProperty = \p _ -> quote $ verb $ text p,
markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e,
- markupHeader = \(Header l h) p -> header l (h p)
+ markupHeader = \(Header l h) p -> header l (h p),
+ markupTable = \(Table h b) p -> table h b p
}
where
header 1 d = text "\\section*" <> braces d
@@ -1149,6 +1150,8 @@ parLatexMarkup ppId = Markup {
| l > 0 && l <= 6 = text "\\subsubsection*" <> braces d
header l _ = error $ "impossible header level in LaTeX generation: " ++ show l
+ table _ _ _ = text "{TODO: Table}"
+
fixString Plain s = latexFilter s
fixString Verb s = s
fixString Mono s = latexMonoFilter s
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"]
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 75b2f223..311301ee 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -144,6 +144,7 @@ rename dflags gre = rn
DocEmpty -> pure (DocEmpty)
DocString str -> pure (DocString str)
DocHeader (Header l t) -> DocHeader . Header l <$> rn t
+ DocTable t -> DocTable <$> traverse rn t
-- | Wrap an identifier that's out of scope (i.e. wasn't found in
-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 76bcb4ae..bbd8d04e 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -459,6 +459,32 @@ instance Binary a => Binary (Header a) where
t <- get bh
return (Header l t)
+instance Binary a => Binary (Table a) where
+ put_ bh (Table h b) = do
+ put_ bh h
+ put_ bh b
+ get bh = do
+ h <- get bh
+ b <- get bh
+ return (Table h b)
+
+instance Binary a => Binary (TableRow a) where
+ put_ bh (TableRow cs) = put_ bh cs
+ get bh = do
+ cs <- get bh
+ return (TableRow cs)
+
+instance Binary a => Binary (TableCell a) where
+ put_ bh (TableCell i j c) = do
+ put_ bh i
+ put_ bh j
+ put_ bh c
+ get bh = do
+ i <- get bh
+ j <- get bh
+ c <- get bh
+ return (TableCell i j c)
+
instance Binary Meta where
put_ bh Meta { _version = v } = put_ bh v
get bh = (\v -> Meta { _version = v }) <$> get bh
@@ -542,6 +568,9 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where
put_ bh (DocMathDisplay x) = do
putByte bh 22
put_ bh x
+ put_ bh (DocTable x) = do
+ putByte bh 23
+ put_ bh x
get bh = do
h <- getByte bh
@@ -615,6 +644,9 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where
22 -> do
x <- get bh
return (DocMathDisplay x)
+ 23 -> do
+ x <- get bh
+ return (DocTable x)
_ -> error "invalid binary data found in the interface file"
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index b4cdc343..725606b2 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -454,6 +454,7 @@ instance (NFData a, NFData mod)
DocProperty a -> a `deepseq` ()
DocExamples a -> a `deepseq` ()
DocHeader a -> a `deepseq` ()
+ DocTable a -> a `deepseq` ()
#if !MIN_VERSION_ghc(8,0,2)
-- These were added to GHC itself in 8.0.2
@@ -474,6 +475,14 @@ instance NFData Picture where
instance NFData Example where
rnf (Example a b) = a `deepseq` b `deepseq` ()
+instance NFData id => NFData (Table id) where
+ rnf (Table h b) = h `deepseq` b `deepseq` ()
+
+instance NFData id => NFData (TableRow id) where
+ rnf (TableRow cs) = cs `deepseq` ()
+
+instance NFData id => NFData (TableCell id) where
+ rnf (TableCell i j c) = i `deepseq` j `deepseq` c `deepseq` ()
exampleToString :: Example -> String
exampleToString (Example expression result) =
diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs
index 3707e0a8..f75ff664 100644
--- a/haddock-library/fixtures/Fixtures.hs
+++ b/haddock-library/fixtures/Fixtures.hs
@@ -151,3 +151,12 @@ instance ToExpr Picture
deriving instance Generic Example
instance ToExpr Example
+
+deriving instance Generic (Table id)
+instance ToExpr id => ToExpr (Table id)
+
+deriving instance Generic (TableRow id)
+instance ToExpr id => ToExpr (TableRow id)
+
+deriving instance Generic (TableCell id)
+instance ToExpr id => ToExpr (TableCell id)
diff --git a/haddock-library/fixtures/examples/table-simple.input b/haddock-library/fixtures/examples/table-simple.input
new file mode 100644
index 00000000..d9c49f87
--- /dev/null
+++ b/haddock-library/fixtures/examples/table-simple.input
@@ -0,0 +1,7 @@
++------+--------------+------------------------------------------+
+| code | message | description |
++======+==============+==========================================+
+| 200 | @OK@ | operation successful |
++------+--------------+------------------------------------------+
+| 204 | @No Content@ | operation successful, no body returned |
++------+--------------+------------------------------------------+
diff --git a/haddock-library/fixtures/examples/table-simple.parsed b/haddock-library/fixtures/examples/table-simple.parsed
new file mode 100644
index 00000000..b5e62453
--- /dev/null
+++ b/haddock-library/fixtures/examples/table-simple.parsed
@@ -0,0 +1,52 @@
+DocTable
+ Table
+ {tableBodyRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " 200 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocAppend
+ (DocString " ")
+ (DocAppend
+ (DocMonospaced (DocString "OK"))
+ (DocString " ")),
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ " operation successful ",
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " 204 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocAppend
+ (DocString " ")
+ (DocAppend
+ (DocMonospaced (DocString "No Content"))
+ (DocString " ")),
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ " operation successful, no body returned ",
+ tableCellRowspan = 1}]],
+ tableHeaderRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " code ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " message ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ " description ",
+ tableCellRowspan = 1}]]}
diff --git a/haddock-library/fixtures/examples/table1.input b/haddock-library/fixtures/examples/table1.input
new file mode 100644
index 00000000..a007020c
--- /dev/null
+++ b/haddock-library/fixtures/examples/table1.input
@@ -0,0 +1,12 @@
++------------------------+------------+----------+----------+
+| Header row, column 1 | Header 2 | Header 3 | Header 4 |
+| (header rows optional) | | | |
++========================+============+==========+==========+
+| body row 1, column 1 | column 2 | column 3 | column 4 |
++------------------------+------------+----------+----------+
+| body row 2 | Cells may span columns. |
++------------------------+------------+---------------------+
+| body row 3 | Cells may | \[ |
++------------------------+ span rows. | f(n) = \sum_{i=1} |
+| body row 4 | | \] |
++------------------------+------------+---------------------+
diff --git a/haddock-library/fixtures/examples/table1.parsed b/haddock-library/fixtures/examples/table1.parsed
new file mode 100644
index 00000000..2fa58fd8
--- /dev/null
+++ b/haddock-library/fixtures/examples/table1.parsed
@@ -0,0 +1,81 @@
+DocTable
+ Table
+ {tableBodyRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " body row 1, column 1 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 2 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 3 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 4 ",
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " body row 2 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 3,
+ tableCellContents = DocString " Cells may span columns. ",
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " body row 3 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ (concat
+ [" Cells may \n",
+ " span rows. \n",
+ " "]),
+ tableCellRowspan = 2},
+ TableCell
+ {tableCellColspan = 2,
+ tableCellContents = DocAppend
+ (DocString " ")
+ (DocAppend
+ (DocMathDisplay
+ (concat
+ [" \n",
+ " f(n) = \\sum_{i=1} \n",
+ " "]))
+ (DocString " ")),
+ tableCellRowspan = 2}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " body row 4 ",
+ tableCellRowspan = 1}]],
+ tableHeaderRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ (concat
+ [" Header row, column 1 \n",
+ " (header rows optional) "]),
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ (concat [" Header 2 \n", " "]),
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ (concat [" Header 3 \n", " "]),
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ (concat [" Header 4 \n", " "]),
+ tableCellRowspan = 1}]]}
diff --git a/haddock-library/fixtures/examples/table2.input b/haddock-library/fixtures/examples/table2.input
new file mode 100644
index 00000000..aa5d0862
--- /dev/null
+++ b/haddock-library/fixtures/examples/table2.input
@@ -0,0 +1,7 @@
++--------------+----------+-----------+-----------+
+| row 1, col 1 | column 2 | column 3 | column 4 |
++--------------+----------+-----------+-----------+
+| row 2 | |
++--------------+----------+-----------+-----------+
+| row 3 | | | |
++--------------+----------+-----------+-----------+
diff --git a/haddock-library/fixtures/examples/table2.parsed b/haddock-library/fixtures/examples/table2.parsed
new file mode 100644
index 00000000..e3dbf0b4
--- /dev/null
+++ b/haddock-library/fixtures/examples/table2.parsed
@@ -0,0 +1,46 @@
+DocTable
+ Table
+ {tableBodyRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " row 1, col 1 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 2 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 3 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 4 ",
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " row 2 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 3,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " row 3 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1}]],
+ tableHeaderRows = []}
diff --git a/haddock-library/fixtures/examples/table3.input b/haddock-library/fixtures/examples/table3.input
new file mode 100644
index 00000000..a6ca84ca
--- /dev/null
+++ b/haddock-library/fixtures/examples/table3.input
@@ -0,0 +1,7 @@
++--------------+----------+-----------+-----------+
+| row 1, col 1 | column 2 | column 3 | column 4 |
++--------------+----------+-----------+-----------+
+| row 2 | Use the command ``ls | more``. |
++--------------+----------+-----------+-----------+
+| row 3 | | | |
++--------------+----------+-----------+-----------+
diff --git a/haddock-library/fixtures/examples/table3.parsed b/haddock-library/fixtures/examples/table3.parsed
new file mode 100644
index 00000000..cabff9cb
--- /dev/null
+++ b/haddock-library/fixtures/examples/table3.parsed
@@ -0,0 +1,50 @@
+DocTable
+ Table
+ {tableBodyRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " row 1, col 1 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 2 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 3 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 4 ",
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " row 2 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 2,
+ tableCellContents = DocString " Use the command ``ls ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " more``. ",
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " row 3 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1}]],
+ tableHeaderRows = []}
diff --git a/haddock-library/fixtures/examples/table4.input b/haddock-library/fixtures/examples/table4.input
new file mode 100644
index 00000000..2c5611c8
--- /dev/null
+++ b/haddock-library/fixtures/examples/table4.input
@@ -0,0 +1,17 @@
+Single outer cell:
+
++-------------+
+| outer |
+| |
++-------+ |
+| inner | |
++-------+-----+
+
+Broken (only inner cell is rendered):
+
++-------+-----+
+| inner | |
++-------+ |
+| |
+| outer |
++-------------+
diff --git a/haddock-library/fixtures/examples/table4.parsed b/haddock-library/fixtures/examples/table4.parsed
new file mode 100644
index 00000000..cfdd6f0f
--- /dev/null
+++ b/haddock-library/fixtures/examples/table4.parsed
@@ -0,0 +1,26 @@
+DocAppend
+ (DocParagraph (DocString "Single outer cell:"))
+ (DocAppend
+ (DocTable
+ Table
+ {tableBodyRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ (concat
+ [" outer \n",
+ " \n",
+ "-------+ \n",
+ " inner | "]),
+ tableCellRowspan = 1}]],
+ tableHeaderRows = []})
+ (DocAppend
+ (DocParagraph (DocString "Broken (only inner cell is rendered):"))
+ (DocTable
+ Table
+ {tableBodyRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " inner ",
+ tableCellRowspan = 1}]],
+ tableHeaderRows = []})))
diff --git a/haddock-library/fixtures/examples/table5.input b/haddock-library/fixtures/examples/table5.input
new file mode 100644
index 00000000..7cf26512
--- /dev/null
+++ b/haddock-library/fixtures/examples/table5.input
@@ -0,0 +1,8 @@
++--------------+----------+-----------+-----------+
+| row 1, col 1 | column 2 | column 3 | column 4 |
++==============+==========+===========+===========+
+| row 2 | Use the command @ls | more@. |
+| | |
+| +----------+-----------+-----------+
+| row 3 | | | |
++--------------+----------+-----------+-----------+
diff --git a/haddock-library/fixtures/examples/table5.parsed b/haddock-library/fixtures/examples/table5.parsed
new file mode 100644
index 00000000..9a547ad3
--- /dev/null
+++ b/haddock-library/fixtures/examples/table5.parsed
@@ -0,0 +1,53 @@
+DocTable
+ Table
+ {tableBodyRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString
+ (concat
+ [" row 2 \n",
+ " \n",
+ " \n",
+ " row 3 "]),
+ tableCellRowspan = 2},
+ TableCell
+ {tableCellColspan = 3,
+ tableCellContents = DocAppend
+ (DocString " Use the command ")
+ (DocAppend
+ (DocMonospaced (DocString "ls | more"))
+ (DocString
+ (concat
+ [". \n",
+ " "]))),
+ tableCellRowspan = 1}],
+ TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " ",
+ tableCellRowspan = 1}]],
+ tableHeaderRows = [TableRow
+ [TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " row 1, col 1 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 2 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 3 ",
+ tableCellRowspan = 1},
+ TableCell
+ {tableCellColspan = 1,
+ tableCellContents = DocString " column 4 ",
+ tableCellRowspan = 1}]]}
diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index 2707a928..62df724b 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -18,12 +18,14 @@ build-type: Simple
cabal-version: >= 2.0
extra-source-files:
CHANGES.md
+
library
default-language: Haskell2010
build-depends:
base >= 4.5 && < 4.12
, bytestring >= 0.9.2.1 && < 0.11
+ , containers >= 0.4.2.1 && < 0.6
, transformers >= 0.3.0 && < 0.6
-- internal sub-lib
@@ -108,6 +110,7 @@ test-suite spec
build-depends:
base-compat ^>= 0.9.3
+ , containers >= 0.4.2.1 && < 0.6
, transformers >= 0.3.0 && < 0.6
, hspec ^>= 2.4.4
, QuickCheck ^>= 2.10
diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs
index 1bf6c084..da8edcd4 100644
--- a/haddock-library/src/Documentation/Haddock/Markup.hs
+++ b/haddock-library/src/Documentation/Haddock/Markup.hs
@@ -30,6 +30,7 @@ markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax
markup m (DocProperty p) = markupProperty m p
markup m (DocExamples e) = markupExample m e
markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t))
+markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b))
markupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a)
markupPair m (a,b) = (markup m a, markup m b)
@@ -59,5 +60,6 @@ idMarkup = Markup {
markupMathDisplay = DocMathDisplay,
markupProperty = DocProperty,
markupExample = DocExamples,
- markupHeader = DocHeader
+ markupHeader = DocHeader,
+ markupTable = DocTable
}
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 4ea87db7..a1349c95 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -24,15 +24,17 @@ import Control.Arrow (first)
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Char (chr, isAsciiUpper)
-import Data.List (stripPrefix, intercalate, unfoldr)
-import Data.Maybe (fromMaybe)
+import Data.List (stripPrefix, intercalate, unfoldr, elemIndex)
+import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid
+import qualified Data.Set as Set
import Documentation.Haddock.Doc
import Documentation.Haddock.Parser.Monad hiding (take, endOfLine)
import Documentation.Haddock.Parser.Util
import Documentation.Haddock.Types
import Documentation.Haddock.Utf8
import Prelude hiding (takeWhile)
+import qualified Prelude as P
-- $setup
-- >>> :set -XOverloadedStrings
@@ -79,6 +81,7 @@ overIdentifier f d = g d
g (DocProperty x) = DocProperty x
g (DocExamples x) = DocExamples x
g (DocHeader (Header l x)) = DocHeader . Header l $ g x
+ g (DocTable (Table h b)) = DocTable (Table (map (fmap g) h) (map (fmap g) b))
parse :: Parser a -> BS.ByteString -> (ParserState, a)
parse p = either err id . parseOnly (p <* endOfInput)
@@ -251,7 +254,7 @@ markdownImage = fromHyperlink <$> ("!" *> linkParser)
-- | Paragraph parser, called by 'parseParas'.
paragraph :: Parser (DocH mod Identifier)
-paragraph = examples <|> do
+paragraph = examples <|> table <|> do
indent <- takeIndent
choice
[ since
@@ -266,6 +269,193 @@ paragraph = examples <|> do
, docParagraph <$> textParagraph
]
+-- | Provides support for grid tables.
+--
+-- Tables are composed by an optional header and body. The header is composed by
+-- a single row. The body is composed by a non-empty list of rows.
+--
+-- Example table with header:
+--
+-- > +----------+----------+
+-- > | /32bit/ | 64bit |
+-- > +==========+==========+
+-- > | 0x0000 | @0x0000@ |
+-- > +----------+----------+
+--
+-- Algorithms loosely follows ideas in
+-- http://docutils.sourceforge.net/docutils/parsers/rst/tableparser.py
+--
+table :: Parser (DocH mod Identifier)
+table = do
+ -- first we parse the first row, which determines the width of the table
+ firstRow <- parseFirstRow
+ let len = BS.length firstRow
+
+ -- then we parse all consequtive rows starting and ending with + or |,
+ -- of the width `len`.
+ restRows <- many (parseRestRows len)
+
+ -- Now we gathered the table block, the next step is to split the block
+ -- into cells.
+ DocTable <$> tableStepTwo len (firstRow : restRows)
+ where
+ parseFirstRow :: Parser BS.ByteString
+ parseFirstRow = do
+ skipHorizontalSpace
+ -- upper-left corner is +
+ c <- char '+'
+ cs <- many1 (char '-' <|> char '+')
+
+ -- upper right corner is + too
+ guard (last cs == '+')
+
+ -- trailing space
+ skipHorizontalSpace
+ _ <- char '\n'
+
+ return (BS.cons c $ BS.pack cs)
+
+ parseRestRows :: Int -> Parser BS.ByteString
+ parseRestRows l = do
+ skipHorizontalSpace
+
+ c <- char '|' <|> char '+'
+ bs <- scan (l - 2) predicate
+ c2 <- char '|' <|> char '+'
+
+ -- trailing space
+ skipHorizontalSpace
+ _ <- char '\n'
+
+ return (BS.cons c (BS.snoc bs c2))
+ where
+ predicate n c
+ | n <= 0 = Nothing
+ | c == '\n' = Nothing
+ | otherwise = Just (n - 1)
+
+-- Second step searchs for row of '+' and '=' characters, records it's index
+-- and changes to '=' to '-'.
+tableStepTwo
+ :: Int -- ^ width
+ -> [BS.ByteString] -- ^ rows
+ -> Parser (Table (DocH mod Identifier))
+tableStepTwo width = go 0 [] where
+ go _ left [] = tableStepThree width (reverse left) Nothing
+ go n left (r : rs)
+ | BS.all (`elem` ['+', '=']) r =
+ tableStepThree width (reverse left ++ r' : rs) (Just n)
+ | otherwise =
+ go (n + 1) (r : left) rs
+ where
+ r' = BS.map (\c -> if c == '=' then '-' else c) r
+
+-- Third step recognises cells in the table area, returning a list of TC, cells.
+tableStepThree
+ :: Int -- ^ width
+ -> [BS.ByteString] -- ^ rows
+ -> Maybe Int -- ^ index of header separator
+ -> Parser (Table (DocH mod Identifier))
+tableStepThree width rs hdrIndex = do
+ cells <- loop (Set.singleton (0, 0))
+ tableStepFour rs hdrIndex cells
+ where
+ height = length rs
+
+ loop :: Set.Set (Int, Int) -> Parser [TC]
+ loop queue = case Set.minView queue of
+ Nothing -> return []
+ Just ((y, x), queue')
+ | y + 1 >= height || x + 1 >= width -> loop queue'
+ | otherwise -> case scanRight x y of
+ Nothing -> loop queue'
+ Just (x2, y2) -> do
+ let tc = TC y x y2 x2
+ fmap (tc :) $ loop $ queue' `Set.union` Set.fromList
+ [(y, x2), (y2, x), (y2, x2)]
+
+ -- scan right looking for +, then try scan down
+ --
+ -- do we need to record + saw on the way left and down?
+ scanRight :: Int -> Int -> Maybe (Int, Int)
+ scanRight x y = go (x + 1) where
+ bs = rs !! y
+ go x' | x' >= width = fail "overflow right "
+ | BS.index bs x' == '+' = scanDown x y x' <|> go (x' + 1)
+ | BS.index bs x' == '-' = go (x' + 1)
+ | otherwise = fail $ "not a border (right) " ++ show (x,y,x')
+
+ -- scan down looking for +
+ scanDown :: Int -> Int -> Int -> Maybe (Int, Int)
+ scanDown x y x2 = go (y + 1) where
+ go y' | y' >= height = fail "overflow down"
+ | BS.index (rs !! y') x2 == '+' = scanLeft x y x2 y' <|> go (y' + 1)
+ | BS.index (rs !! y') x2 == '|' = go (y' + 1)
+ | otherwise = fail $ "not a border (down) " ++ show (x,y,x2,y')
+
+ -- check that at y2 x..x2 characters are '+' or '-'
+ scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
+ scanLeft x y x2 y2
+ | all (\x' -> BS.index bs x' `elem` ['+', '-']) [x..x2] = scanUp x y x2 y2
+ | otherwise = fail $ "not a border (left) " ++ show (x,y,x2,y2)
+ where
+ bs = rs !! y2
+
+ -- check that at y2 x..x2 characters are '+' or '-'
+ scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
+ scanUp x y x2 y2
+ | all (\y' -> BS.index (rs !! y') x `elem` ['+', '|']) [y..y2] = return (x2, y2)
+ | otherwise = fail $ "not a border (up) " ++ show (x,y,x2,y2)
+
+-- | table cell: top left bottom right
+data TC = TC !Int !Int !Int !Int
+ deriving Show
+
+tcXS :: TC -> [Int]
+tcXS (TC _ x _ x2) = [x, x2]
+
+tcYS :: TC -> [Int]
+tcYS (TC y _ y2 _) = [y, y2]
+
+-- | Fourth step. Given the locations of cells, forms 'Table' structure.
+tableStepFour :: [BS.ByteString] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
+tableStepFour rs hdrIndex cells = case hdrIndex of
+ Nothing -> return $ Table [] rowsDoc
+ Just i -> case elemIndex i yTabStops of
+ Nothing -> return $ Table [] rowsDoc
+ Just i' -> return $ uncurry Table $ splitAt i' rowsDoc
+ where
+ xTabStops = sortNub $ concatMap tcXS cells
+ yTabStops = sortNub $ concatMap tcYS cells
+
+ sortNub :: Ord a => [a] -> [a]
+ sortNub = Set.toList . Set.fromList
+
+ init' :: [a] -> [a]
+ init' [] = []
+ init' [_] = []
+ init' (x : xs) = x : init' xs
+
+ rowsDoc = (fmap . fmap) parseStringBS rows
+
+ rows = map makeRow (init' yTabStops)
+ where
+ makeRow y = TableRow $ mapMaybe (makeCell y) cells
+ makeCell y (TC y' x y2 x2)
+ | y /= y' = Nothing
+ | otherwise = Just $ TableCell xts yts (extract (x + 1) (y + 1) (x2 - 1) (y2 - 1))
+ where
+ xts = length $ P.takeWhile (< x2) $ dropWhile (< x) xTabStops
+ yts = length $ P.takeWhile (< y2) $ dropWhile (< y) yTabStops
+
+ -- extract cell contents given boundaries
+ extract :: Int -> Int -> Int -> Int -> BS.ByteString
+ extract x y x2 y2 = BS.intercalate "\n"
+ [ BS.take (x2 - x + 1) $ BS.drop x $ rs !! y'
+ | y' <- [y .. y2]
+ ]
+
+-- | Parse \@since annotations.
since :: Parser (DocH mod a)
since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince >> return DocEmpty
where
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 1e76c631..96653864 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -81,6 +81,21 @@ data Example = Example
, exampleResult :: [String]
} deriving (Eq, Show)
+data TableCell id = TableCell
+ { tableCellColspan :: Int
+ , tableCellRowspan :: Int
+ , tableCellContents :: id
+ } deriving (Eq, Show, Functor, Foldable, Traversable)
+
+newtype TableRow id = TableRow
+ { tableRowCells :: [TableCell id]
+ } deriving (Eq, Show, Functor, Foldable, Traversable)
+
+data Table id = Table
+ { tableHeaderRows :: [TableRow id]
+ , tableBodyRows :: [TableRow id]
+ } deriving (Eq, Show, Functor, Foldable, Traversable)
+
data DocH mod id
= DocEmpty
| DocAppend (DocH mod id) (DocH mod id)
@@ -105,6 +120,7 @@ data DocH mod id
| DocProperty String
| DocExamples [Example]
| DocHeader (Header (DocH mod id))
+ | DocTable (Table (DocH mod id))
deriving (Eq, Show, Functor, Foldable, Traversable)
#if MIN_VERSION_base(4,8,0)
@@ -132,6 +148,7 @@ instance Bifunctor DocH where
bimap _ _ (DocProperty s) = DocProperty s
bimap _ _ (DocExamples examples) = DocExamples examples
bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title))
+ bimap f g (DocTable (Table header body)) = DocTable (Table (map (fmap (bimap f g)) header) (map (fmap (bimap f g)) body))
#endif
#if MIN_VERSION_base(4,10,0)
@@ -149,6 +166,7 @@ instance Bifoldable DocH where
bifoldr f g z (DocDefList docs) = foldr (\(l, r) acc -> bifoldr f g (bifoldr f g acc l) r) z docs
bifoldr f g z (DocCodeBlock doc) = bifoldr f g z doc
bifoldr f g z (DocHeader (Header _ title)) = bifoldr f g z title
+ bifoldr f g z (DocTable (Table header body)) = foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) (foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) z body) header
bifoldr _ _ z _ = z
instance Bitraversable DocH where
@@ -175,6 +193,7 @@ instance Bitraversable DocH where
bitraverse _ _ (DocProperty s) = pure (DocProperty s)
bitraverse _ _ (DocExamples examples) = pure (DocExamples examples)
bitraverse f g (DocHeader (Header level title)) = (DocHeader . Header level) <$> bitraverse f g title
+ bitraverse f g (DocTable (Table header body)) = (\h b -> DocTable (Table h b)) <$> traverse (traverse (bitraverse f g)) header <*> traverse (traverse (bitraverse f g)) body
#endif
-- | 'DocMarkupH' is a set of instructions for marking up documentation.
@@ -209,4 +228,5 @@ data DocMarkupH mod id a = Markup
, markupProperty :: String -> a
, markupExample :: [Example] -> a
, markupHeader :: Header a -> a
+ , markupTable :: Table a -> a
}
diff --git a/html-test/ref/Table.html b/html-test/ref/Table.html
new file mode 100644
index 00000000..959f18b2
--- /dev/null
+++ b/html-test/ref/Table.html
@@ -0,0 +1,238 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><title
+ >Table</title
+ ><link href="#" rel="stylesheet" type="text/css" title="Ocean"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+ ></script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+ ></script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="#"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="#"
+ >Index</a
+ ></li
+ ></ul
+ ><p class="caption empty"
+ ></p
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >Table</p
+ ></div
+ ><div id="description"
+ ><p class="caption"
+ >Description</p
+ ><div class="doc"
+ ><p
+ >This tests the table markup</p
+ ></div
+ ></div
+ ><div id="synopsis"
+ ><details id="syn"
+ ><summary
+ >Synopsis</summary
+ ><ul class="details-toggle" data-details-id="syn"
+ ><li class="src short"
+ ><a href="#"
+ >tableWithHeader</a
+ > :: a -&gt; a</li
+ ><li class="src short"
+ ><a href="#"
+ >tableWithoutHeader</a
+ > :: a -&gt; a</li
+ ><li class="src short"
+ ><a href="#"
+ >fancyTable</a
+ > :: a -&gt; a</li
+ ></ul
+ ></details
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:tableWithHeader" class="def"
+ >tableWithHeader</a
+ > :: a -&gt; a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Table with header.</p
+ ><table
+ ><thead
+ ><tr
+ ><th
+ > code </th
+ ><th
+ > message </th
+ ><th
+ > description </th
+ ></tr
+ ></thead
+ ><tbody
+ ><tr
+ ><td
+ > 200 </td
+ ><td
+ > <code
+ >OK</code
+ > </td
+ ><td
+ > operation successful </td
+ ></tr
+ ><tr
+ ><td
+ > 204 </td
+ ><td
+ > <code
+ >No Content</code
+ > </td
+ ><td
+ > operation successful, no body returned </td
+ ></tr
+ ></tbody
+ ></table
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:tableWithoutHeader" class="def"
+ >tableWithoutHeader</a
+ > :: a -&gt; a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Table without header.</p
+ ><table
+ ><tbody
+ ><tr
+ ><td
+ > 200 </td
+ ><td
+ > <code
+ >OK</code
+ > </td
+ ><td
+ > operation successful </td
+ ></tr
+ ><tr
+ ><td
+ > 204 </td
+ ><td
+ > <code
+ >No Content</code
+ > </td
+ ><td
+ > operation successful, no body returned </td
+ ></tr
+ ><tr
+ ><td
+ > 404 </td
+ ><td
+ > <code
+ >Not Found</code
+ > </td
+ ><td
+ > resource not found </td
+ ></tr
+ ></tbody
+ ></table
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:fancyTable" class="def"
+ >fancyTable</a
+ > :: a -&gt; a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Fancy table.</p
+ ><table
+ ><thead
+ ><tr
+ ><th
+ > Header row, column 1
+ (header rows optional) </th
+ ><th
+ > Header 2
+ </th
+ ><th
+ > Header 3
+ </th
+ ><th
+ > Header 4
+ </th
+ ></tr
+ ></thead
+ ><tbody
+ ><tr
+ ><td
+ > body row 1, column 1 </td
+ ><td
+ > column 2 </td
+ ><td
+ > column 3 </td
+ ><td
+ > column 4 </td
+ ></tr
+ ><tr
+ ><td
+ > <code
+ ><a href="#"
+ >tableWithHeader</a
+ ></code
+ > </td
+ ><td colspan="3"
+ > Cells may span columns. </td
+ ></tr
+ ><tr
+ ><td
+ > body row 3 </td
+ ><td rowspan="2"
+ > Cells may
+ span rows.
+ </td
+ ><td colspan="2" rowspan="2"
+ > \[
+ f(n) = \sum_{i=1}
+ \] </td
+ ></tr
+ ><tr
+ ><td
+ > body row 4 </td
+ ></tr
+ ></tbody
+ ></table
+ ></div
+ ></div
+ ></div
+ ></div
+ ><div id="footer"
+ ></div
+ ></body
+ ></html
+> \ No newline at end of file
diff --git a/html-test/src/Table.hs b/html-test/src/Table.hs
new file mode 100644
index 00000000..2cf0c662
--- /dev/null
+++ b/html-test/src/Table.hs
@@ -0,0 +1,47 @@
+-- | This tests the table markup
+module Table
+ ( tableWithHeader
+ , tableWithoutHeader
+ , fancyTable
+ ) where
+
+-- | Table with header.
+--
+-- +------+--------------+------------------------------------------+
+-- | code | message | description |
+-- +======+==============+==========================================+
+-- | 200 | @OK@ | operation successful |
+-- +------+--------------+------------------------------------------+
+-- | 204 | @No Content@ | operation successful, no body returned |
+-- +------+--------------+------------------------------------------+
+tableWithHeader :: a -> a
+tableWithHeader a = a
+
+-- | Table without header.
+--
+-- +------+--------------+------------------------------------------+
+-- | 200 | @OK@ | operation successful |
+-- +------+--------------+------------------------------------------+
+-- | 204 | @No Content@ | operation successful, no body returned |
+-- +------+--------------+------------------------------------------+
+-- | 404 | @Not Found@ | resource not found |
+-- +------+--------------+------------------------------------------+
+tableWithoutHeader :: a -> a
+tableWithoutHeader a = a
+
+-- | Fancy table.
+--
+-- +------------------------+------------+----------+----------+
+-- | Header row, column 1 | Header 2 | Header 3 | Header 4 |
+-- | (header rows optional) | | | |
+-- +========================+============+==========+==========+
+-- | body row 1, column 1 | column 2 | column 3 | column 4 |
+-- +------------------------+------------+----------+----------+
+-- | 'tableWithHeader' | Cells may span columns. |
+-- +------------------------+------------+---------------------+
+-- | body row 3 | Cells may | \[ |
+-- +------------------------+ span rows. | f(n) = \sum_{i=1} |
+-- | body row 4 | | \] |
+-- +------------------------+------------+---------------------+
+fancyTable :: a -> a
+fancyTable x = x