pptx writer: Handle reference doc without slides (#11310)

An empty `sldIdLst` is now added if the reference doc is missing one so that
`modifySldIdLst` can replace it. To ensure PowerPoint doesn't say that the file
will need fixing, the `sldIdLst` has to be placed after the `sldMasterIdLst`.
I also added a test to ensure that if there are notes, they will be placed between
the `sldMasterIdLst` and `sldIdLst`. Otherwise PowerPoint wouldn't show the
slide of a note when viewing Notes Pages.

Closes #7536.

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

@@ -1417,7 +1417,7 @@ getDefaultTableStyle = do
 graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
 graphicToElement tableWidth (Tbl widths tblPr hdrCells rows) = do
   let totalWidth = sum widths
-  let colWidths = if any (== 0.0) widths
+  let colWidths = if 0.0 `elem` widths
                   then if null hdrCells
                       then case rows of
                          r@(_:_) : _ -> replicate (length r) $
@@ -2444,7 +2444,10 @@ presentationToSldIdLst ::
   P m Element
 presentationToSldIdLst minimumSlideRId (Presentation _ slides) = do
   ids <- mapM (slideToSldIdElement minimumSlideRId) slides
-  return $ mknode "p:sldIdLst" [] ids
+  return $ mkNodeSldIdLst ids
+
+mkNodeSldIdLst :: [Element] -> Element
+mkNodeSldIdLst = mknode "p:sldIdLst" []
 
 presentationToPresentationElement ::
   PandocMonad m =>
@@ -2459,10 +2462,9 @@ presentationToPresentationElement presentationUpdateRIdData pres = do
   sldIdLst <- presentationToSldIdLst minSlideRId pres
 
   let modifySldIdLst :: Content -> Content
-      modifySldIdLst (Elem e) = case elName e of
-        (QName "sldIdLst" _ _) -> Elem sldIdLst
-        _                      -> Elem e
-      modifySldIdLst ct = ct
+      modifySldIdLst ct = if isSldIdLst ct
+                          then Elem sldIdLst
+                          else ct
 
       notesMasterRId = maxSlideRId
 
@@ -2488,15 +2490,9 @@ presentationToPresentationElement presentationUpdateRIdData pres = do
       removeUnwantedMaster :: [Content] -> [Content]
       removeUnwantedMaster = concatMap removeUnwantedMaster'
 
-      insertNotesMaster' :: Content -> [Content]
-      insertNotesMaster' (Elem e) = case elName e of
-        (QName "sldMasterIdLst" _ _) -> [Elem e, Elem notesMasterElem]
-        _                            -> [Elem e]
-      insertNotesMaster' ct = [ct]
-
       insertNotesMaster :: [Content] -> [Content]
       insertNotesMaster = if presHasSpeakerNotes pres
-                          then concatMap insertNotesMaster'
+                          then insertAfterSldMasterIdLst notesMasterElem
                           else id
 
       updateRIds :: Content -> Content
@@ -2516,10 +2512,33 @@ presentationToPresentationElement presentationUpdateRIdData pres = do
         let newValue = updatePresentationRId presentationUpdateRIdData oldValue
         pure attr {attrVal = "rId" <> T.pack (show newValue)}
 
+      -- if there is no sldIdLst in the presentation.xml file, add an empty one
+      -- after the sldMasterIdLst so modifySldIdLst can replace it.
+
+      insertSldIdListIfMissing :: [Content] -> [Content]
+      insertSldIdListIfMissing contentList = if any isSldIdLst contentList
+                                             then contentList
+                                             else insertAfterSldMasterIdLst (mkNodeSldIdLst []) contentList
+
+      insertAfterSldMasterIdLst' :: Content -> Content -> [Content]
+      insertAfterSldMasterIdLst' newElement ct = if isElemName "sldMasterIdLst" ct
+                                                 then [ct, newElement]
+                                                 else [ct]
+
+      insertAfterSldMasterIdLst :: Element -> [Content] -> [Content]
+      insertAfterSldMasterIdLst newElement = concatMap $ insertAfterSldMasterIdLst' $ Elem newElement
+
+      isElemName :: T.Text -> Content -> Bool
+      isElemName name (Elem e) = qName (elName e) == name
+      isElemName _ _ = False
+
+      isSldIdLst :: Content -> Bool
+      isSldIdLst = isElemName "sldIdLst"
+
       newContent = insertNotesMaster $
                    removeUnwantedMaster $
                    (modifySldIdLst . updateRIds) <$>
-                   elContent element
+                   insertSldIdListIfMissing (elContent element)
 
   return $ element{elContent = newContent}
 

test/Tests/Writers/Powerpoint.hs

@@ -276,5 +276,17 @@ tests = let
       def {writerReferenceDoc = Just "pptx/reference-deleted-layouts.pptx"}
       "pptx/layouts/input.native"
       "pptx/layouts/deleted.pptx"
+    , ooxmlTest
+      writePowerpoint
+      "Slides can be missing from the reference doc"
+      def {writerReferenceDoc = Just "pptx/reference-no-slides.pptx"}
+      "pptx/reference-no-slides/add-slides/input.native"
+      "pptx/reference-no-slides/add-slides/output.pptx"
+    , ooxmlTest
+      writePowerpoint
+      "Notes are placed at the right position with a reference doc without slides"
+      def {writerReferenceDoc = Just "pptx/reference-no-slides.pptx"}
+      "pptx/reference-no-slides/with-notes/input.native"
+      "pptx/reference-no-slides/with-notes/output.pptx"
     ]
   in regularTests <> referenceSpecificTests

