aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs62
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