diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 62 |
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 |