aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/Shared.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers/Shared.hs')
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs32
1 files changed, 31 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 9ba6dcc8a..fb4e8eca6 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -34,6 +34,7 @@ module Text.Pandoc.Writers.Shared (
, toSuperscript
, toTableOfContents
, endsWithPlain
+ , toLegacyTable
)
where
import Safe (lastMay)
@@ -50,7 +51,7 @@ import qualified Text.Pandoc.Builder as Builder
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.DocLayout
-import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink)
+import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink, blocksToInlines)
import Text.Pandoc.Walk (walk)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML (escapeStringForXML)
@@ -426,3 +427,32 @@ endsWithPlain xs =
case lastMay xs of
Just Plain{} -> True
_ -> False
+
+-- | Convert the relevant components of a new-style table (with block
+-- caption, row headers, row and column spans, and so on) to those of
+-- an old-style table (inline caption, table head with one row, no
+-- foot, and so on).
+toLegacyTable :: Caption
+ -> [ColSpec]
+ -> TableHead
+ -> [TableBody]
+ -> TableFoot
+ -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
+toLegacyTable (Caption _ cbody) specs (TableHead _ th) tb (TableFoot _ tf)
+ = (cbody', aligns, widths, th', tb')
+ where
+ numcols = length specs
+ (aligns, mwidths) = unzip specs
+ fromWidth (ColWidth w) | w > 0 = w
+ fromWidth _ = 0
+ widths = map fromWidth mwidths
+ unRow (Row _ x) = map unCell x
+ unCell (Cell _ _ _ _ x) = x
+ unBody (TableBody _ _ hd bd) = hd <> bd
+ unBodies = concatMap unBody
+ cbody' = blocksToInlines cbody
+ sanitise = pad mempty numcols . unRow
+ pad element upTo list = take upTo (list ++ repeat element)
+ (th', tb') = case th of
+ (r:rs) -> (sanitise r, map sanitise $ rs <> unBodies tb <> tf)
+ [] -> ([], map sanitise $ unBodies tb <> tf)