PowerPoint writer: Build sp trees correctly

We were previously carrying over too many elements from the layout,
which produced visual artifacts and some corruption. This empties the
sptree (except for properties) after building the shapes, and then
inserts them.

Together with 5e944bf5, fixes #5402

(Note that this addresses the issue and template in that particular
bug report. Other issues will arise no doubt arise with other
templates.)

1 files changed, 19 insertions, 17 deletions

diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 6cb4666b1..db16d5ada 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -409,12 +409,22 @@ getContentShapeSize _ _ _ = throwError $
                             PandocSomeError $
                             "Attempted to find content shape size in non-layout"
 
+buildSpTree :: NameSpaces -> Element -> [Element] -> Element
+buildSpTree ns spTreeElem newShapes =
+  emptySpTreeElem { elContent = newContent }
+  where newContent = elContent emptySpTreeElem ++ map Elem newShapes
+        emptySpTreeElem = spTreeElem { elContent = filter fn (elContent spTreeElem) }
+        fn :: Content -> Bool
+        fn (Elem e) = isElem ns "p" "nvGrpSpPr" e ||
+                      isElem ns "p" "grpSpPr" e
+        fn _        = True
+
 replaceNamedChildren :: NameSpaces
-                   -> String
-                   -> String
-                   -> [Element]
-                   -> Element
-                   -> Element
+                     -> String
+                     -> String
+                     -> [Element]
+                     -> Element
+                     -> Element
 replaceNamedChildren ns prefix name newKids element =
   element { elContent = concat $ fun True $ elContent element }
   where
@@ -1047,10 +1057,7 @@ contentToElement layout hdrShape shapes
       contentElements <- local
                          (\env -> env {envContentType = NormalContent})
                          (shapesToElements layout shapes)
-      return $
-        replaceNamedChildren ns "p" "sp"
-        (hdrShapeElements ++ contentElements)
-        spTree
+      return $ buildSpTree ns spTree (hdrShapeElements ++ contentElements)
 contentToElement _ _ _ = return $ mknode "p:sp" [] ()
 
 twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element
@@ -1070,10 +1077,7 @@ twoColumnToElement layout hdrShape shapesL shapesR
                           (shapesToElements layout shapesR)
       -- let contentElementsL' = map (setIdx ns "1") contentElementsL
       --     contentElementsR' = map (setIdx ns "2") contentElementsR
-      return $
-        replaceNamedChildren ns "p" "sp"
-        (hdrShapeElements ++ contentElementsL ++ contentElementsR)
-        spTree
+      return $ buildSpTree ns spTree (hdrShapeElements ++ contentElementsL ++ contentElementsR)
 twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] ()
 
 
@@ -1086,7 +1090,7 @@ titleToElement layout titleElems
       let titleShapeElements = if null titleElems
                                then []
                                else [element]
-      return $ replaceNamedChildren ns "p" "sp" titleShapeElements spTree
+      return $ buildSpTree ns spTree titleShapeElements
 titleToElement _ _ = return $ mknode "p:sp" [] ()
 
 metadataToElement :: PandocMonad m => Element -> [ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> P m Element
@@ -1105,9 +1109,7 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems
       dateShapeElements <- if null dateElems
                            then return []
                            else sequence [nonBodyTextToElement layout [PHType "dt"] dateElems]
-      return $ replaceNamedChildren ns "p" "sp"
-        (titleShapeElements ++ subtitleShapeElements ++ dateShapeElements)
-        spTree
+      return $ buildSpTree ns spTree (titleShapeElements ++ subtitleShapeElements ++ dateShapeElements)
 metadataToElement _ _ _ _ _ = return $ mknode "p:sp" [] ()
 
 slideToElement :: PandocMonad m => Slide -> P m Element