git.iko.soy/typeable/pandoc
on master help sign in
Started making markdown table writer sensitive to options.

So far incomplete.

commit437b9ec5a46fe6d5c65e4f4837c8995efed2cf03 authorJohn MacFarlane <jgm@berkeley.edu> dateSun 5 Aug 2012, 00:02 (14 years ago) parent3f913c0
2 files changed+50−33
src/Text/Pandoc/Readers/Markdown.hs+1−1 src/Text/Pandoc/Writers/Markdown.hs+49−32
src/Text/Pandoc/Readers/Markdown.hs+1−1
@@ -47,7 +47,7 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
4747import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag,
4848 isTextTag, isCommentTag )
4949import Text.Pandoc.XML ( fromEntities )
50−import Data.Monoid hiding ((<>))
50+import Data.Monoid (mconcat, mempty)
5151import qualified Data.Sequence as Seq -- TODO leaky abstraction, need better isNull in Builder
5252import Control.Applicative ((<$>), (<*), (*>), (<$))
5353import Control.Monad
src/Text/Pandoc/Writers/Markdown.hs+49−32
@@ -41,6 +41,7 @@ import Data.List ( group, isPrefixOf, find, intersperse, transpose )
4141import Text.Pandoc.Pretty
4242import Control.Monad.State
4343import qualified Data.Set as Set
44+import Text.Pandoc.Writers.HTML (writeHtmlString)
4445
4546type Notes = [[Block]]
4647type Refs = [([Inline], Target)]
@@ -280,66 +281,82 @@ blockToMarkdown opts (BlockQuote blocks) = do
280281 else "> "
281282 contents <- blockListToMarkdown opts blocks
282283 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
284285 caption' <- inlineListToMarkdown opts caption
285286 let caption'' = if null caption || not (isEnabled Ext_table_captions opts)
286287 then empty
287288 else blankline <> ": " <> caption' <> blankline
288− headers' <- mapM (blockListToMarkdown opts) headers
289+ rawHeaders <- 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
289327 let alignHeader alignment = case alignment of
290328 AlignLeft -> lblock
291329 AlignCenter -> cblock
292330 AlignRight -> rblock
293331 AlignDefault -> lblock
294− rawRows <- mapM (mapM (blockListToMarkdown opts)) rows
295− let isSimple = all (==0) widths
296332 let numChars = maximum . map offset
297− let widthsInChars =
298− if isSimple
299− then map ((+2) . numChars) $ transpose (headers' : rawRows)
300− else map (floor . (fromIntegral (writerColumns opts) *)) widths
333+ let widthsInChars = map ((+2) . numChars) $ transpose (rawHeaders : rawRows)
334+ -- if isSimple
335+ -- then map ((+2) . numChars) $ transpose (rawHeaders : rawRows)
336+ -- else map (floor . (fromIntegral (writerColumns opts) *)) widths
301337 let makeRow = hcat . intersperse (lblock 1 (text " ")) .
302338 (zipWith3 alignHeader aligns widthsInChars)
303339 let rows' = map makeRow rawRows
304− let head' = makeRow headers'
340+ let head' = makeRow rawHeaders
305341 let maxRowHeight = maximum $ map height (head':rows')
306342 let underline = cat $ intersperse (text " ") $
307343 map (\width -> text (replicate width '-')) widthsInChars
308344 let border = if maxRowHeight > 1
309345 then text (replicate (sum widthsInChars +
310346 length widthsInChars - 1) '-')
311− else if all null headers
347+ else if headless
312348 then underline
313349 else empty
314− let head'' = if all null headers
350+ let head'' = if headless
315351 then empty
316352 else border <> cr <> head'
317353 let body = if maxRowHeight > 1
318354 then vsep rows'
319355 else vcat rows'
320− let bottom = if all null headers
356+ let bottom = if headless
321357 then underline
322358 else border
323− return $ nest 2 $ head'' $$ underline $$ body $$
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
359+ return $ head'' $$ underline $$ body $$ bottom
343360
344361-- | Convert bullet list item (list of blocks) to markdown.
345362bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc