From bd8a66394bc25b52dca9ffd963a560a4ca492f9c Mon Sep 17 00:00:00 2001 From: John MacFarlane 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 ++++++++++++ test/tables-rstsubset.native | 8 +++--- test/tables.rst | 60 +++++++++++++++++---------------------- 4 files changed, 82 insertions(+), 42 deletions(-) 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) diff --git a/test/tables-rstsubset.native b/test/tables-rstsubset.native index 5ea520d7c..a4f801b1c 100644 --- a/test/tables-rstsubset.native +++ b/test/tables-rstsubset.native @@ -1,5 +1,5 @@ [Para [Str "Simple",Space,Str "table",Space,Str "with",Space,Str "caption:"] -,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.1,8.75e-2,0.1125,0.125] +,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[Plain [Str "Right"]] ,[Plain [Str "Left"]] ,[Plain [Str "Center"]] @@ -17,7 +17,7 @@ ,[Plain [Str "1"]] ,[Plain [Str "1"]]]] ,Para [Str "Simple",Space,Str "table",Space,Str "without",Space,Str "caption:"] -,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.1,8.75e-2,0.1125,0.125] +,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[Plain [Str "Right"]] ,[Plain [Str "Left"]] ,[Plain [Str "Center"]] @@ -35,7 +35,7 @@ ,[Plain [Str "1"]] ,[Plain [Str "1"]]]] ,Para [Str "Simple",Space,Str "table",Space,Str "indented",Space,Str "two",Space,Str "spaces:"] -,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.1,8.75e-2,0.1125,0.125] +,Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[Plain [Str "Right"]] ,[Plain [Str "Left"]] ,[Plain [Str "Center"]] @@ -81,7 +81,7 @@ ,[Plain [Str "5.0"]] ,[Plain [Str "Here\8217s",Space,Str "another",Space,Str "one.",Space,Str "Note",SoftBreak,Str "the",Space,Str "blank",Space,Str "line",Space,Str "between",SoftBreak,Str "rows."]]]] ,Para [Str "Table",Space,Str "without",Space,Str "column",Space,Str "headers:"] -,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [7.5e-2,7.5e-2,7.5e-2,7.5e-2] +,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0] [[] ,[] ,[] diff --git a/test/tables.rst b/test/tables.rst index 4559883cd..660df61d4 100644 --- a/test/tables.rst +++ b/test/tables.rst @@ -2,41 +2,35 @@ Simple table with caption: .. table:: Demonstration of simple table syntax. - +-------+------+--------+---------+ - | Right | Left | Center | Default | - +=======+======+========+=========+ - | 12 | 12 | 12 | 12 | - +-------+------+--------+---------+ - | 123 | 123 | 123 | 123 | - +-------+------+--------+---------+ - | 1 | 1 | 1 | 1 | - +-------+------+--------+---------+ + ===== ==== ====== ======= + Right Left Center Default + ===== ==== ====== ======= + 12 12 12 12 + 123 123 123 123 + 1 1 1 1 + ===== ==== ====== ======= Simple table without caption: -+-------+------+--------+---------+ -| Right | Left | Center | Default | -+=======+======+========+=========+ -| 12 | 12 | 12 | 12 | -+-------+------+--------+---------+ -| 123 | 123 | 123 | 123 | -+-------+------+--------+---------+ -| 1 | 1 | 1 | 1 | -+-------+------+--------+---------+ +===== ==== ====== ======= +Right Left Center Default +===== ==== ====== ======= +12 12 12 12 +123 123 123 123 +1 1 1 1 +===== ==== ====== ======= Simple table indented two spaces: .. table:: Demonstration of simple table syntax. - +-------+------+--------+---------+ - | Right | Left | Center | Default | - +=======+======+========+=========+ - | 12 | 12 | 12 | 12 | - +-------+------+--------+---------+ - | 123 | 123 | 123 | 123 | - +-------+------+--------+---------+ - | 1 | 1 | 1 | 1 | - +-------+------+--------+---------+ + ===== ==== ====== ======= + Right Left Center Default + ===== ==== ====== ======= + 12 12 12 12 + 123 123 123 123 + 1 1 1 1 + ===== ==== ====== ======= Multiline table with caption: @@ -70,13 +64,11 @@ Multiline table without caption: Table without column headers: -+-----+-----+-----+-----+ -| 12 | 12 | 12 | 12 | -+-----+-----+-----+-----+ -| 123 | 123 | 123 | 123 | -+-----+-----+-----+-----+ -| 1 | 1 | 1 | 1 | -+-----+-----+-----+-----+ +=== === === === +12 12 12 12 +123 123 123 123 +1 1 1 1 +=== === === === Multiline table without column headers: -- cgit v1.2.3