Started making markdown table writer sensitive to options.

So far incomplete.

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