@@ -217,7 +217,7 @@ writeDocx opts doc@(Pandoc meta _) = do
217 -- styles
217 -- styles
218 let newstyles = styleToOpenXml $ writerHighlightStyle opts
218 let newstyles = styleToOpenXml $ writerHighlightStyle opts
219 let stylepath = "word/styles.xml"
219 let stylepath = "word/styles.xml"
220− styledoc <- parseXml refArchive stylepath
220+ styledoc <- parseXml refArchive stylepath Nothing
221 let styledoc' = styledoc{ elContent = elContent styledoc ++
221 let styledoc' = styledoc{ elContent = elContent styledoc ++
222 [Elem x | x <- newstyles, writerHighlight opts] }
222 [Elem x | x <- newstyles, writerHighlight opts] }
223 let styleEntry = toEntry stylepath epochtime $ renderXml styledoc'
223 let styleEntry = toEntry stylepath epochtime $ renderXml styledoc'
@@ -256,19 +256,20 @@ writeDocx opts doc@(Pandoc meta _) = do
257 let relsEntry = toEntry relsPath epochtime $ renderXml rels
257 let relsEntry = toEntry relsPath epochtime $ renderXml rels
259+ let entryFromArchive path fallback =
259− let entryFromArchive path = (toEntry path epochtime . renderXml) `fmap`
260+ (toEntry path epochtime . renderXml) `fmap`
260− parseXml refArchive path
261+ parseXml refArchive path fallback
261− docPropsAppEntry <- entryFromArchive "docProps/app.xml"
262+ docPropsAppEntry <- entryFromArchive "docProps/app.xml" Nothing
262− themeEntry <- entryFromArchive "word/theme/theme1.xml"
263+ themeEntry <- entryFromArchive "word/theme/theme1.xml" Nothing
263− fontTableEntry <- entryFromArchive "word/fontTable.xml"
264+ fontTableEntry <- entryFromArchive "word/fontTable.xml" Nothing
264− settingsEntry <- entryFromArchive "word/settings.xml"
265+ settingsEntry <- entryFromArchive "word/settings.xml" Nothing
265− webSettingsEntry <- entryFromArchive "word/webSettings.xml"
266+ webSettingsEntry <- entryFromArchive "word/webSettings.xml" Nothing
266 let miscRels = [ f | f <- filesInArchive refArchive
267 let miscRels = [ f | f <- filesInArchive refArchive
267 , "word/_rels/" `isPrefixOf` f
268 , "word/_rels/" `isPrefixOf` f
268 , ".xml.rels" `isSuffixOf` f
269 , ".xml.rels" `isSuffixOf` f
269 , f /= "word/_rels/document.xml.rels"
270 , f /= "word/_rels/document.xml.rels"
270 , f /= "word/_rels/footnotes.xml.rels" ]
271 , f /= "word/_rels/footnotes.xml.rels" ]
271− miscRelEntries <- mapM entryFromArchive miscRels
272+ miscRelEntries <- mapM (\f -> entryFromArchive f Nothing) miscRels
273 -- Create archive
274 -- Create archive
274 let archive = foldr addEntryToArchive emptyArchive $
275 let archive = foldr addEntryToArchive emptyArchive $
@@ -814,10 +815,10 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
814br :: Element
815br :: Element
815br = mknode "w:r" [] [mknode "w:br" [("w:type","textWrapping")] () ]
816br = mknode "w:r" [] [mknode "w:br" [("w:type","textWrapping")] () ]
817−parseXml :: Archive -> String -> IO Element
818+parseXml :: Archive -> String -> Maybe String -> IO Element
818−parseXml refArchive relpath =
819+parseXml refArchive relpath fallback =
819− case findEntryByPath relpath refArchive of
820+ case (findEntryByPath relpath refArchive
820− Just e -> case parseXMLDoc $ UTF8.toStringLazy $ fromEntry e of
821+ >>= parseXMLDoc . UTF8.toStringLazy . fromEntry) `mplus`
822+ (fallback >>= parseXMLDoc) of
821− Just d -> return d
823+ Just d -> return d
822− Nothing -> fail $ relpath ++ " corrupt in reference docx"
824+ Nothing -> fail $ relpath ++ " corrupt or missing in reference docx"
823− Nothing -> fail $ relpath ++ " missing in reference docx"