blob: caef0a0ea1027907bc513838fffeec02db4c1434 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Writers.Markdown
Copyright : © 2006-2023 John MacFarlane
License : GPL-2.0-or-later
Maintainer : John MacFarlane <jgm@berkeley.edu>
Create Markdown pipe-tables and pandoc-style tables.
-}
module Text.Pandoc.Writers.Markdown.Table
( pipeTable
, pandocTable
) where
import Control.Monad.Reader (asks)
import Data.List (intersperse, transpose)
import Data.List.NonEmpty (nonEmpty)
import Data.Text (Text)
import qualified Data.Text as T
import Text.DocLayout
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition (Alignment (..))
import Text.Pandoc.Options (WriterOptions (writerColumns, writerWrapText),
WrapOption(WrapAuto))
import Text.Pandoc.Writers.Markdown.Types (MarkdownVariant(Markdown),
WriterEnv(..), MD)
-- | Creates a Markdown pipe table.
pipeTable :: PandocMonad m
=> WriterOptions
-> Bool -- ^ headless?
-> [Alignment] -- ^ column alignments
-> [Double] -- ^ column widhts
-> [Doc Text] -- ^ table header cells
-> [[Doc Text]] -- ^ table body rows
-> MD m (Doc Text)
pipeTable opts headless aligns widths rawHeaders rawRows = do
let sp = literal " "
let blockFor AlignLeft x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
blockFor AlignCenter x y = cblock (x + 2) (sp <> y <> sp) <> lblock 0 empty
blockFor AlignRight x y = rblock (x + 2) (y <> sp) <> lblock 0 empty
blockFor _ x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
let contentWidths = map (max 3 . maybe 3 maximum . nonEmpty . map offset) $
transpose (rawHeaders : rawRows)
let colwidth = writerColumns opts
let numcols = length contentWidths
let maxwidth = sum contentWidths
variant <- asks envVariant
let pipeWidths = if variant == Markdown &&
not (all (== 0) widths) &&
maxwidth + (numcols + 1) > colwidth
then map
(max 0 .
floor .
(* fromIntegral (colwidth - (numcols +1))))
widths
else contentWidths
let torow cs = nowrap $ literal "|" <>
hcat (intersperse (literal "|") $
zipWith3 blockFor aligns contentWidths (map chomp cs))
<> literal "|"
let toborder a w = literal $ case a of
AlignLeft -> ":" <> T.replicate (w + 1) "-"
AlignCenter -> ":" <> T.replicate w "-" <> ":"
AlignRight -> T.replicate (w + 1) "-" <> ":"
AlignDefault -> T.replicate (w + 2) "-"
-- note: pipe tables can't completely lack a
-- header; for a headerless table, we need a header of empty cells.
-- see jgm/pandoc#1996.
let header = if headless
then torow (replicate (length aligns) empty)
else torow rawHeaders
let border = nowrap $ literal "|" <> hcat (intersperse (literal "|") $
zipWith toborder aligns pipeWidths) <> literal "|"
let body = vcat $ map torow rawRows
return $ header $$ border $$ body
-- | Write a pandoc-style Markdown table.
pandocTable :: PandocMonad m
=> WriterOptions
-> Bool -- ^ whether this is a multiline table
-> Bool -- ^ whether the table has a header
-> [Alignment] -- ^ column alignments
-> [Double] -- ^ column widths
-> [Doc Text] -- ^ table header cells
-> [[Doc Text]] -- ^ table body rows
-> MD m (Doc Text)
pandocTable opts multiline headless aligns widths rawHeaders rawRows = do
let isSimple = all (==0) widths
let alignHeader alignment = case alignment of
AlignLeft -> lblock
AlignCenter -> cblock
AlignRight -> rblock
AlignDefault -> lblock
-- Number of characters per column necessary to output every cell
-- without requiring a line break.
-- The @+2@ is needed for specifying the alignment.
let numChars = (+ 2) . maybe 0 maximum . nonEmpty . map offset
-- Number of characters per column necessary to output every cell
-- without requiring a line break *inside a word*.
-- The @+2@ is needed for specifying the alignment.
let minNumChars = (+ 2) . maybe 0 maximum . nonEmpty . map minOffset
let columns = transpose (rawHeaders : rawRows)
-- minimal column width without wrapping a single word
let relWidth w col =
max (floor $ fromIntegral (writerColumns opts - 1) * w)
(if writerWrapText opts == WrapAuto
then minNumChars col
else numChars col)
let widthsInChars
| isSimple = map numChars columns
| otherwise = zipWith relWidth widths columns
let makeRow = hcat . intersperse (lblock 1 (literal " ")) .
zipWith3 alignHeader aligns widthsInChars
let rows' = map makeRow rawRows
let head' = makeRow rawHeaders
let underline = mconcat $ intersperse (literal " ") $
map (\width -> literal (T.replicate width "-")) widthsInChars
let border
| multiline = literal (T.replicate (sum widthsInChars +
length widthsInChars - 1) "-")
| headless = underline
| otherwise = empty
let head'' = if headless
then empty
else border <> cr <> head'
let body = if multiline
then vsep rows' $$
if length rows' < 2
then blankline -- #4578
else empty
else vcat rows'
let bottom = if headless
then underline
else border
return $ head'' $$ underline $$ body $$ bottom
|
