Markdown writer: Use grid tables when needed, and if enabled.

Closes #740.
This commit is contained in:
John MacFarlane 2013-02-28 20:22:28 -08:00
parent 68c95f4857
commit abdaa96b03

View file

@ -349,6 +349,9 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
rawHeaders <- mapM (blockListToMarkdown opts) headers
rawRows <- mapM (mapM (blockListToMarkdown opts)) rows
let isSimple = all (==0) widths
let isPlainBlock (Plain _) = True
isPlainBlock _ = False
let hasBlocks = not (all isPlainBlock $ concat . concat $ headers:rows)
(nst,tbl) <- case isSimple of
True | isEnabled Ext_simple_tables opts -> fmap (nest 2,) $
pandocTable opts (all null headers) aligns widths
@ -358,9 +361,13 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
| otherwise -> fmap (id,) $
return $ text $ writeHtmlString def
$ Pandoc (Meta [] [] []) [t]
False | isEnabled Ext_multiline_tables opts -> fmap (nest 2,) $
False | not hasBlocks &&
isEnabled Ext_multiline_tables opts -> fmap (nest 2,) $
pandocTable opts (all null headers) aligns widths
rawHeaders rawRows
| isEnabled Ext_grid_tables opts -> fmap (id,) $
gridTable opts (all null headers) aligns widths
rawHeaders rawRows
| otherwise -> fmap (id,) $
return $ text $ writeHtmlString def
$ Pandoc (Meta [] [] []) [t]
@ -448,6 +455,29 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
else border
return $ head'' $$ underline $$ body $$ bottom
gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
-> [Doc] -> [[Doc]] -> State WriterState Doc
gridTable opts headless _aligns widths headers' rawRows = do
let widthsInChars = map (floor . (fromIntegral (writerColumns opts) *)) widths
let hpipeBlocks blocks = hcat [beg, middle, end]
where h = maximum (map height blocks)
sep' = lblock 3 $ vcat (map text $ replicate h " | ")
beg = lblock 2 $ vcat (map text $ replicate h "| ")
end = lblock 2 $ vcat (map text $ replicate h " |")
middle = chomp $ hcat $ intersperse sep' blocks
let makeRow = hpipeBlocks . zipWith lblock widthsInChars
let head' = makeRow headers'
let rows' = map (makeRow . map chomp) rawRows
let border ch = char '+' <> char ch <>
(hcat $ intersperse (char ch <> char '+' <> char ch) $
map (\l -> text $ replicate l ch) widthsInChars) <>
char ch <> char '+'
let body = vcat $ intersperse (border '-') rows'
let head'' = if headless
then empty
else head' $$ border '='
return $ border '-' $$ head'' $$ body $$ border '-'
-- | Convert bullet list item (list of blocks) to markdown.
bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc
bulletListItemToMarkdown opts items = do