Using internal column widths in pptx writer tables

src/Text/Pandoc/Writers/Powerpoint/Output.hs

@@ -1411,19 +1411,19 @@ getDefaultTableStyle = do
   return $ findAttr (QName "def" Nothing Nothing) tblStyleLst
 
 graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
-graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
-  let colWidths = if null hdrCells
-                  then case rows of
-                         r : _ | not (null r) -> replicate (length r) $
+graphicToElement tableWidth (Tbl widths tblPr hdrCells rows) = do
+  let totalWidth = sum widths
+  let colWidths = if any (== 0.0) widths
+                  then if null hdrCells
+                      then case rows of
+                         r@(_:_) : _ -> replicate (length r) $
                                                  tableWidth `div` toInteger (length r)
-                         -- satisfy the compiler. This is the same as
-                         -- saying that rows is empty, but the compiler
-                         -- won't understand that `[]` exhausts the
-                         -- alternatives.
-                         _ -> []
-                  else replicate (length hdrCells) $
-                       tableWidth `div` toInteger (length hdrCells)
-
+                         []: _ -> []
+                         [] -> []
+                      else replicate (length hdrCells) $
+                           tableWidth `div` toInteger (length hdrCells)
+                  else map (\w -> round $ w / totalWidth * fromIntegral tableWidth) widths
+
   let cellToOpenXML paras =
         do elements <- mapM paragraphToElement paras
            let elements' = if null elements

src/Text/Pandoc/Writers/Powerpoint/Presentation.hs

@@ -244,7 +244,7 @@ data TableProps = TableProps { tblPrFirstRow :: Bool
                              , tblPrBandRow :: Bool
                              } deriving (Show, Eq)
 
-data Graphic = Tbl TableProps [TableCell] [[TableCell]]
+data Graphic = Tbl [Double] TableProps [TableCell] [[TableCell]]
   deriving (Show, Eq)
 
 
@@ -601,7 +601,7 @@ blockToShape (Para (il:_))  | Link _ (il':_) target <- il
       <$> inlinesToParElems ils
 blockToShape (Figure _figattr _caption [b]) = blockToShape b
 blockToShape (Table _ blkCapt specs thead tbody tfoot) = do
-  let (caption, algn, _, hdrCells, rows) = toLegacyTable blkCapt specs thead tbody tfoot
+  let (caption, algn, widths, hdrCells, rows) = toLegacyTable blkCapt specs thead tbody tfoot
   caption' <- inlinesToParElems caption
   hdrCells' <- rowToParagraphs algn hdrCells
   rows' <- mapM (rowToParagraphs algn) rows
@@ -613,7 +613,7 @@ blockToShape (Table _ blkCapt specs thead tbody tfoot) = do
                               , tblPrBandRow = True
                               }
 
-  return $ GraphicFrame [Tbl tblPr hdrCells' rows'] caption'
+  return $ GraphicFrame [Tbl widths tblPr hdrCells' rows'] caption'
 -- If the format isn't openxml, we fall through to blockToPargraphs
 blockToShape (RawBlock (Format "openxml") str) = return $ RawOOXMLShape str
 blockToShape blk = do paras <- blockToParagraphs blk