RST writer: improve grid table output, fix bug with empty rows.

Uses the new gridTable in Writers.Shared, which is here
improved to better handle 0-width cells.

Closes #3516.

2 files changed, 40 insertions, 49 deletions

diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index d4a537d72..24898d62e 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -33,7 +33,7 @@ reStructuredText:  <http://docutils.sourceforge.net/rst.html>
 module Text.Pandoc.Writers.RST ( writeRST ) where
 import Control.Monad.State
 import Data.Char (isSpace, toLower)
-import Data.List (intersperse, isPrefixOf, stripPrefix, transpose)
+import Data.List (isPrefixOf, stripPrefix)
 import Data.Maybe (fromMaybe)
 import Network.URI (isURI)
 import qualified Text.Pandoc.Builder as B
@@ -269,39 +269,18 @@ blockToRST (BlockQuote blocks) = do
   tabstop <- gets $ writerTabStop . stOptions
   contents <- blockListToRST blocks
   return $ (nest tabstop contents) <> blankline
-blockToRST (Table caption _ widths headers rows) =  do
+blockToRST (Table caption aligns widths headers rows) = do
   caption' <- inlineListToRST caption
-  headers' <- mapM blockListToRST headers
-  rawRows <- mapM (mapM blockListToRST) rows
-  -- let isSimpleCell [Plain _] = True
-  --     isSimpleCell [Para _]  = True
-  --     isSimpleCell []        = True
-  --     isSimpleCell _         = False
-  -- let isSimple = all (==0) widths && all (all isSimpleCell) rows
-  let numChars = maximum . map offset
+  let blocksToDoc opts bs = do
+         oldOpts <- gets stOptions
+         modify $ \st -> st{ stOptions = opts }
+         result <- blockListToRST bs
+         modify $ \st -> st{ stOptions = oldOpts }
+         return result
   opts <- gets stOptions
-  let widthsInChars =
-       if all (== 0) widths
-          then map ((+2) . numChars) $ transpose (headers' : rawRows)
-          else map (floor . (fromIntegral (writerColumns opts) *)) widths
-  let hpipeBlocks blocks = hcat [beg, middle, end]
-        where h      = height (hcat blocks)
-              sep'   = lblock 3 $ vcat (map text $ replicate h " | ")
-              beg    = lblock 2 $ vcat (map text $ replicate h "| ")
-              end    = lblock 2 $ vcat (map text $ replicate h " |")
-              middle = hcat $ intersperse sep' blocks
-  let makeRow = hpipeBlocks . zipWith lblock widthsInChars
-  let head' = makeRow headers'
-  let rows' = map makeRow rawRows
-  let border ch = char '+' <> char ch <>
-                  (hcat $ intersperse (char ch <> char '+' <> char ch) $
-                          map (\l -> text $ replicate l ch) widthsInChars) <>
-                  char ch <> char '+'
-  let body = vcat $ intersperse (border '-') rows'
-  let head'' = if all null headers
-                  then empty
-                  else head' $$ border '='
-  let tbl = border '-' $$ head'' $$ body $$ border '-'
+  tbl <- gridTable opts blocksToDoc (all null headers)
+            (map (const AlignDefault) aligns) widths
+            headers rows
   return $ if null caption
               then tbl $$ blankline
               else (".. table:: " <> caption') $$ blankline $$ nest 3 tbl $$
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 520df1037..3b28c58c8 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -46,7 +46,7 @@ import Control.Monad (liftM, zipWithM)
 import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
                    encode, fromJSON)
 import qualified Data.HashMap.Strict as H
-import Data.List (groupBy, intersperse)
+import Data.List (groupBy, intersperse, transpose)
 import qualified Data.Map as M
 import Data.Maybe (isJust)
 import qualified Data.Text as T
@@ -229,22 +229,34 @@ gridTable :: Monad m
 gridTable opts blocksToDoc headless aligns widths headers rows = do
   let numcols = maximum (length aligns : length widths :
                            map length (headers:rows))
-  let widths' = if all (==0) widths
-                   then replicate numcols
-                         (1.0 / fromIntegral numcols)
-                   else widths
-  let widthsInChars = map ((\x -> x - 3) . floor .
-         (fromIntegral (writerColumns opts) *)) widths'
-  rawHeaders <- zipWithM blocksToDoc
-      (map (\w -> opts{writerColumns =
-                min (w - 2) (writerColumns opts)}) widthsInChars)
-      headers
-  rawRows <- mapM
-       (\cs -> zipWithM blocksToDoc
-         (map (\w -> opts{writerColumns =
-                   min (w - 2) (writerColumns opts)}) widthsInChars)
-         cs)
-       rows
+  let handleGivenWidths widths' = do
+        let widthsInChars' = map ((\x -> x - 3) . floor .
+                      (fromIntegral (writerColumns opts) *)) widths'
+        rawHeaders' <- zipWithM blocksToDoc
+            (map (\w -> opts{writerColumns =
+                      min (w - 2) (writerColumns opts)}) widthsInChars')
+            headers
+        rawRows' <- mapM
+             (\cs -> zipWithM blocksToDoc
+               (map (\w -> opts{writerColumns =
+                         min (w - 2) (writerColumns opts)}) widthsInChars')
+               cs)
+             rows
+        return (widthsInChars', rawHeaders', rawRows')
+  let handleZeroWidths = do
+        rawHeaders' <- mapM (blocksToDoc opts) headers
+        rawRows' <- mapM (mapM (blocksToDoc opts)) rows
+        let numChars = maximum . map offset
+        let widthsInChars' =
+                map ((+2) . numChars) $ transpose (rawHeaders' : rawRows')
+        if sum widthsInChars' > writerColumns opts
+           then -- use even widths
+                handleGivenWidths
+                  (replicate numcols (1.0 / fromIntegral numcols) :: [Double])
+           else return (widthsInChars', rawHeaders', rawRows')
+  (widthsInChars, rawHeaders, rawRows) <- if all (== 0) widths
+                                             then handleZeroWidths
+                                             else handleGivenWidths widths
   let hpipeBlocks blocks = hcat [beg, middle, end]
         where h       = maximum (1 : map height blocks)
               sep'    = lblock 3 $ vcat (map text $ replicate h " | ")