From 437b9ec5a46fe6d5c65e4f4837c8995efed2cf03 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 5 Aug 2012 00:02:08 -0700 Subject: Started making markdown table writer sensitive to options. So far incomplete. --- src/Text/Pandoc/Readers/Markdown.hs | 2 +- src/Text/Pandoc/Writers/Markdown.hs | 81 ++++++++++++++++++++++--------------- 2 files changed, 50 insertions(+), 33 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index b4b05920e..795935860 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -47,7 +47,7 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock ) import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag, isTextTag, isCommentTag ) import Text.Pandoc.XML ( fromEntities ) -import Data.Monoid hiding ((<>)) +import Data.Monoid (mconcat, mempty) import qualified Data.Sequence as Seq -- TODO leaky abstraction, need better isNull in Builder import Control.Applicative ((<$>), (<*), (*>), (<$)) import Control.Monad diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 2c938081a..03cf624ee 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -41,6 +41,7 @@ import Data.List ( group, isPrefixOf, find, intersperse, transpose ) import Text.Pandoc.Pretty import Control.Monad.State import qualified Data.Set as Set +import Text.Pandoc.Writers.HTML (writeHtmlString) type Notes = [[Block]] type Refs = [([Inline], Target)] @@ -280,66 +281,82 @@ blockToMarkdown opts (BlockQuote blocks) = do else "> " contents <- blockListToMarkdown opts blocks return $ (prefixed leader contents) <> blankline -blockToMarkdown opts (Table caption aligns widths headers rows) = do +blockToMarkdown opts t@(Table caption aligns widths headers rows) = do caption' <- inlineListToMarkdown opts caption let caption'' = if null caption || not (isEnabled Ext_table_captions opts) then empty else blankline <> ": " <> caption' <> blankline - headers' <- mapM (blockListToMarkdown opts) headers + rawHeaders <- mapM (blockListToMarkdown opts) headers + rawRows <- mapM (mapM (blockListToMarkdown opts)) rows + let isSimple = all (==0) widths + tbl <- case isSimple of + True | isEnabled Ext_simple_tables opts -> + simpleTable (all null headers) aligns rawHeaders rawRows + | isEnabled Ext_pipe_tables opts -> + undefined -- pipeTable aligns rawHeaders rawRows + | otherwise -> + return $ text + $ writeHtmlString def (Pandoc (Meta [] [] []) [t]) + False | isEnabled Ext_multiline_tables opts -> + undefined -- multilineTable (all null headers) aligns widths rawHeaders rawRows + | otherwise -> + return $ text + $ writeHtmlString def (Pandoc (Meta [] [] []) [t]) + return $ tbl $$ blankline $$ caption'' $$ blankline +blockToMarkdown opts (BulletList items) = do + contents <- mapM (bulletListItemToMarkdown opts) items + return $ cat contents <> blankline +blockToMarkdown opts (OrderedList (start,sty,delim) items) = do + let start' = if isEnabled Ext_startnum opts then start else 1 + let sty' = if isEnabled Ext_fancy_lists opts then sty else DefaultStyle + let delim' = if isEnabled Ext_fancy_lists opts then delim else DefaultDelim + let attribs = (start', sty', delim') + let markers = orderedListMarkers attribs + let markers' = map (\m -> if length m < 3 + then m ++ replicate (3 - length m) ' ' + else m) markers + contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $ + zip markers' items + return $ cat contents <> blankline +blockToMarkdown opts (DefinitionList items) = do + contents <- mapM (definitionListItemToMarkdown opts) items + return $ cat contents <> blankline + +simpleTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> State WriterState Doc +simpleTable headless aligns rawHeaders rawRows = do let alignHeader alignment = case alignment of AlignLeft -> lblock AlignCenter -> cblock AlignRight -> rblock AlignDefault -> lblock - rawRows <- mapM (mapM (blockListToMarkdown opts)) rows - let isSimple = all (==0) widths let numChars = maximum . map offset - let widthsInChars = - if isSimple - then map ((+2) . numChars) $ transpose (headers' : rawRows) - else map (floor . (fromIntegral (writerColumns opts) *)) widths + let widthsInChars = map ((+2) . numChars) $ transpose (rawHeaders : rawRows) + -- if isSimple + -- then map ((+2) . numChars) $ transpose (rawHeaders : rawRows) + -- else map (floor . (fromIntegral (writerColumns opts) *)) widths let makeRow = hcat . intersperse (lblock 1 (text " ")) . (zipWith3 alignHeader aligns widthsInChars) let rows' = map makeRow rawRows - let head' = makeRow headers' + let head' = makeRow rawHeaders let maxRowHeight = maximum $ map height (head':rows') let underline = cat $ intersperse (text " ") $ map (\width -> text (replicate width '-')) widthsInChars let border = if maxRowHeight > 1 then text (replicate (sum widthsInChars + length widthsInChars - 1) '-') - else if all null headers + else if headless then underline else empty - let head'' = if all null headers + let head'' = if headless then empty else border <> cr <> head' let body = if maxRowHeight > 1 then vsep rows' else vcat rows' - let bottom = if all null headers + let bottom = if headless then underline else border - return $ nest 2 $ head'' $$ underline $$ body $$ - bottom $$ blankline $$ caption'' $$ blankline -blockToMarkdown opts (BulletList items) = do - contents <- mapM (bulletListItemToMarkdown opts) items - return $ cat contents <> blankline -blockToMarkdown opts (OrderedList (start,sty,delim) items) = do - let start' = if isEnabled Ext_startnum opts then start else 1 - let sty' = if isEnabled Ext_fancy_lists opts then sty else DefaultStyle - let delim' = if isEnabled Ext_fancy_lists opts then delim else DefaultDelim - let attribs = (start', sty', delim') - let markers = orderedListMarkers attribs - let markers' = map (\m -> if length m < 3 - then m ++ replicate (3 - length m) ' ' - else m) markers - contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $ - zip markers' items - return $ cat contents <> blankline -blockToMarkdown opts (DefinitionList items) = do - contents <- mapM (definitionListItemToMarkdown opts) items - return $ cat contents <> blankline + return $ head'' $$ underline $$ body $$ bottom -- | Convert bullet list item (list of blocks) to markdown. bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc -- cgit v1.2.3