@@ -29,7 +29,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2929Conversion of 'Pandoc' documents to ODT.
3030-}
3131module Text.Pandoc.Writers.ODT ( writeODTPure, writeODT ) where
32−import Data.IORef
3332import Data.List ( isPrefixOf )
3433import Data.Maybe ( fromMaybe )
3534import Text.XML.Light.Output
@@ -46,6 +45,7 @@ import Text.Pandoc.Walk
4645import Text.Pandoc.Writers.Shared ( fixDisplayMath )
4746import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
4847import Control.Monad (liftM)
48+import Control.Monad.State
4949import Text.Pandoc.XML
5050import Text.Pandoc.Pretty
5151import qualified Control.Exception as E
@@ -55,31 +55,45 @@ import qualified Text.Pandoc.Free as P
5555
5656type ODTAction = PandocAction [Entry]
5757
58+data ODTState = ODTState { stEntries :: [Entry]
59+ }
60+
61+type O = StateT ODTState ODTAction
62+
5863-- | Produce an ODT file from a Pandoc document.
5964writeODT :: WriterOptions -- ^ Writer options
6065 -> Pandoc -- ^ Document to convert
6166 -> IO B.ByteString
6267writeODT opts doc = runIO $ writeODTPure opts doc
6368
64−-- | Produce an ODT file from a Pandoc document.
65−writeODTPure :: WriterOptions -- ^ Writer options
66− -> Pandoc -- ^ Document to convert
69+writeODTPure :: WriterOptions
70+ -> Pandoc
6771 -> ODTAction B.ByteString
68−writeODTPure opts doc@(Pandoc meta _) = do
72+writeODTPure opts doc =
73+ let initState = ODTState{ stEntries = []
74+ }
75+ in
76+ evalStateT (pandocToODT opts doc) initState
77+
78+-- | Produce an ODT file from a Pandoc document.
79+pandocToODT :: WriterOptions -- ^ Writer options
80+ -> Pandoc -- ^ Document to convert
81+ -> O B.ByteString
82+pandocToODT opts doc@(Pandoc meta _) = do
6983 let datadir = writerUserDataDir opts
7084 let title = docTitle meta
7185 refArchive <-
7286 case writerReferenceODT opts of
73− Just f -> liftM toArchive $ P.readFileLazy f
74− Nothing -> P.getDefaultReferenceODT datadir
87+ Just f -> liftM toArchive $ lift $ P.readFileLazy f
88+ Nothing -> lift $ P.getDefaultReferenceODT datadir
7589 -- handle formulas and pictures
76− picEntriesRef <- P.newIORef ([] :: [Entry])
77− doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc
90+ -- picEntriesRef <- P.newIORef ([] :: [Entry])
91+ doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc
7892 let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc'
79− epochtime <- floor `fmap` P.getPOSIXTime
93+ epochtime <- floor `fmap` (lift P.getPOSIXTime)
8094 let contentEntry = toEntry "content.xml" epochtime
8195 $ fromStringLazy newContents
82− picEntries <- P.readIORef picEntriesRef
96+ picEntries <- gets stEntries
8397 let archive = foldr addEntryToArchive refArchive
8498 $ contentEntry : picEntries
8599 -- construct META-INF/manifest.xml based on archive
@@ -134,18 +148,18 @@ writeODTPure opts doc@(Pandoc meta _) = do
134148 return $ fromArchive archive''
135149
136150-- | transform both Image and Math elements
137−transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> ODTAction Inline
138−transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do
139− res <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
151+transformPicMath :: WriterOptions ->Inline -> O Inline
152+transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do
153+ res <- lift $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
140154 case res of
141155 Left (_ :: E.SomeException) -> do
142− P.warn $ "Could not find image `" ++ src ++ "', skipping..."
156+ lift $ P.warn $ "Could not find image `" ++ src ++ "', skipping..."
143157 return $ Emph lab
144158 Right (img, mbMimeType) -> do
145159 (ptX, ptY) <- case imageSize img of
146160 Right s -> return $ sizeInPoints s
147161 Left msg -> do
148− P.warn $ "Could not determine image size in `" ++
162+ lift $ P.warn $ "Could not determine image size in `" ++
149163 src ++ "': " ++ msg
150164 return (100, 100)
151165 let dims =
@@ -163,28 +177,28 @@ transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do
163177 Just dim -> Just $ Inch $ inInch opts dim
164178 Nothing -> Nothing
165179 let newattr = (id', cls, dims)
166− entries <- P.readIORef entriesRef
180+ entries <- gets stEntries
167181 let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)
168182 (mbMimeType >>= extensionFromMimeType)
169183 let newsrc = "Pictures/" ++ show (length entries) <.> extension
170184 let toLazy = B.fromChunks . (:[])
171− epochtime <- floor `fmap` P.getPOSIXTime
185+ epochtime <- floor `fmap` (lift P.getPOSIXTime)
172186 let entry = toEntry newsrc epochtime $ toLazy img
173− P.modifyIORef entriesRef (entry:)
187+ modify $ \st -> st{ stEntries = entry : entries }
174188 return $ Image newattr lab (newsrc, t)
175−transformPicMath _ entriesRef (Math t math) = do
176− entries <- P.readIORef entriesRef
189+transformPicMath _ (Math t math) = do
190+ entries <- gets stEntries
177191 let dt = if t == InlineMath then DisplayInline else DisplayBlock
178192 case writeMathML dt <$> readTeX math of
179193 Left _ -> return $ Math t math
180194 Right r -> do
181195 let conf = useShortEmptyTags (const False) defaultConfigPP
182196 let mathml = ppcTopElement conf r
183− epochtime <- floor `fmap` P.getPOSIXTime
197+ epochtime <- floor `fmap` (lift $ P.getPOSIXTime)
184198 let dirname = "Formula-" ++ show (length entries) ++ "/"
185199 let fname = dirname ++ "content.xml"
186200 let entry = toEntry fname epochtime (fromStringLazy mathml)
187− P.modifyIORef entriesRef (entry:)
201+ modify $ \st -> st{ stEntries = entry : entries }
188202 return $ RawInline (Format "opendocument") $ render Nothing $
189203 inTags False "draw:frame" [("text:anchor-type",
190204 if t == DisplayMath
@@ -197,4 +211,4 @@ transformPicMath _ entriesRef (Math t math) = do
197211 , ("xlink:show", "embed")
198212 , ("xlink:actuate", "onLoad")]
199213
200−transformPicMath _ _ x = return x
214+transformPicMath _ x = return x