From d87dbee3931faf962d3cdea003dfc9c93c7c6ca7 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Wed, 16 Sep 2026 18:01:38 +0000
Subject: [PATCH] Powerpoint writer: add archive entries in a single pass.

Folding addEntryToArchive over the generated entries was quadratic,
since each addition filters the entire entry list to delete entries
with the same path.  With one entry per slide (plus rels and speaker
notes), this became significant for large presentations: about 4% of
total conversion time and 6% of allocation on a large document.

The new addEntriesToArchive helper preserves the semantics of the
fold (first entry wins for duplicate paths; new entries precede and
replace existing ones) while doing a single pass over the archive.
Output is byte-for-byte identical.

Co-Authored-By: Claude <noreply@anthropic.com>
---
 src/Text/Pandoc/Writers/Powerpoint/Output.hs | 32 ++++++++++++++------
 1 file changed, 23 insertions(+), 9 deletions(-)

diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index ee2324c98..3496a6c62 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -28,6 +28,7 @@ import Control.Monad.Reader
 import Control.Monad.State
     ( StateT, gets, modify, evalStateT )
 import Codec.Archive.Zip
+import Data.Containers.ListUtils (nubOrdOn)
 import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse)
 import Data.Bifunctor (bimap)
 import Data.CaseInsensitive (CI)
@@ -57,6 +58,7 @@ import qualified Data.ByteString.Lazy as BL
 import Text.Pandoc.Writers.Shared (metaToContext)
 import Text.Pandoc.Writers.OOXML
 import qualified Data.Map as M
+import qualified Data.Set as Set
 import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isJust)
 import Text.Pandoc.ImageSize
 import Control.Applicative ((<|>))
@@ -391,15 +393,27 @@ presentationToArchiveP p@(Presentation docProps slides) = do
   mediaEntries <- makeMediaEntries
   contentTypesEntry <- presentationToContentTypes p >>= contentTypesToEntry
   -- fold everything into our inherited archive and return it.
-  return $ foldr addEntryToArchive newArch' $
-    slideEntries <>
-    slideRelEntries <>
-    spkNotesEntries <>
-    spkNotesRelEntries <>
-    mediaEntries <>
-    [updatedMasterEntry, updatedMasterRelEntry]  <>
-    [contentTypesEntry, docPropsEntry, docCustomPropsEntry, relsEntry,
-     presEntry, presRelsEntry, viewPropsEntry]
+  return $ addEntriesToArchive
+    (slideEntries <>
+     slideRelEntries <>
+     spkNotesEntries <>
+     spkNotesRelEntries <>
+     mediaEntries <>
+     [updatedMasterEntry, updatedMasterRelEntry]  <>
+     [contentTypesEntry, docPropsEntry, docCustomPropsEntry, relsEntry,
+      presEntry, presRelsEntry, viewPropsEntry])
+    newArch'
+
+-- | Add entries to an archive in a single pass.  Equivalent to (but
+-- faster than) folding 'addEntryToArchive' over the list: for
+-- duplicate paths the first entry in the list wins, and the new
+-- entries precede (and replace) existing entries with the same paths.
+addEntriesToArchive :: [Entry] -> Archive -> Archive
+addEntriesToArchive entries archive =
+  archive{ zEntries = nubOrdOn eRelativePath entries <>
+                      filter (\e -> eRelativePath e `Set.notMember` newPaths)
+                             (zEntries archive) }
+  where newPaths = Set.fromList $ map eRelativePath entries
 
 updateMasterElems :: SlideLayouts -> Element -> Element -> (Element, Element)
 updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels)