T.P.Writers.Shared: New version of `gridTable`.issue6344

This handles row and colspans. Partially addresses #6344.

It also ensures that cells won't wrap text in places where it
wouldn't normally wrap, even if this means making the cells wider
than requested by the colspec. (Closes #9001.  Closes 7641.)

Parameters are different, so this is a breaking [API change].

Markdown, RST, and Muse writers have been adjusted to
use the new `gridTable`.

10 files changed, 292 insertions, 166 deletions

diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 4f79b6c4e..6330259b0 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -125,14 +125,12 @@ blockToHaddock _ (CodeBlock (_,_,_) str) =
 blockToHaddock opts (BlockQuote blocks) =
   blockListToHaddock opts blocks
 blockToHaddock opts (Table _ blkCapt specs thead tbody tfoot) = do
-  let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
-  caption' <- inlineListToHaddock opts caption
+  let Caption _ caption = blkCapt
+  caption' <- blockListToHaddock opts caption
   let caption'' = if null caption
                      then empty
                      else blankline <> caption' <> blankline
-  tbl <- gridTable opts blockListToHaddock
-              (all null headers) (map (const AlignDefault) aligns)
-                widths headers rows
+  tbl <- gridTable opts blockListToHaddock specs thead tbody tfoot
   return $ (tbl $$ blankline $$ caption'') $$ blankline
 blockToHaddock opts (BulletList items) = do
   contents <- mapM (bulletListItemToHaddock opts) items
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index e92685f14..93ce8e937 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -604,6 +604,15 @@ blockToMarkdown' opts (BlockQuote blocks) = do
   return $ text leader <> prefixed leader contents <> blankline
 blockToMarkdown' opts t@(Table (ident,_,_) blkCapt specs thead tbody tfoot) = do
   let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
+  let isColRowSpans (Cell _ _ rs cs _) = rs > 1 || cs > 1
+  let rowHasColRowSpans (Row _ cs) = any isColRowSpans cs
+  let tbodyHasColRowSpans (TableBody _ _ rhs rs) =
+        any rowHasColRowSpans rhs || any rowHasColRowSpans rs
+  let theadHasColRowSpans (TableHead _ rs) = any rowHasColRowSpans rs
+  let tfootHasColRowSpans (TableFoot _ rs) = any rowHasColRowSpans rs
+  let hasColRowSpans = theadHasColRowSpans thead ||
+                       any tbodyHasColRowSpans tbody ||
+                       tfootHasColRowSpans tfoot
   let numcols = maximum (length aligns :| length widths :
                            map length (headers:rows))
   caption' <- inlineListToMarkdown opts caption
@@ -616,7 +625,7 @@ blockToMarkdown' opts t@(Table (ident,_,_) blkCapt specs thead tbody tfoot) = do
         = blankline $$ (": " <> caption'') $$ blankline
         | otherwise = blankline $$ caption'' $$ blankline
   let hasSimpleCells = onlySimpleTableCells $ headers : rows
-  let isSimple = hasSimpleCells && all (==0) widths
+  let isSimple = hasSimpleCells && all (==0) widths && not hasColRowSpans
   let isPlainBlock (Plain _) = True
       isPlainBlock _         = False
   let hasBlocks = not (all (all (all isPlainBlock)) $ headers:rows)
@@ -646,7 +655,7 @@ blockToMarkdown' opts t@(Table (ident,_,_) blkCapt specs thead tbody tfoot) = do
            tbl <- pipeTable opts (all null headers) aligns' widths'
                      rawHeaders rawRows
            return $ (tbl $$ caption''') $$ blankline
-       | not hasBlocks &&
+       | not (hasBlocks || hasColRowSpans) &&
          isEnabled Ext_multiline_tables opts -> do
            rawHeaders <- padRow <$> mapM (blockListToMarkdown opts) headers
            rawRows <- mapM (fmap padRow . mapM (blockListToMarkdown opts))
@@ -655,11 +664,12 @@ blockToMarkdown' opts t@(Table (ident,_,_) blkCapt specs thead tbody tfoot) = do
                      aligns' widths' rawHeaders rawRows
            return $ nest 2 (tbl $$ caption''') $$ blankline
        | isEnabled Ext_grid_tables opts &&
-          writerColumns opts >= 8 * numcols -> do
+          (hasColRowSpans || writerColumns opts >= 8 * numcols) -> do
            tbl <- gridTable opts blockListToMarkdown
-             (all null headers) aligns' widths' headers rows
+                     specs thead tbody tfoot
            return $ (tbl $$ caption''') $$ blankline
-       | hasSimpleCells &&
+       | hasSimpleCells,
+         not hasColRowSpans,
          isEnabled Ext_pipe_tables opts -> do
            rawHeaders <- padRow <$> mapM (blockListToMarkdown opts) headers
            rawRows <- mapM (fmap padRow . mapM (blockListToMarkdown opts))
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index 3b01d2a12..47a5e55ad 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -265,12 +265,15 @@ blockToMuse (Header level (ident,_,_) inlines) = do
   return $ blankline <> attr' $$ nowrap (header' <> contents) <> blankline
 -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors
 blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline
-blockToMuse (Table _ blkCapt specs thead tbody tfoot) =
+blockToMuse (Table _ blkCapt specs thead@(TableHead hattr hrows) tbody tfoot) =
   if isSimple && numcols > 1
     then simpleTable caption headers rows
     else do
       opts <- asks envOptions
-      gridTable opts blocksToDoc True (map (const AlignDefault) aligns) widths headers rows
+      let tbody' = case hrows of
+                     [] -> tbody
+                     _  -> TableBody nullAttr 0 [] hrows : tbody
+      gridTable opts blocksToDoc specs (TableHead hattr []) tbody' tfoot
   where
     (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
     blocksToDoc opts blocks =
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 1b4b59cc2..01deeb969 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -329,7 +329,8 @@ blockToRST (BlockQuote blocks) = do
   contents <- blockListToRST blocks
   return $ nest 3 contents <> blankline
 blockToRST (Table _attrs blkCapt specs thead tbody tfoot) = do
-  let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
+  let (caption, aligns, widths, headers, rows) =
+        toLegacyTable blkCapt specs thead tbody tfoot
   caption' <- inlineListToRST caption
   let blocksToDoc opts bs = do
          oldOpts <- gets stOptions
@@ -338,9 +339,7 @@ blockToRST (Table _attrs blkCapt specs thead tbody tfoot) = do
          modify $ \st -> st{ stOptions = oldOpts }
          return result
   opts <- gets stOptions
-  let renderGrid = gridTable opts blocksToDoc (all null headers)
-                    (map (const AlignDefault) aligns) widths
-                    headers rows
+  let renderGrid = gridTable opts blocksToDoc specs thead tbody tfoot
       isSimple = all (== 0) widths && length widths > 1
       renderSimple = do
         tbl' <- simpleTable opts blocksToDoc headers rows
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index ee3d78bc9..707c25a66 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -51,14 +51,14 @@ module Text.Pandoc.Writers.Shared (
                      , delimited
                      )
 where
-import Safe (lastMay)
+import Safe (lastMay, maximumMay, atDef)
 import qualified Data.ByteString.Lazy as BL
-import Control.Monad (zipWithM, MonadPlus, mzero)
+import Control.Monad (MonadPlus, mzero)
 import Data.Either (isRight)
 import Data.Aeson (ToJSON (..), encode)
 import Data.Char (chr, ord, isSpace, isLetter, isUpper)
-import Data.List (groupBy, intersperse, transpose, foldl')
-import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
+import Data.List (groupBy, intersperse, foldl', transpose)
+import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text.Conversions (FromText(..))
 import qualified Data.Map as M
 import qualified Data.Text as T
@@ -81,6 +81,9 @@ import Text.Collate.Lang (Lang (..))
 import Text.Pandoc.Class (PandocMonad, toLang)
 import Text.Pandoc.Translations (setTranslations)
 import Data.Maybe (fromMaybe)
+import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
+
+-- import Debug.Trace
 
 -- | Create template Context from a 'Meta' and an association list
 -- of variables, specified at the command line or in the writer.
@@ -282,121 +285,226 @@ unsmartify opts = T.concatMap $ \c -> case c of
   _       -> T.singleton c
 
 -- | Writes a grid table.
-gridTable :: (Monad m, HasChars a)
-          => WriterOptions
-          -> (WriterOptions -> [Block] -> m (Doc a)) -- ^ format Doc writer
-          -> Bool             -- ^ headless
-          -> [Alignment]      -- ^ column alignments
-          -> [Double]         -- ^ column widths
-          -> [[Block]]        -- ^ table header row
-          -> [[[Block]]]      -- ^ table body rows
-          -> m (Doc a)
-gridTable opts blocksToDoc headless aligns widths headers rows = do
-  -- the number of columns will be used in case of even widths
-  let numcols = maximum (length aligns :| length widths :
-                           map length (headers:rows))
-  let officialWidthsInChars :: [Double] -> [Int]
-      officialWidthsInChars widths' = map (
-                        (max 1) .
-                        (\x -> x - 3) . floor .
-                        (fromIntegral (writerColumns opts) *)
-                        ) widths'
-  -- handleGivenWidths wraps the given blocks in order for them to fit
-  -- in cells with given widths. the returned content can be
-  -- concatenated with borders and frames
-  let handleGivenWidthsInChars widthsInChars' = do
-        -- replace page width (in columns) in the options with a
-        -- given width if smaller (adjusting by two)
-        let useWidth w = opts{writerColumns = min (w - 2) (writerColumns opts)}
-        -- prepare options to use with header and row cells
-        let columnOptions = map useWidth widthsInChars'
-        rawHeaders' <- zipWithM blocksToDoc columnOptions headers
-        rawRows' <- mapM
-             (\cs -> zipWithM blocksToDoc columnOptions cs)
-             rows
-        return (widthsInChars', rawHeaders', rawRows')
-  let handleGivenWidths widths' = handleGivenWidthsInChars
-                                     (officialWidthsInChars widths')
-  -- handleFullWidths tries to wrap cells to the page width or even
-  -- more in cases where `--wrap=none`. thus the content here is left
-  -- as wide as possible
-  let handleFullWidths widths' = do
-        rawHeaders' <- mapM (blocksToDoc opts) headers
-        rawRows' <- mapM (mapM (blocksToDoc opts)) rows
-        let numChars = maybe 0 maximum . nonEmpty . map offset
-        let minWidthsInChars =
-                map numChars $ transpose (rawHeaders' : rawRows')
-        let widthsInChars' = zipWith max
-                              minWidthsInChars
-                              (officialWidthsInChars widths')
-        return (widthsInChars', rawHeaders', rawRows')
-  -- handleZeroWidths calls handleFullWidths to check whether a wide
-  -- table would fit in the page. if the produced table is too wide,
-  -- it calculates even widths and passes the content to
-  -- handleGivenWidths
-  let handleZeroWidths widths' = do
-        (widthsInChars', rawHeaders', rawRows') <- handleFullWidths widths'
-        if foldl' (+) 0 widthsInChars' > writerColumns opts
-           then do -- use even widths except for thin columns
-             let evenCols  = max 5
-                              (((writerColumns opts - 1) `div` numcols) - 3)
-             let (numToExpand, colsToExpand) =
-                   foldr (\w (n, tot) -> if w < evenCols
-                                            then (n, tot + (evenCols - w))
-                                            else (n + 1, tot))
-                                   (0,0) widthsInChars'
-             let expandAllowance = colsToExpand `div` numToExpand
-             let newWidthsInChars = map (\w -> if w < evenCols
+gridTable :: Monad m
+           => WriterOptions
+           -> (WriterOptions -> [Block] -> m (Doc Text)) -- ^ format Doc writer
+           -> [ColSpec]
+           -> TableHead
+           -> [TableBody]
+           -> TableFoot
+           -> m (Doc Text)
+gridTable opts blocksToDoc colspecs' thead' tbodies' tfoot' = do
+  let Ann.Table _ _ colspecs thead tbodies tfoot =
+        Ann.toTable mempty (Caption Nothing mempty)
+                    colspecs' thead' tbodies' tfoot'
+  let widths = map (toCharWidth opts . getColWidth) colspecs
+  let renderRows = fmap (map (addDummies widths)) . mapM (gridRow opts blocksToDoc)
+  let getHeadCells (Ann.HeaderRow _ _ cells) = cells
+  let getHeadRows (Ann.TableHead _ rs) = map getHeadCells rs
+  headCells <- renderRows (getHeadRows thead)
+  let getFootRows (Ann.TableFoot _ xs) = map getHeadCells xs
+  footCells <- renderRows (getFootRows tfoot)
+  let getBodyCells (Ann.BodyRow _ _ _ cells) = cells
+  let getBody (Ann.TableBody _ _ hs xs) = map getHeadCells hs <> map getBodyCells xs
+  bodyCells <- mapM (renderRows . getBody) tbodies
+  let rows = setTopBorder SingleLine headCells ++
+             (setTopBorder (if null headCells then SingleLine else DoubleLine)
+              . setBottomBorder SingleLine) (mconcat bodyCells) ++
+             (if null footCells
+                 then mempty
+                 else setTopBorder DoubleLine . setBottomBorder DoubleLine $
+                       footCells)
+  let cellHasColSpan c = cellColSpan c > 1
+  let hasColSpans = any (any cellHasColSpan) rows
+  let isSimple = all ((== ColWidthDefault) . snd) colspecs && not hasColSpans
+  pure $ gridRows $
+    if not hasColSpans  -- TODO: figure out how to calculate widths with colspans
+       then redoWidths isSimple opts rows
+       else rows
+
+redoWidths :: Bool -> WriterOptions -> [[RenderedCell Text]] -> [[RenderedCell Text]]
+redoWidths _ _ [] = []
+redoWidths isSimple opts rows@(r:_) =
+  map (\cs -> zipWith resetWidth newwidths cs) rows
+ where
+  actualWidths = map cellWidth r
+  fullwidths = calculateFullWidths rows
+  minwidths = case writerWrapText opts of
+                WrapNone -> fullwidths
+                _ -> calculateMinWidths rows
+  totwidth = writerColumns opts - (3 * length r) - 1
+  evenwidth = totwidth `div` length r
+  resetWidth w c = c{ cellWidth = w }
+  keepwidths = filter (< evenwidth) fullwidths
+  evenwidth' = (totwidth - sum keepwidths) `div`
+                (length r - length keepwidths)
+  ensureMinWidths = zipWith max minwidths
+  newwidths = ensureMinWidths $
+              case isSimple of
+                True | sum fullwidths <= totwidth -> fullwidths
+                     | otherwise -> map (\w -> if w < evenwidth
                                                   then w
-                                                  else min
-                                                       (evenCols + expandAllowance)
-                                                       w)
-                                        widthsInChars'
-             handleGivenWidthsInChars newWidthsInChars
-           else return (widthsInChars', rawHeaders', rawRows')
-  -- render the contents of header and row cells differently depending
-  -- on command line options, widths given in this specific table, and
-  -- cells' contents
-  let handleWidths
-        | writerWrapText opts == WrapNone    = handleFullWidths widths
-        | all (== 0) widths                  = handleZeroWidths widths
-        | otherwise                          = handleGivenWidths widths
-  (widthsInChars, rawHeaders, rawRows) <- handleWidths
-  let hpipeBlocks blocks = hcat [beg, middle, end]
-        where sep'    = vfill " | "
-              beg     = vfill "| "
-              end     = vfill " |"
-              middle  = chomp $ hcat $ intersperse sep' blocks
-  let makeRow = hpipeBlocks . zipWith lblock widthsInChars
-  let head' = makeRow rawHeaders
-  let rows' = map (makeRow . map chomp) rawRows
-  let borderpart ch align widthInChars =
-           (if align == AlignLeft || align == AlignCenter
-               then char ':'
-               else char ch) <>
-           text (replicate widthInChars ch) <>
-           (if align == AlignRight || align == AlignCenter
-               then char ':'
-               else char ch)
-  let border ch aligns' widthsInChars' =
-        char '+' <>
-        hcat (intersperse (char '+') (zipWith (borderpart ch)
-                aligns' widthsInChars')) <> char '+'
-  let body = vcat $ intersperse (border '-' (repeat AlignDefault) widthsInChars)
-                    rows'
-  let head'' = if headless
-                  then empty
-                  else head' $$ border '=' aligns widthsInChars
-  if headless
-     then return $
-           border '-' aligns widthsInChars $$
-           body $$
-           border '-' (repeat AlignDefault) widthsInChars
-     else return $
-           border '-' (repeat AlignDefault) widthsInChars $$
-           head'' $$
-           body $$
-           border '-' (repeat AlignDefault) widthsInChars
+                                                  else evenwidth') fullwidths
+                False -> actualWidths
+
+-- Returns for each column a pair (full width, min width)
+calculateFullWidths :: [[RenderedCell Text]] -> [Int]
+calculateFullWidths rows =
+  map (fromMaybe 0 . maximumMay) (transpose (map (map (\c ->
+         offset (cellContents c))) rows))
+
+calculateMinWidths :: [[RenderedCell Text]] -> [Int]
+calculateMinWidths rows =
+  map (fromMaybe 0 . maximumMay) (transpose (map (map (\c ->
+         minOffset (cellContents c))) rows))
+
+makeDummy :: [Int] -> Int -> Int -> RenderedCell Text
+makeDummy widths n len =
+ let width = atDef 0 widths n
+ in RenderedCell{ cellColNum = n,
+                cellColSpan = len,
+                cellAlign = AlignDefault,
+                cellRowSpan = 0, -- indicates dummy
+                cellWidth = width,
+                cellHeight = 0,
+                cellContents = mempty,
+                cellBottomBorder = NoLine,
+                cellTopBorder = NoLine }
+
+addDummies :: [Int] -> [RenderedCell Text] -> [RenderedCell Text]
+addDummies widths = reverse . snd . foldl' addDummy (0,[])
+ where
+   addDummy (i,cs) c =
+     case cellColNum c - i of
+       0 -> (i+1, c:cs)
+       len -> (cellColNum c + 1, c : makeDummy widths i len : cs)
+
+
+setTopBorder :: LineStyle -> [[RenderedCell Text]] -> [[RenderedCell Text]]
+setTopBorder _ [] = []
+setTopBorder sty (cs:rest) = (map (\c -> c{ cellTopBorder = sty }) cs) : rest
+
+setBottomBorder :: LineStyle -> [[RenderedCell Text]] -> [[RenderedCell Text]]
+setBottomBorder _ [] = []
+setBottomBorder sty [cs] = [map (\c -> c{ cellBottomBorder = sty }) cs]
+setBottomBorder sty (c:cs) = c : setBottomBorder sty cs
+
+gridRows :: [[RenderedCell Text]] -> Doc Text
+gridRows [] = mempty
+gridRows (x:xs) =
+  (formatBorder cellTopBorder False (map (\z -> z{ cellBottomBorder = NoLine }) x))
+  $$
+  vcat (zipWith rowAndBottom (x:xs) (xs ++ [[]]))
+ where
+  -- generate wrapped contents. include pipe borders, bottom and left
+
+  renderCellContents c =
+    -- we don't use cblock or lblock because the content might
+    -- be interpreted as an indented code block...even though it
+    -- would look better to right-align right-aligned cells...
+    -- (TODO: change this on parsing side?)
+    lblock (case cellWidth c of
+                  0 -> 16 -- TODO arbitrary
+                  w -> w) (cellContents c)
+
+  formatRow cs = vfill "| " <>
+   hcat (intersperse (vfill " | ") (map renderCellContents cs)) <> vfill " |"
+
+  rowAndBottom thisRow nextRow =
+    let isLastRow = null nextRow
+        border1 = render Nothing (formatBorder cellBottomBorder False thisRow)
+        border2 = render Nothing (formatBorder cellTopBorder False nextRow)
+        go '+' _ = '+'
+        go _ '+' = '+'
+        go '=' _ = '='
+        go _ '=' = '='
+        go c _   = c
+        combinedBorder = if isLastRow
+                            then literal border1
+                            else literal $ T.zipWith go border1 border2
+    in formatRow thisRow $$ combinedBorder
+
+
+formatBorder :: (RenderedCell Text -> LineStyle) -> Bool -> [RenderedCell Text]
+             -> Doc Text
+formatBorder _ _alignMarkers [] = mempty
+formatBorder borderStyle alignMarkers (c:cs)
+  | borderStyle c == NoLine
+    = openpipe <> text (replicate (cellWidth c + 2) ' ') <> closepipe <>
+      formatBorder borderStyle alignMarkers cs
+  | otherwise
+    = openplus <> leftalign <> underline <> rightalign <> closeplus <>
+      formatBorder borderStyle alignMarkers cs
+  where
+
+    openpipe = "|"
+    closepipe = if null cs then "|" else mempty
+    openplus = "+"
+    closeplus = if null cs
+                   then "+"
+                   else mempty
+    lineChar = case borderStyle c of
+                 NoLine -> ' '
+                 SingleLine -> '-'
+                 DoubleLine -> '='
+    (leftalign, rightalign) =
+       case cellAlign c of
+         _ | not alignMarkers -> (char lineChar,char lineChar)
+         AlignLeft -> (char ':',char lineChar)
+         AlignCenter -> (char ':',char ':')
+         AlignRight -> (char lineChar,char ':')
+         AlignDefault -> (char lineChar,char lineChar)
+    underline = text (replicate (cellWidth c) lineChar)
+
+data LineStyle = NoLine | SingleLine | DoubleLine
+    deriving (Show, Ord, Eq)
+
+data RenderedCell a =
+  RenderedCell{ cellColNum :: Int
+              , cellColSpan :: Int
+              , cellAlign :: Alignment
+              , cellRowSpan :: Int
+              , cellWidth :: Int
+              , cellHeight :: Int
+              , cellContents :: Doc a
+              , cellBottomBorder :: LineStyle
+              , cellTopBorder :: LineStyle
+              }
+  deriving (Show)
+
+getColWidth :: ColSpec -> Double
+getColWidth (_, ColWidth n) = n
+getColWidth (_, ColWidthDefault) = 0 -- TODO?
+
+toCharWidth :: WriterOptions -> Double -> Int
+toCharWidth opts width =
+  max 1 (floor (width * fromIntegral (writerColumns opts)) - 3)
+
+gridRow :: (Monad m, HasChars a)
+        => WriterOptions
+        -> (WriterOptions -> [Block] -> m (Doc a)) -- ^ format Doc writer
+        -> [Ann.Cell]
+        -> m [RenderedCell a]
+gridRow opts blocksToDoc = mapM renderCell
+ where
+  renderer = blocksToDoc opts
+  renderCell (Ann.Cell cellcolspecs (Ann.ColNumber colnum)
+               (Cell _ _ (RowSpan rowspan) _ blocks)) = do
+    let ((align,_):|_) = cellcolspecs
+    let width = toCharWidth opts $ sum (fmap getColWidth cellcolspecs)
+    rendered <- renderer blocks
+    pure $ RenderedCell{ cellColNum = colnum,
+                         cellColSpan = length cellcolspecs,
+                         cellAlign = align,
+                         cellRowSpan = rowspan,
+                         cellWidth = width,
+                         cellHeight = height rendered,
+                         cellContents = rendered,
+                         cellBottomBorder = if rowspan < 2
+                                               then SingleLine
+                                               else NoLine,
+                         cellTopBorder = SingleLine }
+
 
 -- | Retrieve the metadata value for a given @key@
 -- and convert to Bool.
diff --git a/test/command/2834.md b/test/command/2834.md
index 850c39254..32c6d3591 100644
--- a/test/command/2834.md
+++ b/test/command/2834.md
@@ -19,11 +19,11 @@ Nested grid tables.
   </tr>
 </table>
 ^D
-+-----------------------------------------------------------------------+
-| +------------------------------------------------------------------+  |
-| |   -----------                                                    |  |
-| |   some text                                                      |  |
-| |   -----------                                                    |  |
-| +------------------------------------------------------------------+  |
-+-----------------------------------------------------------------------+
++---------------------------------------------------------------------------+
+| +-----------------------------------------------------------------------+ |
+| |   -----------                                                         | |
+| |   some text                                                           | |
+| |   -----------                                                         | |
+| +-----------------------------------------------------------------------+ |
++---------------------------------------------------------------------------+
 ```
diff --git a/test/command/3516.md b/test/command/3516.md
index 615befb3e..116268e34 100644
--- a/test/command/3516.md
+++ b/test/command/3516.md
@@ -91,6 +91,8 @@ on Windows builds.
  [])]
 ^D
 +---+---+
+|   |   |
++===+===+
 | 1 | 2 |
 +---+---+
 |   |   |
diff --git a/test/command/5128.md b/test/command/5128.md
index 261cea507..ea628494b 100644
--- a/test/command/5128.md
+++ b/test/command/5128.md
@@ -7,20 +7,20 @@
 | =^=     | Centered , the same amount of characters is added to the left and the right.                                                                                                                               |
 | ===      | Padding. If a numeric value is printed with a sign, then additional characters are added after the sign. Otherwise it behaves like "=>=". This option is only available for numbers (default for numbers). |
 ^D
-+--------+------------------------------------------------------------------+
-| Option | Meaning                                                          |
-+========+==================================================================+
-| ``<``  | Left alignment, additional characters are added to the right     |
-|        | (default for string).                                            |
-+--------+------------------------------------------------------------------+
-| ``>``  | Right alignment, additional characters are added to the left.    |
-+--------+------------------------------------------------------------------+
-| ``^``  | Centered , the same amount of characters is added to the left    |
-|        | and the right.                                                   |
-+--------+------------------------------------------------------------------+
-| ``=``  | Padding. If a numeric value is printed with a sign, then         |
-|        | additional characters are added after the sign. Otherwise it     |
-|        | behaves like "``>``". This option is only available for numbers  |
-|        | (default for numbers).                                           |
-+--------+------------------------------------------------------------------+
++--------+-------------------------------------------------------------------+
+| Option | Meaning                                                           |
++========+===================================================================+
+| ``<``  | Left alignment, additional characters are added to the right      |
+|        | (default for string).                                             |
++--------+-------------------------------------------------------------------+
+| ``>``  | Right alignment, additional characters are added to the left.     |
++--------+-------------------------------------------------------------------+
+| ``^``  | Centered , the same amount of characters is added to the left and |
+|        | the right.                                                        |
++--------+-------------------------------------------------------------------+
+| ``=``  | Padding. If a numeric value is printed with a sign, then          |
+|        | additional characters are added after the sign. Otherwise it      |
+|        | behaves like "``>``". This option is only available for numbers   |
+|        | (default for numbers).                                            |
++--------+-------------------------------------------------------------------+
 ```
diff --git a/test/command/5899.md b/test/command/5899.md
index 7e641e7de..2382a9c02 100644
--- a/test/command/5899.md
+++ b/test/command/5899.md
@@ -37,15 +37,15 @@
 ^D
 - A list of stuff with a table inside
 
-  +-------+----------------------------------------------------+-------+
-  | First | Second                                             | Third |
-  +=======+====================================================+=======+
-  | First | The big long table cell. The big long table cell.  | Third |
-  |       | The big long table cell. The big long table cell.  |       |
-  |       | The big long table cell. The big long table cell.  |       |
-  |       | The big long table cell. The big long table cell.  |       |
-  |       | The big long table cell. The big long table cell.  |       |
-  +-------+----------------------------------------------------+-------+
+  +-------+------------------------------------------------------+-------+
+  | First | Second                                               | Third |
+  +=======+======================================================+=======+
+  | First | The big long table cell. The big long table cell.    | Third |
+  |       | The big long table cell. The big long table cell.    |       |
+  |       | The big long table cell. The big long table cell.    |       |
+  |       | The big long table cell. The big long table cell.    |       |
+  |       | The big long table cell. The big long table cell.    |       |
+  +-------+------------------------------------------------------+-------+
 
 - Another list item
  ```
diff --git a/test/tables.muse b/test/tables.muse
index 6b3af561d..3ff8884a5 100644
--- a/test/tables.muse
+++ b/test/tables.muse
@@ -24,6 +24,9 @@ Simple table indented two spaces:
 Multiline table with caption:
 
 +-----------+----------+------------+---------------------------+
+| Centered  | Left     | Right      | Default aligned           |
+| Header    | Aligned  | Aligned    |                           |
++-----------+----------+------------+---------------------------+
 | First     | row      | 12.0       | Example of a row that     |
 |           |          |            | spans multiple lines.     |
 +-----------+----------+------------+---------------------------+
@@ -34,6 +37,9 @@ Multiline table with caption:
 Multiline table without caption:
 
 +-----------+----------+------------+---------------------------+
+| Centered  | Left     | Right      | Default aligned           |
+| Header    | Aligned  | Aligned    |                           |
++-----------+----------+------------+---------------------------+
 | First     | row      | 12.0       | Example of a row that     |
 |           |          |            | spans multiple lines.     |
 +-----------+----------+------------+---------------------------+