437b9ec · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Started making markdown table writer sensitive to options.

437b9ecJohn MacFarlane14 years ago

src/Text/Pandoc/Readers/Markdown.hs+1−1

compare with master

unifiedsplit

@@ -47,7 +47,7 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )

47import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag,

48 isTextTag, isCommentTag )

49import Text.Pandoc.XML ( fromEntities )

50−import Data.Monoid hiding ((<>))

50+import Data.Monoid (mconcat, mempty)

51import qualified Data.Sequence as Seq -- TODO leaky abstraction, need better isNull in Builder

52import Control.Applicative ((<$>), (<*), (*>), (<$))

53import Control.Monad

src/Text/Pandoc/Writers/Markdown.hs+49−32

@@ -41,6 +41,7 @@ import Data.List ( group, isPrefixOf, find, intersperse, transpose )

41import Text.Pandoc.Pretty

42import Control.Monad.State

43import qualified Data.Set as Set

44+import Text.Pandoc.Writers.HTML (writeHtmlString)

45type Notes = [[Block]]

46type Notes = [[Block]]

46type Refs = [([Inline], Target)]

47type Refs = [([Inline], Target)]

@@ -280,66 +281,82 @@ blockToMarkdown opts (BlockQuote blocks) = do

280 else "> "

281 else "> "

281 contents <- blockListToMarkdown opts blocks

282 contents <- blockListToMarkdown opts blocks

282 return $ (prefixed leader contents) <> blankline

283 return $ (prefixed leader contents) <> blankline

283−blockToMarkdown opts (Table caption aligns widths headers rows) = do

284+blockToMarkdown opts t@(Table caption aligns widths headers rows) = do

284 caption' <- inlineListToMarkdown opts caption

285 caption' <- inlineListToMarkdown opts caption

285 let caption'' = if null caption || not (isEnabled Ext_table_captions opts)

286 let caption'' = if null caption || not (isEnabled Ext_table_captions opts)

286 then empty

287 then empty

287 else blankline <> ": " <> caption' <> blankline

288 else blankline <> ": " <> caption' <> blankline

289+ rawHeaders <- mapM (blockListToMarkdown opts) headers

288− headers' <- mapM (blockListToMarkdown opts) headers

290+ rawRows <- mapM (mapM (blockListToMarkdown opts)) rows

291+ let isSimple = all (==0) widths

292+ tbl <- case isSimple of

293+ True | isEnabled Ext_simple_tables opts ->

294+ simpleTable (all null headers) aligns rawHeaders rawRows

295+ | isEnabled Ext_pipe_tables opts ->

296+ undefined -- pipeTable aligns rawHeaders rawRows

297+ | otherwise ->

298+ return $ text

299+ $ writeHtmlString def (Pandoc (Meta [] [] []) [t])

300+ False | isEnabled Ext_multiline_tables opts ->

301+ undefined -- multilineTable (all null headers) aligns widths rawHeaders rawRows

302+ | otherwise ->

303+ return $ text

304+ $ writeHtmlString def (Pandoc (Meta [] [] []) [t])

305+ return $ tbl $$ blankline $$ caption'' $$ blankline

306+blockToMarkdown opts (BulletList items) = do

307+ contents <- mapM (bulletListItemToMarkdown opts) items

308+ return $ cat contents <> blankline

309+blockToMarkdown opts (OrderedList (start,sty,delim) items) = do

310+ let start' = if isEnabled Ext_startnum opts then start else 1

311+ let sty' = if isEnabled Ext_fancy_lists opts then sty else DefaultStyle

312+ let delim' = if isEnabled Ext_fancy_lists opts then delim else DefaultDelim

313+ let attribs = (start', sty', delim')

314+ let markers = orderedListMarkers attribs

315+ let markers' = map (\m -> if length m < 3

316+ then m ++ replicate (3 - length m) ' '

317+ else m) markers

318+ contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $

319+ zip markers' items

320+ return $ cat contents <> blankline

321+blockToMarkdown opts (DefinitionList items) = do

322+ contents <- mapM (definitionListItemToMarkdown opts) items

323+ return $ cat contents <> blankline

