7242165 · typeable/pandoc

59import qualified Control.Exception as E

60import Text.Pandoc.MIME (getMimeType, extensionFromMimeType)

61import Control.Applicative ((<|>))

62+import Data.Maybe (mapMaybe)

62

63

63data ListMarker = NoMarker

64data ListMarker = NoMarker

64 | BulletMarker

65 | BulletMarker

123 epochtime <- floor `fmap` getPOSIXTime

124 epochtime <- floor `fmap` getPOSIXTime

124 let imgs = M.elems $ stImages st

125 let imgs = M.elems $ stImages st

125

126

127+ -- create entries for images in word/media/...

128+ let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img

129+ let imageEntries = map toImageEntry imgs

130+

131+ -- adjust contents to add sectPr from reference.docx

132+ parsedDoc <- parseXml refArchive distArchive "word/document.xml"

133+ let wname f qn = qPrefix qn == Just "w" && f (qName qn)

134+ let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc

135+

136+ let sectpr = maybe (mknode "w:sectPr" [] $ ()) id mbsectpr

137+

138+ let stdAttributes =

139+ [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")

140+ ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")

141+ ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")

142+ ,("xmlns:o","urn:schemas-microsoft-com:office:office")

143+ ,("xmlns:v","urn:schemas-microsoft-com:vml")

144+ ,("xmlns:w10","urn:schemas-microsoft-com:office:word")

145+ ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")

146+ ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")

147+ ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]

148+

149+ let contents' = contents ++ [sectpr]

150+ let docContents = mknode "w:document" stdAttributes

151+ $ mknode "w:body" [] $ contents'

152+

153+ parsedRels <- parseXml refArchive distArchive "word/_rels/document.xml.rels"

154+ let isHeaderNode e = findAttr (QName "Type" Nothing Nothing) e == Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/header"

155+ let isFooterNode e = findAttr (QName "Type" Nothing Nothing) e == Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer"

156+ let headers = filterElements isHeaderNode parsedRels

157+ let footers = filterElements isFooterNode parsedRels

158+

159+ let extractTarget e = findAttr (QName "Target" Nothing Nothing) e

160+

126 -- we create [Content_Types].xml and word/_rels/document.xml.rels

161 -- we create [Content_Types].xml and word/_rels/document.xml.rels

127 -- from scratch rather than reading from reference.docx,

162 -- from scratch rather than reading from reference.docx,

128 -- because Word sometimes changes these files when a reference.docx is modified,

163 -- because Word sometimes changes these files when a reference.docx is modified,

135 let mkImageOverride (_, imgpath, mbMimeType, _, _) =

170 let mkImageOverride (_, imgpath, mbMimeType, _, _) =

136 mkOverrideNode ("/word/" ++ imgpath,

171 mkOverrideNode ("/word/" ++ imgpath,

137 fromMaybe "application/octet-stream" mbMimeType)

172 fromMaybe "application/octet-stream" mbMimeType)

138− let overrides = map mkOverrideNode

173+ let overrides = map mkOverrideNode (

139 [("/word/webSettings.xml",

174 [("/word/webSettings.xml",

140 "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")

175 "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")

141 ,("/word/numbering.xml",

176 ,("/word/numbering.xml",

155 ,("/word/document.xml",

190 ,("/word/document.xml",

156 "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml")

191 "application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml")

157 ,("/word/footnotes.xml",

192 ,("/word/footnotes.xml",

158− "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml"),

193+ "application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml")

159− ("/word/header1.xml",

194+ ] ++

195+ map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,

160− "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml"),

196+ "application/vnd.openxmlformats-officedocument.wordprocessingml.header+xml")) headers ++

161− ("/word/footer1.xml",

197+ map (\x -> (maybe "" ("/word/" ++) $ extractTarget x,

162− "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml") ] ++ map mkImageOverride imgs

198+ "application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml")) footers) ++

199+ map mkImageOverride imgs

163 let defaultnodes = [mknode "Default"

200 let defaultnodes = [mknode "Default"

164 [("Extension","xml"),("ContentType","application/xml")] (),

201 [("Extension","xml"),("ContentType","application/xml")] (),

165 mknode "Default"

202 mknode "Default"

195 ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",

232 ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footnotes",

196 "rId7",

233 "rId7",

197 "footnotes.xml")

234 "footnotes.xml")

198− ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/header",

