From bd8a66394bc25b52dca9ffd963a560a4ca492f9c Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sat, 6 Oct 2018 22:33:24 -0700
Subject: RST writer: use simple tables when possible.

Closes #4750.

Text.Pandoc.Writers.Shared now exports hasSimpleCells [API change].
---
 src/Text/Pandoc/Writers/RST.hs    | 38 ++++++++++++++++++++++++++++++++++----
 src/Text/Pandoc/Writers/Shared.hs | 18 ++++++++++++++++++
 2 files changed, 52 insertions(+), 4 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 34d5cce04..d64529c21 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -35,7 +35,7 @@ module Text.Pandoc.Writers.RST ( writeRST, flatten ) where
 import Prelude
 import Control.Monad.State.Strict
 import Data.Char (isSpace, toLower)
-import Data.List (isPrefixOf, stripPrefix)
+import Data.List (isPrefixOf, stripPrefix, transpose)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text, stripEnd)
 import qualified Text.Pandoc.Builder as B
@@ -304,9 +304,12 @@ blockToRST (Table caption aligns widths headers rows) = do
          modify $ \st -> st{ stOptions = oldOpts }
          return result
   opts <- gets stOptions
-  tbl <- gridTable opts blocksToDoc (all null headers)
-            (map (const AlignDefault) aligns) widths
-            headers rows
+  let isSimple = all (== 0) widths
+  tbl <- if isSimple
+            then simpleTable opts blocksToDoc headers rows
+            else 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 $$
@@ -693,3 +696,30 @@ imageDimsToRST attr = do
                           Just dim -> cols dim
                           Nothing  -> empty
   return $ cr <> name $$ showDim Width $$ showDim Height
+
+simpleTable :: PandocMonad m
+            => WriterOptions
+            -> (WriterOptions -> [Block] -> m Doc)
+            -> [[Block]]
+            -> [[[Block]]]
+            -> m Doc
+simpleTable opts blocksToDoc headers rows = do
+  -- can't have empty cells in first column:
+  let fixEmpties (d:ds) = if isEmpty d
+                             then text "\\ " : ds
+                             else d : ds
+      fixEmpties [] = []
+  headerDocs <- if all null headers
+                   then return []
+                   else fixEmpties <$> mapM (blocksToDoc opts) headers
+  rowDocs <- mapM (fmap fixEmpties . mapM (blocksToDoc opts)) rows
+  let numChars [] = 0
+      numChars xs = maximum . map offset $ xs
+  let colWidths = map numChars $ transpose (headerDocs : rowDocs)
+  let toRow = hsep . zipWith lblock colWidths
+  let hline = hsep (map (\n -> text (replicate n '=')) colWidths)
+  let hdr = if all null headers
+               then mempty
+               else hline $$ toRow headerDocs
+  let bdy = vcat $ map toRow rowDocs
+  return $ hdr $$ hline $$ bdy $$ hline
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index a7bf30aaa..ed2c46d7b 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -41,6 +41,7 @@ module Text.Pandoc.Writers.Shared (
                      , isDisplayMath
                      , fixDisplayMath
                      , unsmartify
+                     , hasSimpleCells
                      , gridTable
                      , lookupMetaBool
                      , lookupMetaBlocks
@@ -54,6 +55,7 @@ module Text.Pandoc.Writers.Shared (
 where
 import Prelude
 import Control.Monad (zipWithM)
+import Data.Monoid (Any (..))
 import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
                    encode, fromJSON)
 import Data.Char (chr, ord, isAscii, isSpace)
@@ -70,6 +72,7 @@ import Text.Pandoc.Pretty
 import Text.Pandoc.Shared (stringify)
 import Text.Pandoc.UTF8 (toStringLazy)
 import Text.Pandoc.XML (escapeStringForXML)
+import Text.Pandoc.Walk (query)
 import Text.Printf (printf)
 
 -- | Create JSON value for template from a 'Meta' and an association list
@@ -243,6 +246,21 @@ unsmartify opts ('\8216':xs) = '\'' : unsmartify opts xs
 unsmartify opts (x:xs) = x : unsmartify opts xs
 unsmartify _ [] = []
 
+-- | True if block is a table that can be represented with
+-- one line per row.
+hasSimpleCells :: Block -> Bool
+hasSimpleCells (Table _caption _aligns _widths headers rows) =
+  all isSimpleCell (concat (headers:rows))
+  where
+    isLineBreak LineBreak = Any True
+    isLineBreak _         = Any False
+    hasLineBreak = getAny . query isLineBreak
+    isSimpleCell [Plain ils] = not (hasLineBreak ils)
+    isSimpleCell [Para ils ] = not (hasLineBreak ils)
+    isSimpleCell []          = True
+    isSimpleCell _           = False
+hasSimpleCells _ = False
+
 gridTable :: Monad m
           => WriterOptions
           -> (WriterOptions -> [Block] -> m Doc)
-- 
cgit v1.2.3