From 07fc8501726563d32b57fa5740e90dec17f8f4a8 Mon Sep 17 00:00:00 2001
From: Alexander Krotov <ilabdsf@gmail.com>
Date: Thu, 25 Oct 2018 18:35:02 +0300
Subject: [PATCH] Muse writer: add support for grid tables
---
src/Text/Pandoc/Writers/Muse.hs | 58 ++++++++++++++++++++-------------
test/tables.muse | 35 +++++++++++++-------
2 files changed, 59 insertions(+), 34 deletions(-)
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index ceae14c16..408215602 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -163,6 +163,32 @@ flatBlockListToMuse bs@(DefinitionList _ : DefinitionList _ : _) = catWithBlankL
flatBlockListToMuse bs@(_ : _) = catWithBlankLines bs 0
flatBlockListToMuse [] = return mempty
+simpleTable :: PandocMonad m
+ => [Inline]
+ -> [TableCell]
+ -> [[TableCell]]
+ -> Muse m Doc
+simpleTable caption headers rows = do
+ caption' <- inlineListToMuse caption
+ headers' <- mapM blockListToMuse headers
+ rows' <- mapM (mapM blockListToMuse) rows
+ let noHeaders = all null headers
+ let numChars = maximum . map offset
+ let widthsInChars =
+ map numChars $ transpose (headers' : rows')
+ let hpipeBlocks sep blocks = hcat $ intersperse sep' blocks
+ where h = maximum (1 : map height blocks)
+ sep' = lblock (length sep) $ vcat (replicate h (text sep))
+ let makeRow sep = (" " <>) . hpipeBlocks sep . zipWith lblock widthsInChars
+ let head' = makeRow " || " headers'
+ let rowSeparator = if noHeaders then " | " else " | "
+ rows'' <- mapM (\row -> makeRow rowSeparator <$> mapM blockListToMuse row) rows
+ let body = vcat rows''
+ return $ (if noHeaders then empty else head')
+ $$ body
+ $$ (if null caption then empty else " |+ " <> caption' <> " +|")
+ $$ blankline
+
-- | Convert list of Pandoc block elements to Muse.
blockListToMuse :: PandocMonad m
=> [Block] -- ^ List of block elements
@@ -252,29 +278,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 caption _ _ headers rows) = do
- caption' <- inlineListToMuse caption
- headers' <- mapM blockListToMuse headers
- rows' <- mapM (mapM blockListToMuse) rows
- let noHeaders = all null headers
-
- let numChars = maximum . map offset
- -- FIXME: width is not being used.
- let widthsInChars =
- map numChars $ transpose (headers' : rows')
- -- FIXME: Muse doesn't allow blocks with height more than 1.
- let hpipeBlocks sep blocks = hcat $ intersperse sep' blocks
- where h = maximum (1 : map height blocks)
- sep' = lblock (length sep) $ vcat (replicate h (text sep))
- let makeRow sep = (" " <>) . hpipeBlocks sep . zipWith lblock widthsInChars
- let head' = makeRow " || " headers'
- let rowSeparator = if noHeaders then " | " else " | "
- rows'' <- mapM (\row -> makeRow rowSeparator <$> mapM blockListToMuse row) rows
- let body = vcat rows''
- return $ (if noHeaders then empty else head')
- $$ body
- $$ (if null caption then empty else " |+ " <> caption' <> " +|")
- $$ blankline
+blockToMuse (Table caption aligns widths headers rows) =
+ if all (== 0.0) widths
+ then simpleTable caption headers rows
+ else do
+ opts <- asks envOptions
+ gridTable opts blocksToDoc True (map (const AlignDefault) aligns) widths headers rows
+ where
+ blocksToDoc opts blocks =
+ local (\env -> env { envOptions = opts }) $ blockListToMuse blocks
blockToMuse (Div _ bs) = flatBlockListToMuse bs
blockToMuse Null = return empty
diff --git a/test/tables.muse b/test/tables.muse
index fdf20be49..98e721cf0 100644
--- a/test/tables.muse
+++ b/test/tables.muse
@@ -23,17 +23,24 @@ Simple table indented two spaces:
Multiline table with caption:
- Centered Header || Left Aligned || Right Aligned || Default aligned
- First | row | 12.0 | Example of a row that spans multiple lines.
- Second | row | 5.0 | Here’s another one. Note the blank line between rows.
- |+ Here’s the caption. It may span multiple lines. +|
-
++----------+---------+-----------+--------------------------+
+| First | row | 12.0 | Example of a row that |
+| | | | spans multiple lines. |
++----------+---------+-----------+--------------------------+
+| Second | row | 5.0 | Here’s another one. Note |
+| | | | the blank line between |
+| | | | rows. |
++----------+---------+-----------+--------------------------+
Multiline table without caption:
- Centered Header || Left Aligned || Right Aligned || Default aligned
- First | row | 12.0 | Example of a row that spans multiple lines.
- Second | row | 5.0 | Here’s another one. Note the blank line between rows.
-
++----------+---------+-----------+--------------------------+
+| First | row | 12.0 | Example of a row that |
+| | | | spans multiple lines. |
++----------+---------+-----------+--------------------------+
+| Second | row | 5.0 | Here’s another one. Note |
+| | | | the blank line between |
+| | | | rows. |
++----------+---------+-----------+--------------------------+
Table without column headers:
12 | 12 | 12 | 12
@@ -42,5 +49,11 @@ Table without column headers:
Multiline table without column headers:
- First | row | 12.0 | Example of a row that spans multiple lines.
- Second | row | 5.0 | Here’s another one. Note the blank line between rows.
++----------+---------+-----------+--------------------------+
+| First | row | 12.0 | Example of a row that |
+| | | | spans multiple lines. |
++----------+---------+-----------+--------------------------+
+| Second | row | 5.0 | Here’s another one. Note |
+| | | | the blank line between |
+| | | | rows. |
++----------+---------+-----------+--------------------------+