aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs2
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs81
2 files changed, 50 insertions, 33 deletions
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