aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs66
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs81
-rw-r--r--src/Text/Pandoc/Writers/ICML.hs19
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs48
4 files changed, 124 insertions, 90 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index d425bbbca..cecee7e9e 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, PatternGuards, ViewPatterns #-}
+{-# LANGUAGE ScopedTypeVariables, PatternGuards, ViewPatterns, DeriveFunctor #-}
{-
Copyright (C) 2012-2015 John MacFarlane <jgm@berkeley.edu>
@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of 'Pandoc' documents to docx.
-}
-module Text.Pandoc.Writers.Docx ( writeDocx ) where
+module Text.Pandoc.Writers.Docx ( writeDocx, writeDocxPure ) where
import Data.List ( intercalate, isPrefixOf, isSuffixOf )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
@@ -38,7 +38,6 @@ import qualified Data.Set as Set
import qualified Text.Pandoc.UTF8 as UTF8
import Codec.Archive.Zip
import Data.Time.Clock.POSIX
-import System.Environment
import Text.Pandoc.Compat.Time
import Text.Pandoc.Definition
import Text.Pandoc.Generic
@@ -57,7 +56,7 @@ import Control.Monad.Reader
import Control.Monad.State
import Skylighting
import Data.Unique (hashUnique, newUnique)
-import System.Random (randomRIO)
+import System.Random (randomR)
import Text.Printf (printf)
import qualified Control.Exception as E
import Data.Monoid ((<>))
@@ -67,6 +66,10 @@ import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
import Control.Applicative ((<|>))
import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing)
import Data.Char (ord, isSpace, toLower)
+import Text.Pandoc.Free (PandocAction, runIO)
+import qualified Text.Pandoc.Free as P
+
+type DocxAction = PandocAction ()
data ListMarker = NoMarker
| BulletMarker
@@ -146,7 +149,7 @@ defaultWriterState = WriterState{
, stDynamicTextProps = []
}
-type WS = ReaderT WriterEnv (StateT WriterState IO)
+type WS = ReaderT WriterEnv (StateT WriterState (DocxAction))
mknode :: Node t => String -> [(String,String)] -> t -> Element
mknode s attrs =
@@ -213,19 +216,27 @@ metaValueToInlines (MetaBlocks bs) = query return bs
metaValueToInlines (MetaBool b) = [Str $ show b]
metaValueToInlines _ = []
--- | Produce an Docx file from a Pandoc document.
+
+
writeDocx :: WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert
-> IO BL.ByteString
-writeDocx opts doc@(Pandoc meta _) = do
+writeDocx opts doc = runIO $ writeDocxPure opts doc
+
+
+-- | Produce an Docx file from a Pandoc document.
+writeDocxPure :: WriterOptions -- ^ Writer options
+ -> Pandoc -- ^ Document to convert
+ -> DocxAction BL.ByteString
+writeDocxPure opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts
let doc' = walk fixDisplayMath $ doc
- username <- lookup "USERNAME" <$> getEnvironment
- utctime <- getCurrentTime
- distArchive <- getDefaultReferenceDocx datadir
+ username <- P.lookupEnv "USERNAME"
+ utctime <- P.getCurrentTime
+ distArchive <- P.getDefaultReferenceDocx datadir
refArchive <- case writerReferenceDocx opts of
- Just f -> liftM (toArchive . toLazy) $ B.readFile f
- Nothing -> getDefaultReferenceDocx datadir
+ Just f -> liftM (toArchive . toLazy) $ P.readFileStrict f
+ Nothing -> P.getDefaultReferenceDocx datadir
parsedDoc <- parseXml refArchive distArchive "word/document.xml"
let wname f qn = qPrefix qn == Just "w" && f (qName qn)
@@ -603,7 +614,7 @@ styleToOpenXml sm style =
$ backgroundColor style )
]
-copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> IO Entry
+copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> DocxAction Entry
copyChildren refArchive distArchive path timestamp elNames = do
ref <- parseXml refArchive distArchive path
dist <- parseXml distArchive distArchive path
@@ -622,7 +633,7 @@ copyChildren refArchive distArchive path timestamp elNames = do
baseListId :: Int
baseListId = 1000
-mkNumbering :: [ListMarker] -> IO [Element]
+mkNumbering :: [ListMarker] -> DocxAction [Element]
mkNumbering lists = do
elts <- mapM mkAbstractNum (ordNub lists)
return $ elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)]
@@ -638,9 +649,10 @@ mkNum marker numid =
map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))]
$ mknode "w:startOverride" [("w:val",show start)] ()) [0..6]
-mkAbstractNum :: ListMarker -> IO Element
+mkAbstractNum :: ListMarker -> DocxAction Element
mkAbstractNum marker = do
- nsid <- randomRIO (0x10000000 :: Integer, 0xFFFFFFFF :: Integer)
+ gen <- P.newStdGen
+ let (nsid, _) = randomR (0x10000000 :: Integer, 0xFFFFFFFF :: Integer) gen
return $ mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)]
$ mknode "w:nsid" [("w:val", printf "%8x" nsid)] ()
: mknode "w:multiLevelType" [("w:val","multilevel")] ()
@@ -695,6 +707,7 @@ mkLvl marker lvl =
getNumId :: WS Int
getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists
+
makeTOC :: WriterOptions -> WS [Element]
makeTOC opts | writerTableOfContents opts = do
let depth = "1-"++(show (writerTOCDepth opts))
@@ -781,10 +794,10 @@ rStyleM styleName = do
let sty' = getStyleId styleName $ sCharStyleMap styleMaps
return $ mknode "w:rStyle" [("w:val",sty')] ()
-getUniqueId :: MonadIO m => m String
+getUniqueId :: DocxAction String
-- the + 20 is to ensure that there are no clashes with the rIds
-- already in word/document.xml.rel
-getUniqueId = liftIO $ (show . (+ 20) . hashUnique) `fmap` newUnique
+getUniqueId = (show . (+ 20) . hashUnique) <$> P.newUnique
-- | Key for specifying user-defined docx styles.
dynamicStyleKey :: String
@@ -825,7 +838,7 @@ blockToOpenXML' opts (Header lev (ident,_,_) lst) = do
then uniqueIdent lst usedIdents
else ident
modify $ \s -> s{ stSectionIds = Set.insert bookmarkName $ stSectionIds s }
- id' <- getUniqueId
+ id' <- (lift . lift) getUniqueId
let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')
,("w:name",bookmarkName)] ()
let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()
@@ -1137,7 +1150,7 @@ inlineToOpenXML' opts (Code attrs str) = do
else unhighlighted
inlineToOpenXML' opts (Note bs) = do
notes <- gets stFootnotes
- notenum <- getUniqueId
+ notenum <- (lift . lift) getUniqueId
footnoteStyle <- rStyleM "Footnote Reference"
let notemarker = mknode "w:r" []
[ mknode "w:rPr" [] footnoteStyle
@@ -1168,7 +1181,7 @@ inlineToOpenXML' opts (Link _ txt (src,_)) = do
id' <- case M.lookup src extlinks of
Just i -> return i
Nothing -> do
- i <- ("rId"++) `fmap` getUniqueId
+ i <- ("rId"++) `fmap` ((lift . lift) getUniqueId)
modify $ \st -> st{ stExternalLinks =
M.insert src i extlinks }
return i
@@ -1180,15 +1193,14 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do
case M.lookup src imgs of
Just (_,_,_,elt,_) -> return [elt]
Nothing -> do
- res <- liftIO $
- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
+ res <- (lift . lift) $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
case res of
Left (_ :: E.SomeException) -> do
- warn $ "Could not find image `" ++ src ++ "', skipping..."
+ (lift . lift) $ P.warn ("Could not find image `" ++ src ++ "', skipping...")
-- emit alt text
inlinesToOpenXML opts alt
Right (img, mt) -> do
- ident <- ("rId"++) `fmap` getUniqueId
+ ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId)
let (xpt,ypt) = desiredSizeInPoints opts attr
(either (const def) id (imageSize img))
-- 12700 emu = 1 pt
@@ -1272,13 +1284,13 @@ defaultFootnotes = [ mknode "w:footnote"
[ mknode "w:r" [] $
[ mknode "w:continuationSeparator" [] ()]]]]
-parseXml :: Archive -> Archive -> String -> IO Element
+parseXml :: Archive -> Archive -> String -> DocxAction Element
parseXml refArchive distArchive relpath =
case findEntryByPath relpath refArchive `mplus`
findEntryByPath relpath distArchive of
Nothing -> fail $ relpath ++ " missing in reference docx"
Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of
- Nothing -> fail $ relpath ++ " corrupt in reference docx"
+ Nothing -> P.fail $ relpath ++ " corrupt in reference docx"
Just d -> return d
-- | Scales the image to fit the page
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 00bf4a81c..4a93d52e2 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -28,26 +28,23 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of 'Pandoc' documents to EPUB.
-}
-module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
-import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )
+module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where
+import Data.IORef ( IORef )
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Maybe ( fromMaybe, catMaybes )
import Data.List ( isPrefixOf, isInfixOf, intercalate )
-import System.Environment ( getEnv )
import Text.Printf (printf)
import System.FilePath ( takeExtension, takeFileName )
-import System.FilePath.Glob ( namesMatching )
import Network.HTTP ( urlEncode )
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Text.Pandoc.UTF8 as UTF8
import Codec.Archive.Zip ( emptyArchive, addEntryToArchive, eRelativePath, fromEntry , Entry, toEntry, fromArchive)
-import Data.Time.Clock.POSIX ( getPOSIXTime )
import Text.Pandoc.Compat.Time
import Text.Pandoc.Shared ( renderTags', safeRead, uniqueIdent, trim
- , normalizeDate, readDataFile, stringify, warn
- , hierarchicalize, fetchItem' )
+ , normalizeDate, stringify
+ , hierarchicalize )
import qualified Text.Pandoc.Shared as S (Element(..))
import Text.Pandoc.Builder (fromList, setMeta)
import Text.Pandoc.Options ( WriterOptions(..)
@@ -58,17 +55,19 @@ import Text.Pandoc.Options ( WriterOptions(..)
import Text.Pandoc.Definition
import Text.Pandoc.Walk (walk, walkM, query)
import Control.Monad.State (modify, get, State, put, evalState)
-import Control.Monad (mplus, liftM, when)
+import Control.Monad (mplus, when)
import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
, strContent, lookupAttr, Node(..), QName(..), parseXML
, onlyElems, node, ppElement)
-import Text.Pandoc.UUID (getRandomUUID)
import Text.Pandoc.Writers.HTML ( writeHtml )
import Data.Char ( toLower, isDigit, isAlphaNum )
import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
-import qualified Control.Exception as E
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
+import Text.Pandoc.Free (PandocAction, runIO)
+import qualified Text.Pandoc.Free as P
+
+type EPUBAction = PandocAction [(FilePath, (FilePath, Maybe Entry))]
-- A Chapter includes a list of blocks and maybe a section
-- number offset. Note, some chapters are unnumbered. The section
@@ -143,7 +142,7 @@ removeNote :: Inline -> Inline
removeNote (Note _) = Str ""
removeNote x = x
-getEPUBMetadata :: WriterOptions -> Meta -> IO EPUBMetadata
+getEPUBMetadata :: WriterOptions -> Meta -> EPUBAction EPUBMetadata
getEPUBMetadata opts meta = do
let md = metadataFromMeta opts meta
let elts = onlyElems $ parseXML $ writerEpubMetadata opts
@@ -151,7 +150,7 @@ getEPUBMetadata opts meta = do
let addIdentifier m =
if null (epubIdentifier m)
then do
- randomId <- fmap show getRandomUUID
+ randomId <- fmap show P.newUUID
return $ m{ epubIdentifier = [Identifier randomId Nothing] }
else return m
let addLanguage m =
@@ -159,16 +158,19 @@ getEPUBMetadata opts meta = do
then case lookup "lang" (writerVariables opts) of
Just x -> return m{ epubLanguage = x }
Nothing -> do
- localeLang <- E.catch (liftM
- (map (\c -> if c == '_' then '-' else c) .
- takeWhile (/='.')) $ getEnv "LANG")
- (\e -> let _ = (e :: E.SomeException) in return "en-US")
+ mLang <- P.lookupEnv "LANG"
+ let localeLang =
+ case mLang of
+ Just lang ->
+ map (\c -> if c == '_' then '-' else c) $
+ takeWhile (/='.') lang
+ Nothing -> "en-US"
return m{ epubLanguage = localeLang }
else return m
let fixDate m =
if null (epubDate m)
then do
- currentTime <- getCurrentTime
+ currentTime <- P.getCurrentTime
return $ m{ epubDate = [ Date{
dateText = showDateTimeISO8601 currentTime
, dateEvent = Nothing } ] }
@@ -333,10 +335,15 @@ metadataFromMeta opts meta = EPUBMetadata{
writeEPUB :: WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert
-> IO B.ByteString
-writeEPUB opts doc@(Pandoc meta _) = do
+writeEPUB opts doc = runIO $ writeEPUBPure opts doc
+
+writeEPUBPure :: WriterOptions -- ^ Writer options
+ -> Pandoc -- ^ Document to convert
+ -> EPUBAction B.ByteString
+writeEPUBPure opts doc@(Pandoc meta _) = do
let version = fromMaybe EPUB2 (writerEpubVersion opts)
let epub3 = version == EPUB3
- epochtime <- floor `fmap` getPOSIXTime
+ epochtime <- floor <$> P.getPOSIXTime
let mkEntry path content = toEntry path epochtime content
let vars = ("epub3", if epub3 then "true" else "false")
: ("css", "stylesheet.css")
@@ -361,7 +368,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
let cpContent = renderHtml $ writeHtml
opts'{ writerVariables = ("coverpage","true"):vars }
(Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
- imgContent <- B.readFile img
+ imgContent <- P.readFileLazy img
return ( [mkEntry "cover.xhtml" cpContent]
, [mkEntry coverImage imgContent] )
@@ -372,18 +379,18 @@ writeEPUB opts doc@(Pandoc meta _) = do
let tpEntry = mkEntry "title_page.xhtml" tpContent
-- handle pictures
- mediaRef <- newIORef []
+ mediaRef <- P.newIORef []
Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=
walkM (transformBlock opts' mediaRef)
- picEntries <- (catMaybes . map (snd . snd)) <$> readIORef mediaRef
+ picEntries <- (catMaybes . map (snd . snd)) <$> P.readIORef mediaRef
-- handle fonts
let matchingGlob f = do
- xs <- namesMatching f
+ xs <- P.namesMatching f
when (null xs) $
- warn $ f ++ " did not match any font files."
+ P.warn $ f ++ " did not match any font files."
return xs
- let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f
+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` P.readFileLazy f
fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
fontEntries <- mapM mkFontEntry fontFiles
@@ -520,7 +527,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
let uuid = case epubIdentifier metadata of
(x:_) -> identifierText x -- use first identifier as UUID
[] -> error "epubIdentifier is null" -- shouldn't happen
- currentTime <- getCurrentTime
+ currentTime <- P.getCurrentTime
let contentsData = UTF8.fromStringLazy $ ppTopElement $
unode "package" ! [("version", case version of
EPUB2 -> "2.0"
@@ -692,10 +699,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
-- stylesheet
stylesheet <- case epubStylesheet metadata of
- Just (StylesheetPath fp) -> UTF8.readFile fp
+ Just (StylesheetPath fp) -> P.readFileUTF8 fp
Just (StylesheetContents s) -> return s
Nothing -> UTF8.toString `fmap`
- readDataFile (writerUserDataDir opts) "epub.css"
+ P.readDataFile (writerUserDataDir opts) "epub.css"
let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet
-- construct archive
@@ -814,7 +821,7 @@ showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
transformTag :: WriterOptions
-> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
-> Tag String
- -> IO (Tag String)
+ -> EPUBAction (Tag String)
transformTag opts mediaRef tag@(TagOpen name attr)
| name `elem` ["video", "source", "img", "audio"] &&
lookup "data-external" attr == Nothing = do
@@ -831,34 +838,34 @@ transformTag _ _ tag = return tag
modifyMediaRef :: WriterOptions
-> IORef [(FilePath, (FilePath, Maybe Entry))]
-> FilePath
- -> IO FilePath
+ -> EPUBAction FilePath
modifyMediaRef _ _ "" = return ""
modifyMediaRef opts mediaRef oldsrc = do
- media <- readIORef mediaRef
+ media <- P.readIORef mediaRef
case lookup oldsrc media of
Just (n,_) -> return n
Nothing -> do
- res <- fetchItem' (writerMediaBag opts)
+ res <- P.fetchItem' (writerMediaBag opts)
(writerSourceURL opts) oldsrc
(new, mbEntry) <-
case res of
Left _ -> do
- warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
+ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
return (oldsrc, Nothing)
Right (img,mbMime) -> do
let new = "media/file" ++ show (length media) ++
fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
(('.':) <$> (mbMime >>= extensionFromMimeType))
- epochtime <- floor `fmap` getPOSIXTime
+ epochtime <- floor `fmap` P.getPOSIXTime
let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img
return (new, Just entry)
- modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
+ P.modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )
return new
transformBlock :: WriterOptions
-> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
-> Block
- -> IO Block
+ -> EPUBAction Block
transformBlock opts mediaRef (RawBlock fmt raw)
| fmt == Format "html" = do
let tags = parseTags raw
@@ -869,7 +876,7 @@ transformBlock _ _ b = return b
transformInline :: WriterOptions
-> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
-> Inline
- -> IO Inline
+ -> EPUBAction Inline
transformInline opts mediaRef (Image attr lab (src,tit)) = do
newsrc <- modifyMediaRef opts mediaRef src
return $ Image attr lab (newsrc, tit)
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index e2c123fc2..3a1e772ce 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -18,7 +18,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.XML
import Text.Pandoc.Readers.TeXMath (texMathToInlines)
import Text.Pandoc.Writers.Shared
-import Text.Pandoc.Shared (linesToPara, splitBy, fetchItem, warn)
+import Text.Pandoc.Shared (linesToPara, splitBy, warn)
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Pretty
@@ -28,6 +28,10 @@ import Data.Text as Text (breakOnAll, pack)
import Control.Monad.State
import Network.URI (isURI)
import qualified Data.Set as Set
+import Text.Pandoc.Free (runIO)
+import qualified Text.Pandoc.Free as P
+
+type ICMLAction = P.PandocAction ()
type Style = [String]
type Hyperlink = [(Int, String)]
@@ -40,7 +44,7 @@ data WriterState = WriterState{
, maxListDepth :: Int
}
-type WS a = StateT WriterState IO a
+type WS a = StateT WriterState ICMLAction a
defaultWriterState :: WriterState
defaultWriterState = WriterState{
@@ -121,10 +125,13 @@ subListParName = "subParagraph"
footnoteName = "Footnote"
citeName = "Cite"
-
-- | Convert Pandoc document to string in ICML format.
writeICML :: WriterOptions -> Pandoc -> IO String
-writeICML opts (Pandoc meta blocks) = do
+writeICML opts doc = runIO $ writeICMLPure opts doc
+
+-- | Convert Pandoc document to string in ICML format.
+writeICMLPure :: WriterOptions -> Pandoc -> ICMLAction String
+writeICMLPure opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
@@ -532,10 +539,10 @@ styleToStrAttr style =
-- | Assemble an ICML Image.
imageICML :: WriterOptions -> Style -> Attr -> Target -> WS Doc
imageICML opts style attr (src, _) = do
- res <- liftIO $ fetchItem (writerSourceURL opts) src
+ res <- lift $ P.fetchItem (writerSourceURL opts) src
imgS <- case res of
Left (_) -> do
- warn $ "Could not find image `" ++ src ++ "', skipping..."
+ lift $ P.warn $ "Could not find image `" ++ src ++ "', skipping..."
return def
Right (img, _) -> do
case imageSize img of
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index ce4d456a3..0f1dd7cd3 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of 'Pandoc' documents to ODT.
-}
-module Text.Pandoc.Writers.ODT ( writeODT ) where
+module Text.Pandoc.Writers.ODT ( writeODTPure, writeODT ) where
import Data.IORef
import Data.List ( isPrefixOf )
import Data.Maybe ( fromMaybe )
@@ -38,8 +38,7 @@ import qualified Data.ByteString.Lazy as B
import Text.Pandoc.UTF8 ( fromStringLazy )
import Codec.Archive.Zip
import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) )
-import Text.Pandoc.Shared ( stringify, fetchItem', warn,
- getDefaultReferenceODT )
+import Text.Pandoc.Shared ( stringify )
import Text.Pandoc.ImageSize
import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType )
import Text.Pandoc.Definition
@@ -50,28 +49,37 @@ import Control.Monad (liftM)
import Text.Pandoc.XML
import Text.Pandoc.Pretty
import qualified Control.Exception as E
-import Data.Time.Clock.POSIX ( getPOSIXTime )
import System.FilePath ( takeExtension, takeDirectory, (<.>))
+import Text.Pandoc.Free ( PandocAction, runIO )
+import qualified Text.Pandoc.Free as P
+
+type ODTAction = PandocAction [Entry]
-- | Produce an ODT file from a Pandoc document.
writeODT :: WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert
-> IO B.ByteString
-writeODT opts doc@(Pandoc meta _) = do
+writeODT opts doc = runIO $ writeODTPure opts doc
+
+-- | Produce an ODT file from a Pandoc document.
+writeODTPure :: WriterOptions -- ^ Writer options
+ -> Pandoc -- ^ Document to convert
+ -> ODTAction B.ByteString
+writeODTPure opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts
let title = docTitle meta
refArchive <-
case writerReferenceODT opts of
- Just f -> liftM toArchive $ B.readFile f
- Nothing -> getDefaultReferenceODT datadir
+ Just f -> liftM toArchive $ P.readFileLazy f
+ Nothing -> P.getDefaultReferenceODT datadir
-- handle formulas and pictures
- picEntriesRef <- newIORef ([] :: [Entry])
+ picEntriesRef <- P.newIORef ([] :: [Entry])
doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc
let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc'
- epochtime <- floor `fmap` getPOSIXTime
+ epochtime <- floor `fmap` P.getPOSIXTime
let contentEntry = toEntry "content.xml" epochtime
$ fromStringLazy newContents
- picEntries <- readIORef picEntriesRef
+ picEntries <- P.readIORef picEntriesRef
let archive = foldr addEntryToArchive refArchive
$ contentEntry : picEntries
-- construct META-INF/manifest.xml based on archive
@@ -126,18 +134,18 @@ writeODT opts doc@(Pandoc meta _) = do
return $ fromArchive archive''
-- | transform both Image and Math elements
-transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline
+transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> ODTAction Inline
transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do
- res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
+ res <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
case res of
Left (_ :: E.SomeException) -> do
- warn $ "Could not find image `" ++ src ++ "', skipping..."
+ 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
- warn $ "Could not determine image size in `" ++
+ P.warn $ "Could not determine image size in `" ++
src ++ "': " ++ msg
return (100, 100)
let dims =
@@ -155,28 +163,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 <- readIORef entriesRef
+ entries <- P.readIORef entriesRef
let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)
(mbMimeType >>= extensionFromMimeType)
let newsrc = "Pictures/" ++ show (length entries) <.> extension
let toLazy = B.fromChunks . (:[])
- epochtime <- floor `fmap` getPOSIXTime
+ epochtime <- floor `fmap` P.getPOSIXTime
let entry = toEntry newsrc epochtime $ toLazy img
- modifyIORef entriesRef (entry:)
+ P.modifyIORef entriesRef (entry:)
return $ Image newattr lab (newsrc, t)
transformPicMath _ entriesRef (Math t math) = do
- entries <- readIORef entriesRef
+ entries <- P.readIORef entriesRef
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` getPOSIXTime
+ epochtime <- floor `fmap` P.getPOSIXTime
let dirname = "Formula-" ++ show (length entries) ++ "/"
let fname = dirname ++ "content.xml"
let entry = toEntry fname epochtime (fromStringLazy mathml)
- modifyIORef entriesRef (entry:)
+ P.modifyIORef entriesRef (entry:)
return $ RawInline (Format "opendocument") $ render Nothing $
inTags False "draw:frame" [("text:anchor-type",
if t == DisplayMath
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-14 22:49:57 +0000