Skip to content
This repository was archived by the owner on Aug 3, 2024. It is now read-only.

Commit 088b199

Browse files
phadejalexbiehl
phadej
authored and
alexbiehl
committed
Grid Tables (#718)
* Add table examples * Add table types and adopt simple parser Simple parser is done by Giovanni Cappellotto (@potomak) in #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
1 parent 2e0d7ae commit 088b199

29 files changed

+996
-7
lines changed

‎CHANGES.md

+2
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22

33
* to be released
44

5+
* Haddock now supports tables in documentation inspired by reSTs grid tables
6+
57
* A --reexport flag, which can be used to add extra modules to the
68
top-level module tree
79

‎doc/markup.rst

+20
Original file line numberDiff line numberDiff line change
@@ -1078,6 +1078,26 @@ If the output format supports it, the mathematics will be rendered
10781078
inside the documentation. For example, the HTML backend will display
10791079
the mathematics via `MathJax <https://www.mathjax.org>`__.
10801080

1081+
Grid Tables
1082+
~~~~~~~~~~~
1083+
1084+
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. ::
1085+
1086+
-- | This is a grid table:
1087+
--
1088+
-- +------------------------+------------+----------+----------+
1089+
-- | Header row, column 1 | Header 2 | Header 3 | Header 4 |
1090+
-- | (header rows optional) | | | |
1091+
-- +========================+============+==========+==========+
1092+
-- | body row 1, column 1 | column 2 | column 3 | column 4 |
1093+
-- +------------------------+------------+----------+----------+
1094+
-- | body row 2 | Cells may span columns. |
1095+
-- +------------------------+------------+---------------------+
1096+
-- | body row 3 | Cells may | \[ |
1097+
-- +------------------------+ span rows. | f(n) = \sum_{i=1} |
1098+
-- | body row 4 | | \] |
1099+
-- +------------------------+------------+---------------------+
1100+
10811101
Anchors
10821102
~~~~~~~
10831103

‎haddock-api/resources/html/Classic.theme/xhaddock.css

+14
Original file line numberDiff line numberDiff line change
@@ -392,6 +392,20 @@ td.rdoc p {
392392
}
393393

394394

395+
.doc table {
396+
border-collapse: collapse;
397+
border-spacing: 0px;
398+
}
399+
400+
.doc th,
401+
.doc td {
402+
padding: 5px;
403+
border: 1px solid #ddd;
404+
}
405+
406+
.doc th {
407+
background-color: #f0f0f0;
408+
}
395409

396410
#footer {
397411
background-color: #000099;

‎haddock-api/resources/html/Ocean.std-theme/ocean.css

+15
Original file line numberDiff line numberDiff line change
@@ -443,6 +443,21 @@ div#style-menu-holder {
443443
margin-top: 0.8em;
444444
}
445445

