From b60c6157fecd868671baf055045a324ffe20c233 Mon Sep 17 00:00:00 2001 From: Emily Bourke Date: Thu, 2 Sep 2021 10:54:55 +0100 Subject: pptx: Don’t add relationships unnecessarily MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Before now, for any layouts added to the output from the default reference doc, the relationships were unconditionally added to the output. However, if there was already a layout in slideMaster1 at the same index then that results in duplicate relationships. This commit checks first, and only adds the relationship if it doesn’t already exist. --- src/Text/Pandoc/Writers/Powerpoint/Output.hs | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index a28eaf54c..0b6ca50c2 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -384,9 +384,11 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels) Element -> ([Text], Element) addLayoutRels e = let - layoutsToAdd = filter (not . slInReferenceDoc) (toList layouts) + layoutsToAdd = filter (\l -> not (slInReferenceDoc l) && isNew e l) + (toList layouts) newRelationships = snd (foldr mkRelationship (maxIdNumber e, []) layoutsToAdd) - newRelationshipIds = mapMaybe getRelationshipId newRelationships + newRelationshipIds = + mapMaybe (findElemAttr (QName "Id" Nothing Nothing)) newRelationships mkRelationship layout (lastId, relationships) = let thisId = lastId + 1 slideLayoutPath = "../slideLayouts/" <> T.pack (takeFileName (slPath layout)) @@ -403,9 +405,16 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels) in (thisId, Elem newRelationship : relationships) in (newRelationshipIds, e {elContent = elContent e <> newRelationships}) - getRelationshipId :: Content -> Maybe Text - getRelationshipId (Elem e) = findAttr (QName "Id" Nothing Nothing) e - getRelationshipId _ = Nothing + -- | Whether the layout needs to be added to the Relationships element. + isNew :: Element -> SlideLayout -> Bool + isNew relationships SlideLayout{..} = let + toDetails = fmap (takeFileName . T.unpack) + . findElemAttr (QName "Target" Nothing Nothing) + in takeFileName slPath `notElem` mapMaybe toDetails (elContent relationships) + + findElemAttr :: QName -> Content -> Maybe Text + findElemAttr attr (Elem e) = findAttr attr e + findElemAttr _ _ = Nothing maxIdNumber :: Element -> Integer maxIdNumber relationships = maximum (0 : idNumbers) -- cgit v1.2.3