aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2016-09-24 17:52:25 -0400
committerJohn MacFarlane <jgm@berkeley.edu>2017-01-25 17:07:39 +0100
commit32c68dada92eb142949c5be5224a3ddf20fcf484 (patch)
tree41ba1aaf202d0f6093218ab1ceadaf3b159c5a83 /src/Text
parent0ab4af2f03f4226714a39c959c161def679d9d57 (diff)
downloadpandoc-32c68dada92eb142949c5be5224a3ddf20fcf484.tar.gz
Introduce pure versions of IO Writers.
Using Text.Pandoc.Free, introduce pure versions of Docx, EPUB, ICML, and ODT writers. Each of the pure versions is exported along with the IO version (produced by running `runIO` on the pure reader). Ideally, this should make the writers easier to test.
Diffstat (limited to 'src/Text')
-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