@@ -29,7 +29,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2929Conversion of 'Pandoc' documents to docx.
3030-}
3131module Text.Pandoc.Writers.Docx ( writeDocx ) where
32−import Data.Maybe (fromMaybe)
3332import Data.List ( intercalate, isPrefixOf, isSuffixOf )
3433import qualified Data.ByteString as B
3534import qualified Data.ByteString.Lazy as BL
@@ -59,7 +58,7 @@ import Text.Printf (printf)
5958import qualified Control.Exception as E
6059import Text.Pandoc.MIME (getMimeType, extensionFromMimeType)
6160import Control.Applicative ((<|>), (<$>))
62−import Data.Maybe (mapMaybe)
61+import Data.Maybe (fromMaybe, mapMaybe)
6362
6463data ListMarker = NoMarker
6564 | BulletMarker
@@ -119,8 +118,8 @@ mknode s attrs =
119118nodename :: String -> QName
120119nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix }
121120 where (name, prefix) = case break (==':') s of
122− (xs,[]) -> (xs, Nothing)
123− (ys,(_:zs)) -> (zs, Just ys)
121+ (xs,[]) -> (xs, Nothing)
122+ (ys, _:zs) -> (zs, Just ys)
124123
125124toLazy :: B.ByteString -> BL.ByteString
126125toLazy = BL.fromChunks . (:[])
@@ -156,7 +155,7 @@ writeDocx opts doc@(Pandoc meta _) = do
156155 let wname f qn = qPrefix qn == Just "w" && f (qName qn)
157156 let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc
158157
159− let sectpr = maybe (mknode "w:sectPr" [] $ ()) id mbsectpr
158+ let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr
160159
161160 let stdAttributes =
162161 [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
@@ -171,7 +170,7 @@ writeDocx opts doc@(Pandoc meta _) = do
171170
172171 let contents' = contents ++ [sectpr]
173172 let docContents = mknode "w:document" stdAttributes
174− $ mknode "w:body" [] $ contents'
173+ $ mknode "w:body" [] contents'
175174
176175 parsedRels <- parseXml refArchive distArchive "word/_rels/document.xml.rels"
177176 let isHeaderNode e = findAttr (QName "Type" Nothing Nothing) e == Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/header"
@@ -179,7 +178,7 @@ writeDocx opts doc@(Pandoc meta _) = do
179178 let headers = filterElements isHeaderNode parsedRels
180179 let footers = filterElements isFooterNode parsedRels
181180
182− let extractTarget e = findAttr (QName "Target" Nothing Nothing) e
181+ let extractTarget = findAttr (QName "Target" Nothing Nothing)
183182
184183 -- we create [Content_Types].xml and word/_rels/document.xml.rels
185184 -- from scratch rather than reading from reference.docx,
@@ -283,7 +282,7 @@ writeDocx opts doc@(Pandoc meta _) = do
283282 -- footnote rels
284283 let footnoteRelEntry = toEntry "word/_rels/footnotes.xml.rels" epochtime
285284 $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
286− $ linkrels
285+ linkrels
287286
288287 -- styles
289288 let newstyles = styleToOpenXml $ writerHighlightStyle opts
@@ -315,8 +314,8 @@ writeDocx opts doc@(Pandoc meta _) = do
315314 $ mknode "dc:title" [] (stringify $ docTitle meta)
316315 : mknode "dc:creator" [] (intercalate "; " (map stringify $ docAuthors meta))
317316 : maybe []
318− (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] $ x
319− , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] $ x
317+ (\x -> [ mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")] x
318+ , mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] x
320319 ]) (normalizeDate $ stringify $ docDate meta)
321320 let docPropsEntry = toEntry docPropsPath epochtime $ renderXml docProps
322321
@@ -347,7 +346,7 @@ writeDocx opts doc@(Pandoc meta _) = do
347346 settingsEntry <- entryFromArchive distArchive "word/settings.xml"
348347 webSettingsEntry <- entryFromArchive refArchive "word/webSettings.xml"
349348 headerFooterEntries <- mapM (entryFromArchive refArchive) $
350− mapMaybe (\e -> fmap ("word/" ++) $ extractTarget e)
349+ mapMaybe (fmap ("word/" ++) . extractTarget)
351350 (headers ++ footers)
352351 let miscRelEntries = [ e | e <- zEntries refArchive
353352 , "word/_rels/" `isPrefixOf` (eRelativePath e)
@@ -508,7 +507,7 @@ writeOpenXML opts (Pandoc meta blocks) = do
508507 let convertSpace (Str x : Space : Str y : xs) = Str (x ++ " " ++ y) : xs
509508 convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs
510509 convertSpace xs = xs
511− let blocks' = bottomUp convertSpace $ blocks
510+ let blocks' = bottomUp convertSpace blocks
512511 doc' <- blocksToOpenXML opts blocks'
513512 notes' <- reverse `fmap` gets stFootnotes
514513 let meta' = title ++ subtitle ++ authors ++ date ++ abstract
@@ -592,13 +591,12 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do
592591 let cellToOpenXML (al, cell) = withParaProp (alignmentFor al)
593592 $ blocksToOpenXML opts cell
594593 headers' <- mapM cellToOpenXML $ zip aligns headers
595− rows' <- mapM (\cells -> mapM cellToOpenXML $ zip aligns cells)
596− $ rows
594+ rows' <- mapM (mapM cellToOpenXML . zip aligns) rows
597595 let borderProps = mknode "w:tcPr" []
598596 [ mknode "w:tcBorders" []
599597 $ mknode "w:bottom" [("w:val","single")] ()
600598 , mknode "w:vAlign" [("w:val","bottom")] () ]
601− let emptyCell = [mknode "w:p" [] [mknode "w:pPr" [] $
599+ let emptyCell = [mknode "w:p" [] [mknode "w:pPr" []
602600 [mknode "w:pStyle" [("w:val","Compact")] ()]]]
603601 let mkcell border contents = mknode "w:tc" []
604602 $ [ borderProps | border ] ++
@@ -610,12 +608,12 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do
610608 let fullrow = 5000 -- 100% specified in pct
611609 let rowwidth = fullrow * sum widths
612610 let mkgridcol w = mknode "w:gridCol"
613− [("w:w", show $ (floor (textwidth * w) :: Integer))] ()
611+ [("w:w", show (floor (textwidth * w) :: Integer))] ()
614612 return $
615− [ mknode "w:tbl" []
613+ mknode "w:tbl" []
616614 ( mknode "w:tblPr" []
617− ( [ mknode "w:tblStyle" [("w:val","TableNormal")] () ] ++
618− [ mknode "w:tblW" [("w:type", "pct"), ("w:w", (show rowwidth))] () ] ++
615+ ( mknode "w:tblStyle" [("w:val","TableNormal")] () :
616+ mknode "w:tblW" [("w:type", "pct"), ("w:w", show rowwidth)] () :
619617 [ mknode "w:tblCaption" [("w:val", captionStr)] ()
620618 | not (null caption) ] )
621619 : mknode "w:tblGrid" []
@@ -624,8 +622,7 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do
624622 else map mkgridcol widths)
625623 : [ mkrow True headers' | not (all null headers) ] ++
626624 map (mkrow False) rows'
627− )
628− ] ++ caption'
625+ ) : caption'
629626blockToOpenXML opts (BulletList lst) = do
630627 let marker = BulletMarker
631628 addList marker
@@ -692,7 +689,7 @@ getTextProps = do
692689 props <- gets stTextProperties
693690 return $ if null props
694691 then []
695− else [mknode "w:rPr" [] $ props]
692+ else [mknode "w:rPr" [] props]
696693
697694pushTextProp :: Element -> WS ()
698695pushTextProp d = modify $ \s -> s{ stTextProperties = d : stTextProperties s }