324+

325+simpleTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> State WriterState Doc

326+simpleTable headless aligns rawHeaders rawRows = do

289 let alignHeader alignment = case alignment of

327 let alignHeader alignment = case alignment of

290 AlignLeft -> lblock

328 AlignLeft -> lblock

291 AlignCenter -> cblock

329 AlignCenter -> cblock

292 AlignRight -> rblock

330 AlignRight -> rblock

293 AlignDefault -> lblock

331 AlignDefault -> lblock

294− rawRows <- mapM (mapM (blockListToMarkdown opts)) rows

295− let isSimple = all (==0) widths

296 let numChars = maximum . map offset

332 let numChars = maximum . map offset

297− let widthsInChars =

333+ let widthsInChars = map ((+2) . numChars) $ transpose (rawHeaders : rawRows)

298− if isSimple

334+ -- if isSimple

299− then map ((+2) . numChars) $ transpose (headers' : rawRows)

335+ -- then map ((+2) . numChars) $ transpose (rawHeaders : rawRows)

300− else map (floor . (fromIntegral (writerColumns opts) *)) widths

336+ -- else map (floor . (fromIntegral (writerColumns opts) *)) widths

301 let makeRow = hcat . intersperse (lblock 1 (text " ")) .

337 let makeRow = hcat . intersperse (lblock 1 (text " ")) .

302 (zipWith3 alignHeader aligns widthsInChars)

338 (zipWith3 alignHeader aligns widthsInChars)

303 let rows' = map makeRow rawRows

339 let rows' = map makeRow rawRows

304− let head' = makeRow headers'

340+ let head' = makeRow rawHeaders

305 let maxRowHeight = maximum $ map height (head':rows')

341 let maxRowHeight = maximum $ map height (head':rows')

306 let underline = cat $ intersperse (text " ") $

342 let underline = cat $ intersperse (text " ") $

307 map (\width -> text (replicate width '-')) widthsInChars

343 map (\width -> text (replicate width '-')) widthsInChars

308 let border = if maxRowHeight > 1

344 let border = if maxRowHeight > 1

309 then text (replicate (sum widthsInChars +

345 then text (replicate (sum widthsInChars +

310 length widthsInChars - 1) '-')

346 length widthsInChars - 1) '-')

311− else if all null headers

347+ else if headless

312 then underline

348 then underline

313 else empty

349 else empty

314− let head'' = if all null headers

350+ let head'' = if headless

315 then empty

351 then empty

316 else border <> cr <> head'

352 else border <> cr <> head'

317 let body = if maxRowHeight > 1

353 let body = if maxRowHeight > 1

318 then vsep rows'

354 then vsep rows'

319 else vcat rows'

355 else vcat rows'

320− let bottom = if all null headers

356+ let bottom = if headless

321 then underline

357 then underline

322 else border

358 else border

323− return $ nest 2 $ head'' $$ underline $$ body $$

359+ return $ head'' $$ underline $$ body $$ bottom

324− bottom $$ blankline $$ caption'' $$ blankline

325−blockToMarkdown opts (BulletList items) = do

326− contents <- mapM (bulletListItemToMarkdown opts) items

327− return $ cat contents <> blankline

328−blockToMarkdown opts (OrderedList (start,sty,delim) items) = do

329− let start' = if isEnabled Ext_startnum opts then start else 1

330− let sty' = if isEnabled Ext_fancy_lists opts then sty else DefaultStyle

331− let delim' = if isEnabled Ext_fancy_lists opts then delim else DefaultDelim

332− let attribs = (start', sty', delim')

333− let markers = orderedListMarkers attribs

334− let markers' = map (\m -> if length m < 3

335− then m ++ replicate (3 - length m) ' '

336− else m) markers

337− contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $

338− zip markers' items

339− return $ cat contents <> blankline

340−blockToMarkdown opts (DefinitionList items) = do

341− contents <- mapM (definitionListItemToMarkdown opts) items

342− return $ cat contents <> blankline

343

360

344-- | Convert bullet list item (list of blocks) to markdown.

361-- | Convert bullet list item (list of blocks) to markdown.

345bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc

362bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc