bd1079e · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Docx writer: Ignore most components of reference.docx.

bd1079eJohn MacFarlane13 years ago

src/Text/Pandoc/Writers/Docx.hs+41−24

compare with master

unifiedsplit

@@ -32,8 +32,10 @@ module Text.Pandoc.Writers.Docx ( writeDocx ) where

32import Data.List ( intercalate, groupBy )

33import qualified Data.ByteString as B

34import qualified Data.ByteString.Lazy as BL

35+import qualified Data.ByteString.Lazy.Char8 as BL8

35import qualified Data.Map as M

36import qualified Data.Map as M

36import qualified Text.Pandoc.UTF8 as UTF8

37import qualified Text.Pandoc.UTF8 as UTF8

38+import Data.Monoid ((<>))

37import Codec.Archive.Zip

39import Codec.Archive.Zip

38import Data.Time.Clock.POSIX

40import Data.Time.Clock.POSIX

39import Text.Pandoc.Definition

41import Text.Pandoc.Definition

@@ -89,9 +91,6 @@ defaultWriterState = WriterState{

90type WS a = StateT WriterState IO a

92type WS a = StateT WriterState IO a

92−showTopElement' :: Element -> String

93−showTopElement' x = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++ showElement x

94−

95mknode :: Node t => String -> [(String,String)] -> t -> Element

94mknode :: Node t => String -> [(String,String)] -> t -> Element

96mknode s attrs =

95mknode s attrs =

97 add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) . node (unqual s)

96 add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) . node (unqual s)

@@ -99,6 +98,10 @@ mknode s attrs =

99toLazy :: B.ByteString -> BL.ByteString

98toLazy :: B.ByteString -> BL.ByteString

100toLazy = BL.fromChunks . (:[])

99toLazy = BL.fromChunks . (:[])

101

100

101+renderXml :: Element -> BL.ByteString

102+renderXml elt = BL8.pack "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" <>

103+ UTF8.fromStringLazy (showElement elt)

104+

102-- | Produce an Docx file from a Pandoc document.

105-- | Produce an Docx file from a Pandoc document.

103writeDocx :: WriterOptions -- ^ Writer options

106writeDocx :: WriterOptions -- ^ Writer options

104 -> Pandoc -- ^ Document to convert

107 -> Pandoc -- ^ Document to convert

@@ -155,7 +158,7 @@ writeDocx opts doc@(Pandoc meta _) = do

155 [("Extension","rels"),("ContentType","application/vnd.openxmlformats-package.relationships+xml")] ()]

158 [("Extension","rels"),("ContentType","application/vnd.openxmlformats-package.relationships+xml")] ()]

156 let contentTypesDoc = mknode "Types" [("xmlns","http://schemas.openxmlformats.org/package/2006/content-types")] $ defaultnodes ++ overrides

159 let contentTypesDoc = mknode "Types" [("xmlns","http://schemas.openxmlformats.org/package/2006/content-types")] $ defaultnodes ++ overrides

157 let contentTypesEntry = toEntry "[Content_Types].xml" epochtime

160 let contentTypesEntry = toEntry "[Content_Types].xml" epochtime

158− $ UTF8.fromStringLazy $ showTopElement' contentTypesDoc

161+ $ renderXml contentTypesDoc

159

162

160 -- word/_rels/document.xml.rels

163 -- word/_rels/document.xml.rels

