Skip to content

Commit

Permalink
Markdown writer: Use grid tables when needed, and if enabled.
Browse files Browse the repository at this point in the history
Closes #740.
  • Loading branch information
John MacFarlane committed Mar 1, 2013
1 parent 68c95f4 commit abdaa96
Showing 1 changed file with 31 additions and 1 deletion.
32 changes: 31 additions & 1 deletion src/Text/Pandoc/Writers/Markdown.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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]
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit abdaa96

Please sign in to comment.