Skip to content
This repository was archived by the owner on Aug 3, 2024. It is now read-only.
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
20 changes: 20 additions & 0 deletions doc/markup.rst
Original file line number Diff line number Diff line change
Expand Up @@ -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
~~~~~~~

Expand Down
14 changes: 14 additions & 0 deletions haddock-api/resources/html/Classic.theme/xhaddock.css
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
15 changes: 15 additions & 0 deletions haddock-api/resources/html/Ocean.std-theme/ocean.css
Original file line number Diff line number Diff line change
Expand Up @@ -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: " ";
Expand Down
3 changes: 2 additions & 1 deletion haddock-api/src/Haddock/Backends/Hoogle.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
}


Expand Down
5 changes: 4 additions & 1 deletion haddock-api/src/Haddock/Backends/LaTeX.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1139,7 +1139,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
Expand All @@ -1148,6 +1149,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
Expand Down
19 changes: 18 additions & 1 deletion haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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"]

Expand Down
1 change: 1 addition & 0 deletions haddock-api/src/Haddock/Interface/LexParseRn.hs
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,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
Expand Down
32 changes: 32 additions & 0 deletions haddock-api/src/Haddock/InterfaceFile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -464,6 +464,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
Expand Down Expand Up @@ -547,6 +573,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
Expand Down Expand Up @@ -620,6 +649,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"


Expand Down
9 changes: 9 additions & 0 deletions haddock-api/src/Haddock/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -471,6 +471,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
Expand All @@ -491,6 +492,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) =
Expand Down
9 changes: 9 additions & 0 deletions haddock-library/fixtures/Fixtures.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
7 changes: 7 additions & 0 deletions haddock-library/fixtures/examples/table-simple.input
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
+------+--------------+------------------------------------------+
| code | message | description |
+======+==============+==========================================+
| 200 | @OK@ | operation successful |
+------+--------------+------------------------------------------+
| 204 | @No Content@ | operation successful, no body returned |
+------+--------------+------------------------------------------+
52 changes: 52 additions & 0 deletions haddock-library/fixtures/examples/table-simple.parsed
Original file line number Diff line number Diff line change
@@ -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}]]}
12 changes: 12 additions & 0 deletions haddock-library/fixtures/examples/table1.input
Original file line number Diff line number Diff line change
@@ -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 | | \] |
+------------------------+------------+---------------------+
81 changes: 81 additions & 0 deletions haddock-library/fixtures/examples/table1.parsed
Original file line number Diff line number Diff line change
@@ -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}]]}
Loading