161 let toBaseRel (url', id', target') = mknode "Relationship"

164 let toBaseRel (url', id', target') = mknode "Relationship"

@@ -190,22 +193,21 @@ writeDocx opts doc@(Pandoc meta _) = do

190 let linkrels = map toLinkRel $ M.toList $ stExternalLinks st

193 let linkrels = map toLinkRel $ M.toList $ stExternalLinks st

191 let reldoc = mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")] $ baserels ++ imgrels ++ linkrels

194 let reldoc = mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")] $ baserels ++ imgrels ++ linkrels

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

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

193− $ UTF8.fromStringLazy $ showTopElement' reldoc

196+ $ renderXml reldoc

194

197

195 -- create entries for images in word/media/...

198 -- create entries for images in word/media/...

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

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

197 let imageEntries = map toImageEntry imgs

200 let imageEntries = map toImageEntry imgs

198

201

199 -- word/document.xml

202 -- word/document.xml

200− let contentEntry = toEntry "word/document.xml" epochtime $ UTF8.fromStringLazy $ showTopElement' contents

203+ let contentEntry = toEntry "word/document.xml" epochtime $ renderXml contents

201

204

202 -- footnotes

205 -- footnotes

203− let footnotesEntry = toEntry "word/footnotes.xml" epochtime $ UTF8.fromStringLazy $

206+ let footnotesEntry = toEntry "word/footnotes.xml" epochtime $ renderXml footnotes

204− showTopElement' footnotes

205

207

206 -- footnote rels

208 -- footnote rels

207− let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime $ UTF8.fromStringLazy $

209+ let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime

208− showTopElement' $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]

210+ $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]

209 $ linkrels

211 $ linkrels

210

212

211 -- styles

213 -- styles

@@ -213,11 +215,11 @@ writeDocx opts doc@(Pandoc meta _) = do

213 let stylepath = "word/styles.xml"

215 let stylepath = "word/styles.xml"

214 styledoc <- parseXml refArchive stylepath

216 styledoc <- parseXml refArchive stylepath

215 let styledoc' = styledoc{ elContent = elContent styledoc ++ map Elem newstyles }

217 let styledoc' = styledoc{ elContent = elContent styledoc ++ map Elem newstyles }

216− let styleEntry = toEntry stylepath epochtime $ UTF8.fromStringLazy $ showTopElement' styledoc'

218+ let styleEntry = toEntry stylepath epochtime $ renderXml styledoc'

217

219

218 -- construct word/numbering.xml

220 -- construct word/numbering.xml

219 let numpath = "word/numbering.xml"

221 let numpath = "word/numbering.xml"

220− numEntry <- (toEntry numpath epochtime . UTF8.fromStringLazy . showTopElement')

222+ numEntry <- (toEntry numpath epochtime . renderXml)

221 `fmap` mkNumbering (stNumStyles st) (stLists st)

223 `fmap` mkNumbering (stNumStyles st) (stLists st)

222 let docPropsPath = "docProps/core.xml"

224 let docPropsPath = "docProps/core.xml"

223 let docProps = mknode "cp:coreProperties"

225 let docProps = mknode "cp:coreProperties"

@@ -231,21 +233,36 @@ writeDocx opts doc@(Pandoc meta _) = do

231 (maybe "" id $ normalizeDate $ stringify $ docDate meta)

233 (maybe "" id $ normalizeDate $ stringify $ docDate meta)

232 : mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] () -- put current time here

234 : mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] () -- put current time here

233 : map (mknode "dc:creator" [] . stringify) (docAuthors meta)

235 : map (mknode "dc:creator" [] . stringify) (docAuthors meta)

234− let docPropsEntry = toEntry docPropsPath epochtime $ UTF8.fromStringLazy $ showTopElement' docProps

236+ let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps

235− let relsPath = "_rels/.rels"

236− rels <- case findEntryByPath relsPath refArchive of

237− Just e -> return $ UTF8.toStringLazy $ fromEntry e

238− Nothing -> err 57 "could not find .rels/_rels in reference docx"

239

237

240− -- fix .rels/_rels, which can get screwed up when reference.docx is edited by Word

238+ let relsPath = "_rels/.rels"

241− let rels' = substitute "http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties"

239+ let rels = mknode "Relationships" [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]

240+ $ map (\attrs -> mknode "Relationship" attrs ())

241+ [ [("Id","rId1")

242+ ,("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument")

243+ ,("Target","word/document.xml")]

244+ , [("Id","rId4")

245+ ,("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties")

246+ ,("Target","docProps/app.xml")]

247+ , [("Id","rId3")

242− "http://schemas.openxmlformats.org/officedocument/2006/relationships/metadata/core-properties"

248+ ,("Type","http://schemas.openxmlformats.org/officedocument/2006/relationships/metadata/core-properties")

243− rels

249+ ,("Target","docProps/core.xml")]

250+ ]

244− let relsEntry = toEntry relsPath epochtime $ UTF8.fromStringLazy rels'

251+ let relsEntry = toEntry relsPath epochtime $ renderXml rels

252+

253+ let entryFromArchive path = (toEntry path epochtime . renderXml) `fmap`

254+ parseXml refArchive path

255+ docPropsAppEntry <- entryFromArchive "docProps/app.xml"

256+ themeEntry <- entryFromArchive "word/theme/theme1.xml"

257+ fontTableEntry <- entryFromArchive "word/fontTable.xml"

258+ webSettingsEntry <- entryFromArchive "word/webSettings.xml"

245

259

246 -- Create archive

260 -- Create archive

247− let archive = foldr addEntryToArchive refArchive $

261+ let archive = foldr addEntryToArchive emptyArchive $

262+ contentTypesEntry : relsEntry : contentEntry : relEntry :

248− contentTypesEntry : relsEntry : contentEntry : relEntry : footnoteRelEntry : numEntry : styleEntry : footnotesEntry : docPropsEntry : imageEntries

263+ footnoteRelEntry : numEntry : styleEntry : footnotesEntry :

264+ docPropsEntry : docPropsAppEntry : themeEntry :

265+ fontTableEntry : webSettingsEntry : imageEntries

249 return $ fromArchive archive

266 return $ fromArchive archive

250

267

251styleToOpenXml :: Style -> [Element]

268styleToOpenXml :: Style -> [Element]