Remove IORef from ODT writer.

We want pure writers, so IORef shouldn't be in there. We switch to using
a normal State Monad. If this produces performance problems, we can look
into trying STRefs, but that seems like unnecessary complication at the
moment.

1 files changed, 38 insertions, 24 deletions

diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 0f1dd7cd3..b139695db 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -29,7 +29,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Conversion of 'Pandoc' documents to ODT.
 -}
 module Text.Pandoc.Writers.ODT ( writeODTPure, writeODT ) where
-import Data.IORef
 import Data.List ( isPrefixOf )
 import Data.Maybe ( fromMaybe )
 import Text.XML.Light.Output
@@ -46,6 +45,7 @@ import Text.Pandoc.Walk
 import Text.Pandoc.Writers.Shared ( fixDisplayMath )
 import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
 import Control.Monad (liftM)
+import Control.Monad.State
 import Text.Pandoc.XML
 import Text.Pandoc.Pretty
 import qualified Control.Exception as E
@@ -55,31 +55,45 @@ import qualified Text.Pandoc.Free as P
 
 type ODTAction = PandocAction [Entry]
 
+data ODTState = ODTState { stEntries :: [Entry]
+                         }
+
+type O = StateT ODTState ODTAction
+
 -- | Produce an ODT file from a Pandoc document.
 writeODT :: WriterOptions  -- ^ Writer options
          -> Pandoc         -- ^ Document to convert
          -> IO B.ByteString
 writeODT opts doc = runIO $ writeODTPure opts doc
 
--- | Produce an ODT file from a Pandoc document.
-writeODTPure :: WriterOptions  -- ^ Writer options
-             -> Pandoc         -- ^ Document to convert
+writeODTPure :: WriterOptions
+             -> Pandoc
              -> ODTAction B.ByteString
-writeODTPure opts doc@(Pandoc meta _) = do
+writeODTPure opts doc =
+  let initState = ODTState{ stEntries = []
+                          }
+  in
+    evalStateT (pandocToODT opts doc) initState
+
+-- | Produce an ODT file from a Pandoc document.
+pandocToODT :: WriterOptions  -- ^ Writer options
+            -> Pandoc         -- ^ Document to convert
+            -> O B.ByteString
+pandocToODT opts doc@(Pandoc meta _) = do
   let datadir = writerUserDataDir opts
   let title = docTitle meta
   refArchive <-
        case writerReferenceODT opts of
-             Just f -> liftM toArchive $ P.readFileLazy f
-             Nothing -> P.getDefaultReferenceODT datadir
+             Just f -> liftM toArchive $ lift $ P.readFileLazy f
+             Nothing -> lift $ P.getDefaultReferenceODT datadir
   -- handle formulas and pictures
-  picEntriesRef <- P.newIORef ([] :: [Entry])
-  doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc
+  -- picEntriesRef <- P.newIORef ([] :: [Entry])
+  doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc
   let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc'
-  epochtime <- floor `fmap` P.getPOSIXTime
+  epochtime <- floor `fmap` (lift P.getPOSIXTime)
   let contentEntry = toEntry "content.xml" epochtime
                      $ fromStringLazy newContents
-  picEntries <- P.readIORef picEntriesRef
+  picEntries <- gets stEntries
   let archive = foldr addEntryToArchive refArchive
                 $ contentEntry : picEntries
   -- construct META-INF/manifest.xml based on archive
@@ -134,18 +148,18 @@ writeODTPure opts doc@(Pandoc meta _) = do
   return $ fromArchive archive''
 
 -- | transform both Image and Math elements
-transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> ODTAction Inline
-transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do
-  res <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
+transformPicMath :: WriterOptions ->Inline -> O Inline
+transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do
+  res <- lift $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
   case res of
      Left (_ :: E.SomeException) -> do
-       P.warn $ "Could not find image `" ++ src ++ "', skipping..."
+       lift $ P.warn $ "Could not find image `" ++ src ++ "', skipping..."
        return $ Emph lab
      Right (img, mbMimeType) -> do
        (ptX, ptY) <- case imageSize img of
                        Right s  -> return $ sizeInPoints s
                        Left msg -> do
-                         P.warn $ "Could not determine image size in `" ++
+                         lift $ P.warn $ "Could not determine image size in `" ++
                            src ++ "': " ++ msg
                          return (100, 100)
        let dims =
@@ -163,28 +177,28 @@ transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do
                               Just dim         -> Just $ Inch $ inInch opts dim
                               Nothing          -> Nothing
        let  newattr = (id', cls, dims)
-       entries <- P.readIORef entriesRef
+       entries <- gets stEntries
        let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)
                            (mbMimeType >>= extensionFromMimeType)
        let newsrc = "Pictures/" ++ show (length entries) <.> extension
        let toLazy = B.fromChunks . (:[])
-       epochtime <- floor `fmap` P.getPOSIXTime
+       epochtime <- floor `fmap` (lift P.getPOSIXTime)
        let entry = toEntry newsrc epochtime $ toLazy img
-       P.modifyIORef entriesRef (entry:)
+       modify $ \st -> st{ stEntries = entry : entries }
        return $ Image newattr lab (newsrc, t)
-transformPicMath _ entriesRef (Math t math) = do
-  entries <- P.readIORef entriesRef
+transformPicMath _ (Math t math) = do
+  entries <- gets stEntries
   let dt = if t == InlineMath then DisplayInline else DisplayBlock
   case writeMathML dt <$> readTeX math of
        Left  _ -> return $ Math t math
        Right r -> do
          let conf = useShortEmptyTags (const False) defaultConfigPP
          let mathml = ppcTopElement conf r
-         epochtime <- floor `fmap` P.getPOSIXTime
+         epochtime <- floor `fmap` (lift $ P.getPOSIXTime)
          let dirname = "Formula-" ++ show (length entries) ++ "/"
          let fname = dirname ++ "content.xml"
          let entry = toEntry fname epochtime (fromStringLazy mathml)
-         P.modifyIORef entriesRef (entry:)
+         modify $ \st -> st{ stEntries = entry : entries }
          return $ RawInline (Format "opendocument") $ render Nothing $
            inTags False "draw:frame" [("text:anchor-type",
                                        if t == DisplayMath
@@ -197,4 +211,4 @@ transformPicMath _ entriesRef (Math t math) = do
                                         , ("xlink:show", "embed")
                                         , ("xlink:actuate", "onLoad")]
 
-transformPicMath _ _ x = return x
+transformPicMath _ x = return x