test/pptx/reference-no-slides/add-slides/input.native

@@ -0,0 +1,14 @@
+[ Header
+    2
+    ( "first-slide" , [] , [] )
+    [ Str "First" , Space , Str "Slide" ]
+, Para [ Str "Title" ]
+, Header
+    2
+    ( "second-slide" , [] , [] )
+    [ Str "Second" , Space , Str "Slide" ]
+, BulletList
+    [ [ Plain [ Str "First" , Space , Str "item" ] ]
+    , [ Plain [ Str "Second" , Space , Str "item" ] ]
+    ]
+]

test/pptx/reference-no-slides/with-notes/input.native

@@ -0,0 +1,70 @@
+[ Header
+    2
+    ( "first-slide" , [] , [] )
+    [ Str "First" , Space , Str "Slide" ]
+, Para
+    [ Str "First"
+    , Space
+    , Str "slide"
+    , Space
+    , Str "with"
+    , Space
+    , Str "notes"
+    ]
+, Div
+    ( "" , [ "notes" ] , [] )
+    [ Para
+        [ Str "Notes"
+        , Space
+        , Str "for"
+        , Space
+        , Str "the"
+        , Space
+        , Str "first"
+        , Space
+        , Str "slide"
+        ]
+    ]
+, Header
+    2
+    ( "second-slide" , [] , [] )
+    [ Str "Second" , Space , Str "Slide" ]
+, Para
+    [ Str "Slide"
+    , Space
+    , Str "without"
+    , Space
+    , Str "notes"
+    ]
+, Header
+    2
+    ( "third-slide" , [] , [] )
+    [ Str "Third" , Space , Str "Slide" ]
+, Para
+    [ Str "Slide"
+    , Space
+    , Str "with"
+    , Space
+    , Str "notes"
+    , Space
+    , Str "again"
+    ]
+, BulletList
+    [ [ Plain [ Str "First" , Space , Str "item" ] ]
+    , [ Plain [ Str "Second" , Space , Str "item" ] ]
+    ]
+, Div
+    ( "" , [ "notes" ] , [] )
+    [ Para
+        [ Str "Notes"
+        , Space
+        , Str "for"
+        , Space
+        , Str "the"
+        , Space
+        , Str "third"
+        , Space
+        , Str "slides"
+        ]
+    ]
+]