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>
This commit is contained in:
John MacFarlane
2026-09-16 11:45:29 -07:00
co-authored by Claude
parent b69753d23e
commit d87dbee393
+23 -9
View File
@@ -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)