446+
.doc table {
447+
border-collapse: collapse;
448+
border-spacing: 0px;
449+
}
450+
451+
.doc th,
452+
.doc td {
453+
padding: 5px;
454+
border: 1px solid #ddd;
455+
}
456+
457+
.doc th {
458+
background-color: #f0f0f0;
459+
}
460+
446461
.clearfix:after {
447462
clear: both;
448463
content: " ";

‎haddock-api/src/Haddock/Backends/Hoogle.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -328,7 +328,8 @@ markupTag dflags = Markup {
328328
markupAName = const $ str "",
329329
markupProperty = box TagPre . str,
330330
markupExample = box TagPre . str . unlines . map exampleToString,
331-
markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h
331+
markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h,
332+
markupTable = \(Table _ _) -> str "TODO: table"
332333
}
333334

334335

‎haddock-api/src/Haddock/Backends/LaTeX.hs

+4-1
Original file line numberDiff line numberDiff line change
@@ -1140,7 +1140,8 @@ parLatexMarkup ppId = Markup {
11401140
markupAName = \_ _ -> empty,
11411141
markupProperty = \p _ -> quote $ verb $ text p,
11421142
markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e,
1143-
markupHeader = \(Header l h) p -> header l (h p)
1143+
markupHeader = \(Header l h) p -> header l (h p),
1144+
markupTable = \(Table h b) p -> table h b p
11441145
}
11451146
where
11461147
header 1 d = text "\\section*" <> braces d
@@ -1149,6 +1150,8 @@ parLatexMarkup ppId = Markup {
11491150
| l > 0 && l <= 6 = text "\\subsubsection*" <> braces d
11501151
header l _ = error $ "impossible header level in LaTeX generation: " ++ show l
11511152

1153+
table _ _ _ = text "{TODO: Table}"
1154+
11521155
fixString Plain s = latexFilter s
11531156
fixString Verb s = s
11541157
fixString Mono s = latexMonoFilter s

‎haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs

+18-1
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
7373
markupMathDisplay = \mathjax -> toHtml ("\\[" ++ mathjax ++ "\\]"),
7474
markupProperty = pre . toHtml,
7575
markupExample = examplesToHtml,
76-
markupHeader = \(Header l t) -> makeHeader l t
76+
markupHeader = \(Header l t) -> makeHeader l t,
77+
markupTable = \(Table h r) -> makeTable h r
7778
}
7879
where
7980
makeHeader :: Int -> Html -> Html
@@ -85,6 +86,22 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
8586
makeHeader 6 mkup = h6 mkup
8687
makeHeader l _ = error $ "Somehow got a header level `" ++ show l ++ "' in DocMarkup!"
8788

89+
makeTable :: [TableRow Html] -> [TableRow Html] -> Html
90+
makeTable hs bs = table (concatHtml (hs' ++ bs'))
91+
where
92+
hs' | null hs = []
93+
| otherwise = [thead (concatHtml (map (makeTableRow th) hs))]
94+
95+
bs' = [tbody (concatHtml (map (makeTableRow td) bs))]
96+
97+
makeTableRow :: (Html -> Html) -> TableRow Html -> Html
98+
makeTableRow thr (TableRow cs) = tr (concatHtml (map (makeTableCell thr) cs))
99+
100+
makeTableCell :: (Html -> Html) -> TableCell Html -> Html
101+
makeTableCell thr (TableCell i j c) = thr c ! (i' ++ j')
102+
where
103+
i' = if i == 1 then [] else [ colspan i ]
104+
j' = if j == 1 then [] else [ rowspan j ]
88105

89106
examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
90107

‎haddock-api/src/Haddock/Interface/LexParseRn.hs

+1
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,7 @@ rename dflags gre = rn
144144
DocEmpty -> pure (DocEmpty)
145145
DocString str -> pure (DocString str)
146146
DocHeader (Header l t) -> DocHeader . Header l <$> rn t
147+
DocTable t -> DocTable <$> traverse rn t
147148

148149
-- | Wrap an identifier that's out of scope (i.e. wasn't found in
149150
-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently

‎haddock-api/src/Haddock/InterfaceFile.hs

+32
Original file line numberDiff line numberDiff line change
@@ -459,6 +459,32 @@ instance Binary a => Binary (Header a) where
459459
t <- get bh
460460
return (Header l t)
461461

462+
instance Binary a => Binary (Table a) where
463+
put_ bh (Table h b) = do
464+
put_ bh h
465+
put_ bh b
466+
get bh = do
467+
h <- get bh
468+
b <- get bh
469+
return (Table h b)
470+
471+
instance Binary a => Binary (TableRow a) where
472+
put_ bh (TableRow cs) = put_ bh cs
473+
get bh = do
474+
cs <- get bh
475+
return (TableRow cs)
476+
477+
instance Binary a => Binary (TableCell a) where
478+
put_ bh (TableCell i j c) = do
479+
put_ bh i
480+
put_ bh j
481+
put_ bh c
482+
get bh = do
483+
i <- get bh
484+
j <- get bh
485+
c <- get bh
486+
return (TableCell i j c)
487+
462488
instance Binary Meta where
463489
put_ bh Meta { _version = v } = put_ bh v
464490
get bh = (\v -> Meta { _version = v }) <$> get bh
@@ -542,6 +568,9 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where
542568
put_ bh (DocMathDisplay x) = do
543569
putByte bh 22
544570
put_ bh x
571+
put_ bh (DocTable x) = do
572+
putByte bh 23
573+
put_ bh x
545574

546575
get bh = do
547576
h <- getByte bh
@@ -615,6 +644,9 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where
615644
22 -> do
616645
x <- get bh
617646
return (DocMathDisplay x)
647+
23 -> do
648+
x <- get bh
649+
return (DocTable x)
618650
_ -> error "invalid binary data found in the interface file"
619651

620652

‎haddock-api/src/Haddock/Types.hs

+9
Original file line numberDiff line numberDiff line change
@@ -454,6 +454,7 @@ instance (NFData a, NFData mod)
454454
DocProperty a -> a `deepseq` ()
455455
DocExamples a -> a `deepseq` ()
456456
DocHeader a -> a `deepseq` ()
457+
DocTable a -> a `deepseq` ()
457458

458459
#if !MIN_VERSION_ghc(8,0,2)
459460
-- These were added to GHC itself in 8.0.2
@@ -474,6 +475,14 @@ instance NFData Picture where
474475
instance NFData Example where
475476
rnf (Example a b) = a `deepseq` b `deepseq` ()
476477

478+
instance NFData id => NFData (Table id) where
479+
rnf (Table h b) = h `deepseq` b `deepseq` ()
480+
481+
instance NFData id => NFData (TableRow id) where
482+
rnf (TableRow cs) = cs `deepseq` ()
483+
484+
instance NFData id => NFData (TableCell id) where
485+
rnf (TableCell i j c) = i `deepseq` j `deepseq` c `deepseq` ()
477486

478487
exampleToString :: Example -> String
479488
exampleToString (Example expression result) =

‎haddock-library/fixtures/Fixtures.hs

+9
Original file line numberDiff line numberDiff line change
@@ -151,3 +151,12 @@ instance ToExpr Picture
151151

152152
deriving instance Generic Example
153153
instance ToExpr Example
154+
155+
deriving instance Generic (Table id)
156+
instance ToExpr id => ToExpr (Table id)
157+
158+
deriving instance Generic (TableRow id)
159+
instance ToExpr id => ToExpr (TableRow id)
160+
161+
deriving instance Generic (TableCell id)
162+
instance ToExpr id => ToExpr (TableCell id)

‎haddock-library/fixtures/examples/table-simple.input

+7
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
+------+--------------+------------------------------------------+
2+
| code | message | description |
3+
+======+==============+==========================================+
4+
| 200 | @OK@ | operation successful |
5+
+------+--------------+------------------------------------------+
6+
| 204 | @No Content@ | operation successful, no body returned |
7+
+------+--------------+------------------------------------------+

‎haddock-library/fixtures/examples/table-simple.parsed

+52
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
DocTable
2+
Table
3+
{tableBodyRows = [TableRow
4+
[TableCell
5+
{tableCellColspan = 1,
6+
tableCellContents = DocString " 200 ",
7+
tableCellRowspan = 1},
8+
TableCell
9+
{tableCellColspan = 1,
10+
tableCellContents = DocAppend
11+
(DocString " ")
12+
(DocAppend
13+
(DocMonospaced (DocString "OK"))
14+
(DocString " ")),
15+
tableCellRowspan = 1},
16+
TableCell
17+
{tableCellColspan = 1,
18+
tableCellContents = DocString
19+
" operation successful ",
20+
tableCellRowspan = 1}],
21+
TableRow
22+
[TableCell
23+
{tableCellColspan = 1,
24+
tableCellContents = DocString " 204 ",
25+
tableCellRowspan = 1},
26+
TableCell
27+
{tableCellColspan = 1,
28+
tableCellContents = DocAppend
29+
(DocString " ")
30+
(DocAppend
31+
(DocMonospaced (DocString "No Content"))
32+
(DocString " ")),
33+
tableCellRowspan = 1},
34+
TableCell
35+
{tableCellColspan = 1,
36+
tableCellContents = DocString
37+
" operation successful, no body returned ",
38+
tableCellRowspan = 1}]],
39+
tableHeaderRows = [TableRow
40+
[TableCell
41+
{tableCellColspan = 1,
42+
tableCellContents = DocString " code ",
43+
tableCellRowspan = 1},
44+
TableCell
45+
{tableCellColspan = 1,
46+
tableCellContents = DocString " message ",
47+
tableCellRowspan = 1},
48+
TableCell
49+
{tableCellColspan = 1,
50+
tableCellContents = DocString
51+
" description ",
52+
tableCellRowspan = 1}]]}

‎haddock-library/fixtures/examples/table1.input

+12
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
+------------------------+------------+----------+----------+
2+
| Header row, column 1 | Header 2 | Header 3 | Header 4 |
3+
| (header rows optional) | | | |
4+
+========================+============+==========+==========+
5+
| body row 1, column 1 | column 2 | column 3 | column 4 |
6+
+------------------------+------------+----------+----------+
7+
| body row 2 | Cells may span columns. |
8+
+------------------------+------------+---------------------+
9+
| body row 3 | Cells may | \[ |
10+
+------------------------+ span rows. | f(n) = \sum_{i=1} |
11+
| body row 4 | | \] |
12+
+------------------------+------------+---------------------+

‎haddock-library/fixtures/examples/table1.parsed

+81
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
DocTable
2+
Table
3+
{tableBodyRows = [TableRow
4+
[TableCell
5+
{tableCellColspan = 1,
6+
tableCellContents = DocString " body row 1, column 1 ",
7+
tableCellRowspan = 1},
8+
TableCell
9+
{tableCellColspan = 1,
10+
tableCellContents = DocString " column 2 ",
11+
tableCellRowspan = 1},
12+
TableCell
13+
{tableCellColspan = 1,
14+
tableCellContents = DocString " column 3 ",
15+
tableCellRowspan = 1},
16+
TableCell
17+
{tableCellColspan = 1,
18+
tableCellContents = DocString " column 4 ",
19+
tableCellRowspan = 1}],
20+
TableRow
21+
[TableCell
22+
{tableCellColspan = 1,
23+
tableCellContents = DocString " body row 2 ",
24+
tableCellRowspan = 1},
25+
TableCell
26+
{tableCellColspan = 3,
27+
tableCellContents = DocString " Cells may span columns. ",
28+
tableCellRowspan = 1}],
29+
TableRow
30+
[TableCell
31+
{tableCellColspan = 1,
32+
tableCellContents = DocString " body row 3 ",
33+
tableCellRowspan = 1},
34+
TableCell
35+
{tableCellColspan = 1,
36+
tableCellContents = DocString
37+
(concat
38+
[" Cells may \n",
39+
" span rows. \n",
40+
" "]),
41+
tableCellRowspan = 2},
42+
TableCell
43+
{tableCellColspan = 2,
44+
tableCellContents = DocAppend
45+
(DocString " ")
46+
(DocAppend
47+
(DocMathDisplay
48+
(concat
49+
[" \n",
50+
" f(n) = \\sum_{i=1} \n",
51+
" "]))
52+
(DocString " ")),
53+
tableCellRowspan = 2}],
54+
TableRow
55+
[TableCell
56+
{tableCellColspan = 1,
57+
tableCellContents = DocString " body row 4 ",
58+
tableCellRowspan = 1}]],
59+
tableHeaderRows = [TableRow
60+
[TableCell
61+
{tableCellColspan = 1,
62+
tableCellContents = DocString
63+
(concat
64+
[" Header row, column 1 \n",
65+
" (header rows optional) "]),
66+
tableCellRowspan = 1},
67+
TableCell
68+
{tableCellColspan = 1,
69+
tableCellContents = DocString
70+
(concat [" Header 2 \n", " "]),
71+
tableCellRowspan = 1},
72+
TableCell
73+
{tableCellColspan = 1,
74+
tableCellContents = DocString
75+
(concat [" Header 3 \n", " "]),
76+
tableCellRowspan = 1},
77+
TableCell
78+
{tableCellColspan = 1,
79+
tableCellContents = DocString
80+
(concat [" Header 4 \n", " "]),
81+
tableCellRowspan = 1}]]}

0 commit comments

Comments
 (0)