199− "rId8",

200− "header1.xml")

201− ,("http://schemas.openxmlformats.org/officeDocument/2006/relationships/footer",

202− "rId9",

203− "footer1.xml")

204− ]

235+ ] ++

236+ headers ++ footers

205 let toImgRel (ident,path,_,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()

237 let toImgRel (ident,path,_,_,_) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/image"),("Id",ident),("Target",path)] ()

206 let imgrels = map toImgRel imgs

238 let imgrels = map toImgRel imgs

207 let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()

239 let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()

210 let relEntry = toEntry "word/_rels/document.xml.rels" epochtime

242 let relEntry = toEntry "word/_rels/document.xml.rels" epochtime

211 $ renderXml reldoc

243 $ renderXml reldoc

212

244

213− -- create entries for images in word/media/...

214− let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img

215− let imageEntries = map toImageEntry imgs

216−

217− -- adjust contents to add sectPr from reference.docx

218− let docpath = "word/document.xml"

219− parsedDoc <- parseXml refArchive distArchive docpath

220− let mbsectpr = filterElementName (\qn -> qPrefix qn == Just "w" &&

221− qName qn == "sectPr") parsedDoc

222− let sectPrProps = case mbsectpr of

223− Nothing -> []

224− Just e -> filterElementsName (\qn ->

225− qPrefix qn == Just "w" &&

226− qName qn `notElem` ["headerReference","footerReference","sectPr"]) e

227− let headerPr = mknode "w:headerReference" [("w:type","default"),("r:id","rId8")] $ ()

228− let footerPr = mknode "w:footerReference" [("w:type","default"),("r:id","rId9")] $ ()

229− let sectpr = mknode "w:sectPr" [] $ [headerPr, footerPr] ++ sectPrProps

230−

231− let stdAttributes =

232− [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")

233− ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")

234− ,("xmlns:r","http://schemas.openxmlformats.org/officeDocument/2006/relationships")

235− ,("xmlns:o","urn:schemas-microsoft-com:office:office")

236− ,("xmlns:v","urn:schemas-microsoft-com:vml")

237− ,("xmlns:w10","urn:schemas-microsoft-com:office:word")

238− ,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")

239− ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")

240− ,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]

241−

242− let contents' = contents ++ [sectpr]

243− let docContents = mknode "w:document" stdAttributes

244− $ mknode "w:body" [] $ contents'

245

246 -- word/document.xml

247 let contentEntry = toEntry "word/document.xml" epochtime

304 docPropsAppEntry <- entryFromArchive refArchive "docProps/app.xml"

305 themeEntry <- entryFromArchive refArchive "word/theme/theme1.xml"

306 fontTableEntry <- entryFromArchive refArchive "word/fontTable.xml"

307− -- we take settings.xml from dist archive because the ref archive

307+ -- we use dist archive for settings.xml, because Word sometimes

308− -- sometimes references special footnotes and endnotes that may

309− -- not be defined in footnotes.xml or endnotes.xml.

308+ -- adds references to footnotes or endnotes we don't have...

310 settingsEntry <- entryFromArchive distArchive "word/settings.xml"

309 settingsEntry <- entryFromArchive distArchive "word/settings.xml"

311− webSettingsEntry <- entryFromArchive distArchive "word/webSettings.xml"

310+ webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml"

312− headerEntry <- entryFromArchive refArchive "word/header1.xml"

311+ headerFooterEntries <- mapM (entryFromArchive refArchive) $

313− footerEntry <- entryFromArchive refArchive "word/footer1.xml"

312+ mapMaybe (\e -> fmap ("word/" ++) $ extractTarget e)

313+ (headers ++ footers)

314 let miscRels = [ f | f <- filesInArchive refArchive

315 , "word/_rels/" `isPrefixOf` f

316 , ".xml.rels" `isSuffixOf` f

324 footnoteRelEntry : numEntry : styleEntry : footnotesEntry :

325 docPropsEntry : docPropsAppEntry : themeEntry :

326 fontTableEntry : settingsEntry : webSettingsEntry :

327+ imageEntries ++ headerFooterEntries ++

327− headerEntry : footerEntry : imageEntries ++ miscRelEntries

328+ miscRelEntries

328 return $ fromArchive archive

329 return $ fromArchive archive

329

330

330styleToOpenXml :: Style -> [Element]

331styleToOpenXml :: Style -> [Element]