diff options
author | John MacFarlane <jgm@berkeley.edu> | 2018-10-06 22:33:24 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2018-10-06 22:33:24 -0700 |
commit | bd8a66394bc25b52dca9ffd963a560a4ca492f9c (patch) | |
tree | c10ed7ee83a665967bdbf04d62b35f1f987271e6 /src/Text | |
parent | 36a6a40ef7db36686630adf8ccb18a0fa252768f (diff) | |
download | pandoc-bd8a66394bc25b52dca9ffd963a560a4ca492f9c.tar.gz |
RST writer: use simple tables when possible.
Closes #4750.
Text.Pandoc.Writers.Shared now exports hasSimpleCells [API change].
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 38 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Shared.hs | 18 |
2 files changed, 52 insertions, 4 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) |