@@ -1,3 +1,4 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
12{-
23Copyright (C) 2012 John MacFarlane <jgm@berkeley.edu>
34
@@ -29,15 +30,14 @@ Conversion of 'Pandoc' documents to docx.
2930-}
3031module Text.Pandoc.Writers.Docx ( writeDocx ) where
3132import Data.List ( intercalate )
32−import qualified Data.ByteString.Lazy as B
33+import qualified Data.ByteString as B
34+import qualified Data.ByteString.Lazy as BL
3335import qualified Data.Map as M
3436import qualified Text.Pandoc.UTF8 as UTF8
35−import System.IO ( stderr )
3637import Codec.Archive.Zip
3738import Data.Time.Clock.POSIX
3839import Text.Pandoc.Definition
3940import Text.Pandoc.Generic
40−import System.Directory
4141import Text.Pandoc.ImageSize
4242import Text.Pandoc.Shared hiding (Element)
4343import Text.Pandoc.Options
@@ -51,6 +51,7 @@ import Text.Highlighting.Kate
5151import Data.Unique (hashUnique, newUnique)
5252import System.Random (randomRIO)
5353import Text.Printf (printf)
54+import qualified Control.Exception as E
5455
5556data WriterState = WriterState{
5657 stTextProperties :: [Element]
@@ -93,17 +94,19 @@ mknode :: Node t => String -> [(String,String)] -> t -> Element
9394mknode s attrs =
9495 add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) . node (unqual s)
9596
97+toLazy :: B.ByteString -> BL.ByteString
98+toLazy = BL.fromChunks . (:[])
99+
96100-- | Produce an Docx file from a Pandoc document.
97101writeDocx :: WriterOptions -- ^ Writer options
98102 -> Pandoc -- ^ Document to convert
99− -> IO B.ByteString
103+ -> IO BL.ByteString
100104writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
101105 let datadir = writerUserDataDir opts
102− refArchive <- liftM toArchive $
106+ refArchive <- liftM (toArchive . toLazy) $
103107 case writerReferenceDocx opts of
104− Just f -> B.readFile f
105− Nothing -> (B.fromChunks . (:[])) `fmap`
106− readDataFile datadir "reference.docx"
108+ Just f -> B.readFile f
109+ Nothing -> readDataFile datadir "reference.docx"
107110
108111 ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc)
109112 defaultWriterState
@@ -125,7 +128,7 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
125128 let reldoc' = reldoc{ elContent = elContent reldoc ++ map Elem newrels }
126129 -- create entries for images
127130 let toImageEntry (ident,img) = toEntry ("word/" ++ imgPath ident img)
128− epochtime img
131+ epochtime $ toLazy img
129132 let imageEntries = map toImageEntry imgs
130133 -- NOW get list of external links and images from this, and do what's needed
131134 let toLinkRel (src,ident) = mknode "Relationship" [("Type","http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink"),("Id",ident),("Target",src),("TargetMode","External") ] ()
@@ -623,14 +626,20 @@ inlineToOpenXML opts (Link txt (src,_)) = do
623626 return i
624627 return [ mknode "w:hyperlink" [("r:id",id')] contents ]
625628inlineToOpenXML opts (Image alt (src, tit)) = do
626− exists <- liftIO $ doesFileExist src
627− if exists
628− then do
629+ res <- liftIO $ E.try $ getItem (writerUserDataDir opts) src
630+ -- res is Right (img, maybeMIMEString) or Left err
631+ case res of
632+ Left (_ :: E.SomeException) -> do
633+ liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
634+ inlinesToOpenXML opts alt
635+ Right (img, _) -> do
629636 imgs <- gets stImages
637+ -- TODO move this check to before the getItem
638+ -- also TODO, instead of storing ident, imagebs; store
639+ -- the whole Element, so we don't have to reconstruct it at all.
630640 (ident,size) <- case M.lookup src imgs of
631− Just (i,img) -> return (i, imageSize img)
641+ Just (i,img') -> return (i, imageSize img')
632642 Nothing -> do
633− img <- liftIO $ B.readFile src
634643 ident' <- ("rId"++) `fmap` getUniqueId
635644 let size' = imageSize img
636645 modify $ \st -> st{
@@ -672,10 +681,6 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
672681 , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] ()
673682 , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] ()
674683 , graphic ] ]
675− else do
676− liftIO $ UTF8.hPutStrLn stderr $
677− "Could not find image `" ++ src ++ "', skipping..."
678− inlinesToOpenXML opts alt
679684
680685br :: Element
681686br = mknode "w:r" [] [mknode "w:cr" [] () ]