32c68da · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Introduce pure versions of IO Writers.

32c68daJesse Rosenthal10 years ago

src/Text/Pandoc/Writers/Docx.hs+39−27

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−{-# LANGUAGE ScopedTypeVariables, PatternGuards, ViewPatterns #-}

1+{-# LANGUAGE ScopedTypeVariables, PatternGuards, ViewPatterns, DeriveFunctor #-}

2{-

@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

29Conversion of 'Pandoc' documents to docx.

30-}

31−module Text.Pandoc.Writers.Docx ( writeDocx ) where

31+module Text.Pandoc.Writers.Docx ( writeDocx, writeDocxPure ) where

32import Data.List ( intercalate, isPrefixOf, isSuffixOf )

33import qualified Data.ByteString as B

34import qualified Data.ByteString.Lazy as BL

@@ -38,7 +38,6 @@ import qualified Data.Set as Set

38import qualified Text.Pandoc.UTF8 as UTF8

39import Codec.Archive.Zip

40import Data.Time.Clock.POSIX

41−import System.Environment

42import Text.Pandoc.Compat.Time

41import Text.Pandoc.Compat.Time

43import Text.Pandoc.Definition

42import Text.Pandoc.Definition

44import Text.Pandoc.Generic

43import Text.Pandoc.Generic

@@ -57,7 +56,7 @@ import Control.Monad.Reader

57import Control.Monad.State

56import Control.Monad.State

58import Skylighting

57import Skylighting

59import Data.Unique (hashUnique, newUnique)

58import Data.Unique (hashUnique, newUnique)

60−import System.Random (randomRIO)

59+import System.Random (randomR)

61import Text.Printf (printf)

60import Text.Printf (printf)

62import qualified Control.Exception as E

61import qualified Control.Exception as E

63import Data.Monoid ((<>))

62import Data.Monoid ((<>))

@@ -67,6 +66,10 @@ import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,

67import Control.Applicative ((<|>))

66import Control.Applicative ((<|>))

68import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing)

67import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing)

69import Data.Char (ord, isSpace, toLower)

68import Data.Char (ord, isSpace, toLower)

69+import Text.Pandoc.Free (PandocAction, runIO)

70+import qualified Text.Pandoc.Free as P

71+

72+type DocxAction = PandocAction ()

71data ListMarker = NoMarker

74data ListMarker = NoMarker

72 | BulletMarker

75 | BulletMarker

@@ -146,7 +149,7 @@ defaultWriterState = WriterState{

146 , stDynamicTextProps = []

149 , stDynamicTextProps = []

147 }

150 }

148

151

149−type WS = ReaderT WriterEnv (StateT WriterState IO)

152+type WS = ReaderT WriterEnv (StateT WriterState (DocxAction))

150

153

151mknode :: Node t => String -> [(String,String)] -> t -> Element

154mknode :: Node t => String -> [(String,String)] -> t -> Element

152mknode s attrs =

155mknode s attrs =

@@ -213,19 +216,27 @@ metaValueToInlines (MetaBlocks bs) = query return bs

213metaValueToInlines (MetaBool b) = [Str $ show b]

216metaValueToInlines (MetaBool b) = [Str $ show b]

214metaValueToInlines _ = []

217metaValueToInlines _ = []

215

218

216−-- | Produce an Docx file from a Pandoc document.

219+

220+

217writeDocx :: WriterOptions -- ^ Writer options

221writeDocx :: WriterOptions -- ^ Writer options

218 -> Pandoc -- ^ Document to convert

222 -> Pandoc -- ^ Document to convert

219 -> IO BL.ByteString

223 -> IO BL.ByteString

220−writeDocx opts doc@(Pandoc meta _) = do

224+writeDocx opts doc = runIO $ writeDocxPure opts doc

225+

226+

227+-- | Produce an Docx file from a Pandoc document.

228+writeDocxPure :: WriterOptions -- ^ Writer options

229+ -> Pandoc -- ^ Document to convert

230+ -> DocxAction BL.ByteString

231+writeDocxPure opts doc@(Pandoc meta _) = do

221 let datadir = writerUserDataDir opts

232 let datadir = writerUserDataDir opts

222 let doc' = walk fixDisplayMath $ doc

233 let doc' = walk fixDisplayMath $ doc

223− username <- lookup "USERNAME" <$> getEnvironment

234+ username <- P.lookupEnv "USERNAME"

224− utctime <- getCurrentTime

235+ utctime <- P.getCurrentTime

225− distArchive <- getDefaultReferenceDocx datadir

236+ distArchive <- P.getDefaultReferenceDocx datadir

226 refArchive <- case writerReferenceDocx opts of

237 refArchive <- case writerReferenceDocx opts of

227− Just f -> liftM (toArchive . toLazy) $ B.readFile f

238+ Just f -> liftM (toArchive . toLazy) $ P.readFileStrict f

228− Nothing -> getDefaultReferenceDocx datadir

239+ Nothing -> P.getDefaultReferenceDocx datadir

229

240

230 parsedDoc <- parseXml refArchive distArchive "word/document.xml"

241 parsedDoc <- parseXml refArchive distArchive "word/document.xml"

231 let wname f qn = qPrefix qn == Just "w" && f (qName qn)

242 let wname f qn = qPrefix qn == Just "w" && f (qName qn)

@@ -603,7 +614,7 @@ styleToOpenXml sm style =

603 $ backgroundColor style )

614 $ backgroundColor style )

604 ]

615 ]

605

616

606−copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> IO Entry

617+copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> DocxAction Entry

607copyChildren refArchive distArchive path timestamp elNames = do

618copyChildren refArchive distArchive path timestamp elNames = do

608 ref <- parseXml refArchive distArchive path

619 ref <- parseXml refArchive distArchive path

609 dist <- parseXml distArchive distArchive path

620 dist <- parseXml distArchive distArchive path

@@ -622,7 +633,7 @@ copyChildren refArchive distArchive path timestamp elNames = do

622baseListId :: Int

633baseListId :: Int

623baseListId = 1000

634baseListId = 1000

624

635

625−mkNumbering :: [ListMarker] -> IO [Element]

636+mkNumbering :: [ListMarker] -> DocxAction [Element]

626mkNumbering lists = do

637mkNumbering lists = do

627 elts <- mapM mkAbstractNum (ordNub lists)

638 elts <- mapM mkAbstractNum (ordNub lists)

628 return $ elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)]

639 return $ elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)]

@@ -638,9 +649,10 @@ mkNum marker numid =

638 map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))]

649 map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))]

639 $ mknode "w:startOverride" [("w:val",show start)] ()) [0..6]

650 $ mknode "w:startOverride" [("w:val",show start)] ()) [0..6]

640

651

641−mkAbstractNum :: ListMarker -> IO Element

652+mkAbstractNum :: ListMarker -> DocxAction Element

642mkAbstractNum marker = do

653mkAbstractNum marker = do

654+ gen <- P.newStdGen

643− nsid <- randomRIO (0x10000000 :: Integer, 0xFFFFFFFF :: Integer)

655+ let (nsid, _) = randomR (0x10000000 :: Integer, 0xFFFFFFFF :: Integer) gen

644 return $ mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)]

656 return $ mknode "w:abstractNum" [("w:abstractNumId",listMarkerToId marker)]

645 $ mknode "w:nsid" [("w:val", printf "%8x" nsid)] ()

657 $ mknode "w:nsid" [("w:val", printf "%8x" nsid)] ()

646 : mknode "w:multiLevelType" [("w:val","multilevel")] ()

658 : mknode "w:multiLevelType" [("w:val","multilevel")] ()

@@ -695,6 +707,7 @@ mkLvl marker lvl =

695getNumId :: WS Int

707getNumId :: WS Int

696getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists

708getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists

697

709

710+

698makeTOC :: WriterOptions -> WS [Element]

711makeTOC :: WriterOptions -> WS [Element]

699makeTOC opts | writerTableOfContents opts = do

712makeTOC opts | writerTableOfContents opts = do

700 let depth = "1-"++(show (writerTOCDepth opts))

713 let depth = "1-"++(show (writerTOCDepth opts))

@@ -781,10 +794,10 @@ rStyleM styleName = do

781 let sty' = getStyleId styleName $ sCharStyleMap styleMaps

794 let sty' = getStyleId styleName $ sCharStyleMap styleMaps

782 return $ mknode "w:rStyle" [("w:val",sty')] ()

795 return $ mknode "w:rStyle" [("w:val",sty')] ()

783

796

784−getUniqueId :: MonadIO m => m String

797+getUniqueId :: DocxAction String

785-- the + 20 is to ensure that there are no clashes with the rIds

798-- the + 20 is to ensure that there are no clashes with the rIds

786-- already in word/document.xml.rel

799-- already in word/document.xml.rel

787−getUniqueId = liftIO $ (show . (+ 20) . hashUnique) `fmap` newUnique

800+getUniqueId = (show . (+ 20) . hashUnique) <$> P.newUnique

788

801

789-- | Key for specifying user-defined docx styles.

802-- | Key for specifying user-defined docx styles.

790dynamicStyleKey :: String

803dynamicStyleKey :: String

@@ -825,7 +838,7 @@ blockToOpenXML' opts (Header lev (ident,_,_) lst) = do

825 then uniqueIdent lst usedIdents

838 then uniqueIdent lst usedIdents

826 else ident

839 else ident

827 modify $ \s -> s{ stSectionIds = Set.insert bookmarkName $ stSectionIds s }

840 modify $ \s -> s{ stSectionIds = Set.insert bookmarkName $ stSectionIds s }

828− id' <- getUniqueId

841+ id' <- (lift . lift) getUniqueId

829 let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')

842 let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')

830 ,("w:name",bookmarkName)] ()

843 ,("w:name",bookmarkName)] ()

831 let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()

844 let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()

@@ -1137,7 +1150,7 @@ inlineToOpenXML' opts (Code attrs str) = do

1137 else unhighlighted

1150 else unhighlighted

1138inlineToOpenXML' opts (Note bs) = do

1151inlineToOpenXML' opts (Note bs) = do

1139 notes <- gets stFootnotes

1152 notes <- gets stFootnotes

1140− notenum <- getUniqueId

1153+ notenum <- (lift . lift) getUniqueId

1141 footnoteStyle <- rStyleM "Footnote Reference"

1154 footnoteStyle <- rStyleM "Footnote Reference"

1142 let notemarker = mknode "w:r" []

1155 let notemarker = mknode "w:r" []

1143 [ mknode "w:rPr" [] footnoteStyle

1156 [ mknode "w:rPr" [] footnoteStyle

@@ -1168,7 +1181,7 @@ inlineToOpenXML' opts (Link _ txt (src,_)) = do

1168 id' <- case M.lookup src extlinks of

1181 id' <- case M.lookup src extlinks of

1169 Just i -> return i

1182 Just i -> return i

1170 Nothing -> do

1183 Nothing -> do

1171− i <- ("rId"++) `fmap` getUniqueId

1184+ i <- ("rId"++) `fmap` ((lift . lift) getUniqueId)

1172 modify $ \st -> st{ stExternalLinks =

1185 modify $ \st -> st{ stExternalLinks =

1173 M.insert src i extlinks }

1186 M.insert src i extlinks }

1174 return i

1187 return i

@@ -1180,15 +1193,14 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do

1180 case M.lookup src imgs of

1193 case M.lookup src imgs of

1181 Just (_,_,_,elt,_) -> return [elt]

1194 Just (_,_,_,elt,_) -> return [elt]

1182 Nothing -> do

1195 Nothing -> do

1183− res <- liftIO $

1184− fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

1196+ res <- (lift . lift) $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

1185 case res of

1197 case res of

1186 Left (_ :: E.SomeException) -> do

1198 Left (_ :: E.SomeException) -> do

1187− warn $ "Could not find image `" ++ src ++ "', skipping..."

1199+ (lift . lift) $ P.warn ("Could not find image `" ++ src ++ "', skipping...")

1188 -- emit alt text

1200 -- emit alt text

1189 inlinesToOpenXML opts alt

1201 inlinesToOpenXML opts alt

1190 Right (img, mt) -> do

1202 Right (img, mt) -> do

1191− ident <- ("rId"++) `fmap` getUniqueId

1203+ ident <- ("rId"++) `fmap` ((lift . lift) getUniqueId)

1192 let (xpt,ypt) = desiredSizeInPoints opts attr

1204 let (xpt,ypt) = desiredSizeInPoints opts attr

1193 (either (const def) id (imageSize img))

1205 (either (const def) id (imageSize img))

1194 -- 12700 emu = 1 pt

1206 -- 12700 emu = 1 pt

@@ -1272,13 +1284,13 @@ defaultFootnotes = [ mknode "w:footnote"

1272 [ mknode "w:r" [] $

1284 [ mknode "w:r" [] $

1273 [ mknode "w:continuationSeparator" [] ()]]]]

1285 [ mknode "w:continuationSeparator" [] ()]]]]

1274

1286

1275−parseXml :: Archive -> Archive -> String -> IO Element

1287+parseXml :: Archive -> Archive -> String -> DocxAction Element

1276parseXml refArchive distArchive relpath =

1288parseXml refArchive distArchive relpath =

1277 case findEntryByPath relpath refArchive `mplus`

1289 case findEntryByPath relpath refArchive `mplus`

1278 findEntryByPath relpath distArchive of

1290 findEntryByPath relpath distArchive of

1279 Nothing -> fail $ relpath ++ " missing in reference docx"

1291 Nothing -> fail $ relpath ++ " missing in reference docx"

1280 Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of

1292 Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of

1281− Nothing -> fail $ relpath ++ " corrupt in reference docx"

1293+ Nothing -> P.fail $ relpath ++ " corrupt in reference docx"

1282 Just d -> return d

1294 Just d -> return d

1283

1295

1284-- | Scales the image to fit the page

1296-- | Scales the image to fit the page

src/Text/Pandoc/Writers/EPUB.hs+44−37

@@ -28,26 +28,23 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

29Conversion of 'Pandoc' documents to EPUB.

30-}

31−module Text.Pandoc.Writers.EPUB ( writeEPUB ) where

31+module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where

32−import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )

32+import Data.IORef ( IORef )

33import qualified Data.Map as M

34import qualified Data.Set as Set

35import Data.Maybe ( fromMaybe, catMaybes )

36import Data.List ( isPrefixOf, isInfixOf, intercalate )

37−import System.Environment ( getEnv )

38import Text.Printf (printf)

37import Text.Printf (printf)

39import System.FilePath ( takeExtension, takeFileName )

38import System.FilePath ( takeExtension, takeFileName )

40−import System.FilePath.Glob ( namesMatching )

41import Network.HTTP ( urlEncode )

39import Network.HTTP ( urlEncode )

42import qualified Data.ByteString.Lazy as B

40import qualified Data.ByteString.Lazy as B

43import qualified Data.ByteString.Lazy.Char8 as B8

41import qualified Data.ByteString.Lazy.Char8 as B8

44import qualified Text.Pandoc.UTF8 as UTF8

42import qualified Text.Pandoc.UTF8 as UTF8

45import Codec.Archive.Zip ( emptyArchive, addEntryToArchive, eRelativePath, fromEntry , Entry, toEntry, fromArchive)

43import Codec.Archive.Zip ( emptyArchive, addEntryToArchive, eRelativePath, fromEntry , Entry, toEntry, fromArchive)

46−import Data.Time.Clock.POSIX ( getPOSIXTime )

47import Text.Pandoc.Compat.Time

44import Text.Pandoc.Compat.Time

48import Text.Pandoc.Shared ( renderTags', safeRead, uniqueIdent, trim

45import Text.Pandoc.Shared ( renderTags', safeRead, uniqueIdent, trim

49− , normalizeDate, readDataFile, stringify, warn

46+ , normalizeDate, stringify

50− , hierarchicalize, fetchItem' )

47+ , hierarchicalize )

51import qualified Text.Pandoc.Shared as S (Element(..))

48import qualified Text.Pandoc.Shared as S (Element(..))

52import Text.Pandoc.Builder (fromList, setMeta)

49import Text.Pandoc.Builder (fromList, setMeta)

53import Text.Pandoc.Options ( WriterOptions(..)

50import Text.Pandoc.Options ( WriterOptions(..)

@@ -58,17 +55,19 @@ import Text.Pandoc.Options ( WriterOptions(..)

58import Text.Pandoc.Definition

55import Text.Pandoc.Definition

59import Text.Pandoc.Walk (walk, walkM, query)

56import Text.Pandoc.Walk (walk, walkM, query)

60import Control.Monad.State (modify, get, State, put, evalState)

57import Control.Monad.State (modify, get, State, put, evalState)

61−import Control.Monad (mplus, liftM, when)

58+import Control.Monad (mplus, when)

62import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs

59import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs

63 , strContent, lookupAttr, Node(..), QName(..), parseXML

60 , strContent, lookupAttr, Node(..), QName(..), parseXML

64 , onlyElems, node, ppElement)

61 , onlyElems, node, ppElement)

65−import Text.Pandoc.UUID (getRandomUUID)

66import Text.Pandoc.Writers.HTML ( writeHtml )

62import Text.Pandoc.Writers.HTML ( writeHtml )

67import Data.Char ( toLower, isDigit, isAlphaNum )

63import Data.Char ( toLower, isDigit, isAlphaNum )

68import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)

64import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)

69−import qualified Control.Exception as E

70import Text.Blaze.Html.Renderer.Utf8 (renderHtml)

65import Text.Blaze.Html.Renderer.Utf8 (renderHtml)

71import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)

66import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)

67+import Text.Pandoc.Free (PandocAction, runIO)

68+import qualified Text.Pandoc.Free as P

69+

70+type EPUBAction = PandocAction [(FilePath, (FilePath, Maybe Entry))]

73-- A Chapter includes a list of blocks and maybe a section

72-- A Chapter includes a list of blocks and maybe a section

74-- number offset. Note, some chapters are unnumbered. The section

73-- number offset. Note, some chapters are unnumbered. The section

@@ -143,7 +142,7 @@ removeNote :: Inline -> Inline

143removeNote (Note _) = Str ""

142removeNote (Note _) = Str ""

144removeNote x = x

143removeNote x = x

145

144

146−getEPUBMetadata :: WriterOptions -> Meta -> IO EPUBMetadata

145+getEPUBMetadata :: WriterOptions -> Meta -> EPUBAction EPUBMetadata

147getEPUBMetadata opts meta = do

146getEPUBMetadata opts meta = do

148 let md = metadataFromMeta opts meta

147 let md = metadataFromMeta opts meta

149 let elts = onlyElems $ parseXML $ writerEpubMetadata opts

148 let elts = onlyElems $ parseXML $ writerEpubMetadata opts

@@ -151,7 +150,7 @@ getEPUBMetadata opts meta = do

151 let addIdentifier m =

150 let addIdentifier m =

152 if null (epubIdentifier m)

151 if null (epubIdentifier m)

153 then do

152 then do

154− randomId <- fmap show getRandomUUID

153+ randomId <- fmap show P.newUUID

155 return $ m{ epubIdentifier = [Identifier randomId Nothing] }

154 return $ m{ epubIdentifier = [Identifier randomId Nothing] }

156 else return m

155 else return m

157 let addLanguage m =

156 let addLanguage m =

@@ -159,16 +158,19 @@ getEPUBMetadata opts meta = do

159 then case lookup "lang" (writerVariables opts) of

158 then case lookup "lang" (writerVariables opts) of

160 Just x -> return m{ epubLanguage = x }

159 Just x -> return m{ epubLanguage = x }

161 Nothing -> do

160 Nothing -> do

162− localeLang <- E.catch (liftM

161+ mLang <- P.lookupEnv "LANG"

162+ let localeLang =

163+ case mLang of

164+ Just lang ->

163− (map (\c -> if c == '_' then '-' else c) .

165+ map (\c -> if c == '_' then '-' else c) $

164− takeWhile (/='.')) $ getEnv "LANG")

166+ takeWhile (/='.') lang

165− (\e -> let _ = (e :: E.SomeException) in return "en-US")

167+ Nothing -> "en-US"

166 return m{ epubLanguage = localeLang }

168 return m{ epubLanguage = localeLang }

167 else return m

169 else return m

168 let fixDate m =

170 let fixDate m =

169 if null (epubDate m)

171 if null (epubDate m)

170 then do

172 then do

171− currentTime <- getCurrentTime

173+ currentTime <- P.getCurrentTime

172 return $ m{ epubDate = [ Date{

174 return $ m{ epubDate = [ Date{

173 dateText = showDateTimeISO8601 currentTime

175 dateText = showDateTimeISO8601 currentTime

174 , dateEvent = Nothing } ] }

176 , dateEvent = Nothing } ] }

@@ -333,10 +335,15 @@ metadataFromMeta opts meta = EPUBMetadata{

333writeEPUB :: WriterOptions -- ^ Writer options

335writeEPUB :: WriterOptions -- ^ Writer options

334 -> Pandoc -- ^ Document to convert

336 -> Pandoc -- ^ Document to convert

335 -> IO B.ByteString

337 -> IO B.ByteString

336−writeEPUB opts doc@(Pandoc meta _) = do

338+writeEPUB opts doc = runIO $ writeEPUBPure opts doc

339+

340+writeEPUBPure :: WriterOptions -- ^ Writer options

341+ -> Pandoc -- ^ Document to convert

342+ -> EPUBAction B.ByteString

343+writeEPUBPure opts doc@(Pandoc meta _) = do

337 let version = fromMaybe EPUB2 (writerEpubVersion opts)

344 let version = fromMaybe EPUB2 (writerEpubVersion opts)

338 let epub3 = version == EPUB3

345 let epub3 = version == EPUB3

339− epochtime <- floor `fmap` getPOSIXTime

346+ epochtime <- floor <$> P.getPOSIXTime

340 let mkEntry path content = toEntry path epochtime content

347 let mkEntry path content = toEntry path epochtime content

341 let vars = ("epub3", if epub3 then "true" else "false")

348 let vars = ("epub3", if epub3 then "true" else "false")

342 : ("css", "stylesheet.css")

349 : ("css", "stylesheet.css")

@@ -361,7 +368,7 @@ writeEPUB opts doc@(Pandoc meta _) = do

361 let cpContent = renderHtml $ writeHtml

368 let cpContent = renderHtml $ writeHtml

362 opts'{ writerVariables = ("coverpage","true"):vars }

369 opts'{ writerVariables = ("coverpage","true"):vars }

363 (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])

370 (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])

364− imgContent <- B.readFile img

371+ imgContent <- P.readFileLazy img

365 return ( [mkEntry "cover.xhtml" cpContent]

372 return ( [mkEntry "cover.xhtml" cpContent]

366 , [mkEntry coverImage imgContent] )

373 , [mkEntry coverImage imgContent] )

367

374

@@ -372,18 +379,18 @@ writeEPUB opts doc@(Pandoc meta _) = do

372 let tpEntry = mkEntry "title_page.xhtml" tpContent

379 let tpEntry = mkEntry "title_page.xhtml" tpContent

373

380

374 -- handle pictures

381 -- handle pictures

375− mediaRef <- newIORef []

382+ mediaRef <- P.newIORef []

376 Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=

383 Pandoc _ blocks <- walkM (transformInline opts' mediaRef) doc >>=

377 walkM (transformBlock opts' mediaRef)

384 walkM (transformBlock opts' mediaRef)

378− picEntries <- (catMaybes . map (snd . snd)) <$> readIORef mediaRef

385+ picEntries <- (catMaybes . map (snd . snd)) <$> P.readIORef mediaRef

379

386

380 -- handle fonts

387 -- handle fonts

381 let matchingGlob f = do

388 let matchingGlob f = do

382− xs <- namesMatching f

389+ xs <- P.namesMatching f

383 when (null xs) $

390 when (null xs) $

384− warn $ f ++ " did not match any font files."

391+ P.warn $ f ++ " did not match any font files."

385 return xs

392 return xs

386− let mkFontEntry f = mkEntry (takeFileName f) `fmap` B.readFile f

393+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` P.readFileLazy f

387 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')

394 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')

388 fontEntries <- mapM mkFontEntry fontFiles

395 fontEntries <- mapM mkFontEntry fontFiles

389

396

@@ -520,7 +527,7 @@ writeEPUB opts doc@(Pandoc meta _) = do

520 let uuid = case epubIdentifier metadata of

527 let uuid = case epubIdentifier metadata of

521 (x:_) -> identifierText x -- use first identifier as UUID

528 (x:_) -> identifierText x -- use first identifier as UUID

522 [] -> error "epubIdentifier is null" -- shouldn't happen

529 [] -> error "epubIdentifier is null" -- shouldn't happen

523− currentTime <- getCurrentTime

530+ currentTime <- P.getCurrentTime

524 let contentsData = UTF8.fromStringLazy $ ppTopElement $

531 let contentsData = UTF8.fromStringLazy $ ppTopElement $

525 unode "package" ! [("version", case version of

532 unode "package" ! [("version", case version of

526 EPUB2 -> "2.0"

533 EPUB2 -> "2.0"

@@ -692,10 +699,10 @@ writeEPUB opts doc@(Pandoc meta _) = do

692

699

693 -- stylesheet

700 -- stylesheet

694 stylesheet <- case epubStylesheet metadata of

701 stylesheet <- case epubStylesheet metadata of

695− Just (StylesheetPath fp) -> UTF8.readFile fp

702+ Just (StylesheetPath fp) -> P.readFileUTF8 fp

696 Just (StylesheetContents s) -> return s

703 Just (StylesheetContents s) -> return s

697 Nothing -> UTF8.toString `fmap`

704 Nothing -> UTF8.toString `fmap`

698− readDataFile (writerUserDataDir opts) "epub.css"

705+ P.readDataFile (writerUserDataDir opts) "epub.css"

699 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet

706 let stylesheetEntry = mkEntry "stylesheet.css" $ UTF8.fromStringLazy stylesheet

700

707

701 -- construct archive

708 -- construct archive

@@ -814,7 +821,7 @@ showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"

814transformTag :: WriterOptions

821transformTag :: WriterOptions

815 -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media

822 -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media

816 -> Tag String

823 -> Tag String

817− -> IO (Tag String)

824+ -> EPUBAction (Tag String)

818transformTag opts mediaRef tag@(TagOpen name attr)

825transformTag opts mediaRef tag@(TagOpen name attr)

819 | name `elem` ["video", "source", "img", "audio"] &&

826 | name `elem` ["video", "source", "img", "audio"] &&

820 lookup "data-external" attr == Nothing = do

827 lookup "data-external" attr == Nothing = do

@@ -831,34 +838,34 @@ transformTag _ _ tag = return tag

831modifyMediaRef :: WriterOptions

838modifyMediaRef :: WriterOptions

832 -> IORef [(FilePath, (FilePath, Maybe Entry))]

839 -> IORef [(FilePath, (FilePath, Maybe Entry))]

833 -> FilePath

840 -> FilePath

834− -> IO FilePath

841+ -> EPUBAction FilePath

835modifyMediaRef _ _ "" = return ""

842modifyMediaRef _ _ "" = return ""

836modifyMediaRef opts mediaRef oldsrc = do

843modifyMediaRef opts mediaRef oldsrc = do

837− media <- readIORef mediaRef

844+ media <- P.readIORef mediaRef

838 case lookup oldsrc media of

845 case lookup oldsrc media of

839 Just (n,_) -> return n

846 Just (n,_) -> return n

840 Nothing -> do

847 Nothing -> do

841− res <- fetchItem' (writerMediaBag opts)

848+ res <- P.fetchItem' (writerMediaBag opts)

842 (writerSourceURL opts) oldsrc

849 (writerSourceURL opts) oldsrc

843 (new, mbEntry) <-

850 (new, mbEntry) <-

844 case res of

851 case res of

845 Left _ -> do

852 Left _ -> do

846− warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."

853+ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."

847 return (oldsrc, Nothing)

854 return (oldsrc, Nothing)

848 Right (img,mbMime) -> do

855 Right (img,mbMime) -> do

849 let new = "media/file" ++ show (length media) ++

856 let new = "media/file" ++ show (length media) ++

850 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))

857 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))

851 (('.':) <$> (mbMime >>= extensionFromMimeType))

858 (('.':) <$> (mbMime >>= extensionFromMimeType))

852− epochtime <- floor `fmap` getPOSIXTime

859+ epochtime <- floor `fmap` P.getPOSIXTime

853 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img

860 let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img

854 return (new, Just entry)

861 return (new, Just entry)

855− modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )

862+ P.modifyIORef mediaRef ( (oldsrc, (new, mbEntry)): )

856 return new

863 return new

857

864

858transformBlock :: WriterOptions

865transformBlock :: WriterOptions

859 -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media

866 -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media

860 -> Block

867 -> Block

861− -> IO Block

868+ -> EPUBAction Block

862transformBlock opts mediaRef (RawBlock fmt raw)

869transformBlock opts mediaRef (RawBlock fmt raw)

863 | fmt == Format "html" = do

870 | fmt == Format "html" = do

864 let tags = parseTags raw

871 let tags = parseTags raw

@@ -869,7 +876,7 @@ transformBlock _ _ b = return b

869transformInline :: WriterOptions

876transformInline :: WriterOptions

870 -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media

877 -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media

871 -> Inline

878 -> Inline

872− -> IO Inline

879+ -> EPUBAction Inline

873transformInline opts mediaRef (Image attr lab (src,tit)) = do

880transformInline opts mediaRef (Image attr lab (src,tit)) = do

874 newsrc <- modifyMediaRef opts mediaRef src

881 newsrc <- modifyMediaRef opts mediaRef src

875 return $ Image attr lab (newsrc, tit)

882 return $ Image attr lab (newsrc, tit)

src/Text/Pandoc/Writers/ICML.hs+13−6

@@ -18,7 +18,7 @@ import Text.Pandoc.Definition

18import Text.Pandoc.XML

19import Text.Pandoc.Readers.TeXMath (texMathToInlines)

20import Text.Pandoc.Writers.Shared

21−import Text.Pandoc.Shared (linesToPara, splitBy, fetchItem, warn)

21+import Text.Pandoc.Shared (linesToPara, splitBy, warn)

22import Text.Pandoc.Options

23import Text.Pandoc.Templates (renderTemplate')

24import Text.Pandoc.Pretty

@@ -28,6 +28,10 @@ import Data.Text as Text (breakOnAll, pack)

28import Control.Monad.State

29import Network.URI (isURI)

30import qualified Data.Set as Set

31+import Text.Pandoc.Free (runIO)

32+import qualified Text.Pandoc.Free as P

33+

34+type ICMLAction = P.PandocAction ()

32type Style = [String]

36type Style = [String]

33type Hyperlink = [(Int, String)]

37type Hyperlink = [(Int, String)]

@@ -40,7 +44,7 @@ data WriterState = WriterState{

40 , maxListDepth :: Int

44 , maxListDepth :: Int

41 }

45 }

43−type WS a = StateT WriterState IO a

47+type WS a = StateT WriterState ICMLAction a

45defaultWriterState :: WriterState

49defaultWriterState :: WriterState

46defaultWriterState = WriterState{

50defaultWriterState = WriterState{

@@ -121,10 +125,13 @@ subListParName = "subParagraph"

121footnoteName = "Footnote"

125footnoteName = "Footnote"

122citeName = "Cite"

126citeName = "Cite"

123

127

124−

125-- | Convert Pandoc document to string in ICML format.

128-- | Convert Pandoc document to string in ICML format.

126writeICML :: WriterOptions -> Pandoc -> IO String

129writeICML :: WriterOptions -> Pandoc -> IO String

130+writeICML opts doc = runIO $ writeICMLPure opts doc

131+

132+-- | Convert Pandoc document to string in ICML format.

133+writeICMLPure :: WriterOptions -> Pandoc -> ICMLAction String

127−writeICML opts (Pandoc meta blocks) = do

134+writeICMLPure opts (Pandoc meta blocks) = do

128 let colwidth = if writerWrapText opts == WrapAuto

135 let colwidth = if writerWrapText opts == WrapAuto

129 then Just $ writerColumns opts

136 then Just $ writerColumns opts

130 else Nothing

137 else Nothing

@@ -532,10 +539,10 @@ styleToStrAttr style =

532-- | Assemble an ICML Image.

539-- | Assemble an ICML Image.

533imageICML :: WriterOptions -> Style -> Attr -> Target -> WS Doc

540imageICML :: WriterOptions -> Style -> Attr -> Target -> WS Doc

534imageICML opts style attr (src, _) = do

541imageICML opts style attr (src, _) = do

535− res <- liftIO $ fetchItem (writerSourceURL opts) src

542+ res <- lift $ P.fetchItem (writerSourceURL opts) src

536 imgS <- case res of

543 imgS <- case res of

537 Left (_) -> do

544 Left (_) -> do

538− warn $ "Could not find image `" ++ src ++ "', skipping..."

545+ lift $ P.warn $ "Could not find image `" ++ src ++ "', skipping..."

539 return def

546 return def

540 Right (img, _) -> do

547 Right (img, _) -> do

541 case imageSize img of

548 case imageSize img of

src/Text/Pandoc/Writers/ODT.hs+28−20

@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

29Conversion of 'Pandoc' documents to ODT.

30-}

31−module Text.Pandoc.Writers.ODT ( writeODT ) where

31+module Text.Pandoc.Writers.ODT ( writeODTPure, writeODT ) where

32import Data.IORef

33import Data.List ( isPrefixOf )

34import Data.Maybe ( fromMaybe )

@@ -38,8 +38,7 @@ import qualified Data.ByteString.Lazy as B

38import Text.Pandoc.UTF8 ( fromStringLazy )

39import Codec.Archive.Zip

40import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) )

41−import Text.Pandoc.Shared ( stringify, fetchItem', warn,

41+import Text.Pandoc.Shared ( stringify )

42− getDefaultReferenceODT )

43import Text.Pandoc.ImageSize

42import Text.Pandoc.ImageSize

44import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType )

43import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType )

45import Text.Pandoc.Definition

44import Text.Pandoc.Definition

@@ -50,28 +49,37 @@ import Control.Monad (liftM)

50import Text.Pandoc.XML

49import Text.Pandoc.XML

51import Text.Pandoc.Pretty

50import Text.Pandoc.Pretty

52import qualified Control.Exception as E

51import qualified Control.Exception as E

53−import Data.Time.Clock.POSIX ( getPOSIXTime )

54import System.FilePath ( takeExtension, takeDirectory, (<.>))

52import System.FilePath ( takeExtension, takeDirectory, (<.>))

53+import Text.Pandoc.Free ( PandocAction, runIO )

54+import qualified Text.Pandoc.Free as P

55+

56+type ODTAction = PandocAction [Entry]

56-- | Produce an ODT file from a Pandoc document.

58-- | Produce an ODT file from a Pandoc document.

57writeODT :: WriterOptions -- ^ Writer options

59writeODT :: WriterOptions -- ^ Writer options

58 -> Pandoc -- ^ Document to convert

60 -> Pandoc -- ^ Document to convert

59 -> IO B.ByteString

61 -> IO B.ByteString

60−writeODT opts doc@(Pandoc meta _) = do

62+writeODT opts doc = runIO $ writeODTPure opts doc

63+

64+-- | Produce an ODT file from a Pandoc document.

65+writeODTPure :: WriterOptions -- ^ Writer options

66+ -> Pandoc -- ^ Document to convert

67+ -> ODTAction B.ByteString

68+writeODTPure opts doc@(Pandoc meta _) = do

61 let datadir = writerUserDataDir opts

69 let datadir = writerUserDataDir opts

62 let title = docTitle meta

70 let title = docTitle meta

63 refArchive <-

71 refArchive <-

64 case writerReferenceODT opts of

72 case writerReferenceODT opts of

65− Just f -> liftM toArchive $ B.readFile f

73+ Just f -> liftM toArchive $ P.readFileLazy f

66− Nothing -> getDefaultReferenceODT datadir

74+ Nothing -> P.getDefaultReferenceODT datadir

67 -- handle formulas and pictures

75 -- handle formulas and pictures

68− picEntriesRef <- newIORef ([] :: [Entry])

76+ picEntriesRef <- P.newIORef ([] :: [Entry])

69 doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc

77 doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc

70 let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc'

78 let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc'

71− epochtime <- floor `fmap` getPOSIXTime

79+ epochtime <- floor `fmap` P.getPOSIXTime

72 let contentEntry = toEntry "content.xml" epochtime

80 let contentEntry = toEntry "content.xml" epochtime

73 $ fromStringLazy newContents

81 $ fromStringLazy newContents

74− picEntries <- readIORef picEntriesRef

82+ picEntries <- P.readIORef picEntriesRef

75 let archive = foldr addEntryToArchive refArchive

83 let archive = foldr addEntryToArchive refArchive

76 $ contentEntry : picEntries

84 $ contentEntry : picEntries

77 -- construct META-INF/manifest.xml based on archive

85 -- construct META-INF/manifest.xml based on archive

@@ -126,18 +134,18 @@ writeODT opts doc@(Pandoc meta _) = do

126 return $ fromArchive archive''

134 return $ fromArchive archive''

127

135

128-- | transform both Image and Math elements

136-- | transform both Image and Math elements

129−transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline

137+transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> ODTAction Inline

130transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do

138transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do

131− res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

139+ res <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

132 case res of

140 case res of

133 Left (_ :: E.SomeException) -> do

141 Left (_ :: E.SomeException) -> do

134− warn $ "Could not find image `" ++ src ++ "', skipping..."

142+ P.warn $ "Could not find image `" ++ src ++ "', skipping..."

135 return $ Emph lab

143 return $ Emph lab

136 Right (img, mbMimeType) -> do

144 Right (img, mbMimeType) -> do

137 (ptX, ptY) <- case imageSize img of

145 (ptX, ptY) <- case imageSize img of

138 Right s -> return $ sizeInPoints s

146 Right s -> return $ sizeInPoints s

139 Left msg -> do

147 Left msg -> do

140− warn $ "Could not determine image size in `" ++

148+ P.warn $ "Could not determine image size in `" ++

141 src ++ "': " ++ msg

149 src ++ "': " ++ msg

142 return (100, 100)

150 return (100, 100)

143 let dims =

151 let dims =

@@ -155,28 +163,28 @@ transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do

155 Just dim -> Just $ Inch $ inInch opts dim

163 Just dim -> Just $ Inch $ inInch opts dim

156 Nothing -> Nothing

164 Nothing -> Nothing

157 let newattr = (id', cls, dims)

165 let newattr = (id', cls, dims)

158− entries <- readIORef entriesRef

166+ entries <- P.readIORef entriesRef

159 let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)

167 let extension = fromMaybe (takeExtension $ takeWhile (/='?') src)

160 (mbMimeType >>= extensionFromMimeType)

168 (mbMimeType >>= extensionFromMimeType)

161 let newsrc = "Pictures/" ++ show (length entries) <.> extension

169 let newsrc = "Pictures/" ++ show (length entries) <.> extension

162 let toLazy = B.fromChunks . (:[])

170 let toLazy = B.fromChunks . (:[])

163− epochtime <- floor `fmap` getPOSIXTime

171+ epochtime <- floor `fmap` P.getPOSIXTime

164 let entry = toEntry newsrc epochtime $ toLazy img

172 let entry = toEntry newsrc epochtime $ toLazy img

165− modifyIORef entriesRef (entry:)

173+ P.modifyIORef entriesRef (entry:)

166 return $ Image newattr lab (newsrc, t)

174 return $ Image newattr lab (newsrc, t)

167transformPicMath _ entriesRef (Math t math) = do

175transformPicMath _ entriesRef (Math t math) = do

168− entries <- readIORef entriesRef

176+ entries <- P.readIORef entriesRef

169 let dt = if t == InlineMath then DisplayInline else DisplayBlock

177 let dt = if t == InlineMath then DisplayInline else DisplayBlock

170 case writeMathML dt <$> readTeX math of

178 case writeMathML dt <$> readTeX math of

171 Left _ -> return $ Math t math

179 Left _ -> return $ Math t math

172 Right r -> do

180 Right r -> do

173 let conf = useShortEmptyTags (const False) defaultConfigPP

181 let conf = useShortEmptyTags (const False) defaultConfigPP

174 let mathml = ppcTopElement conf r

182 let mathml = ppcTopElement conf r

175− epochtime <- floor `fmap` getPOSIXTime

183+ epochtime <- floor `fmap` P.getPOSIXTime

176 let dirname = "Formula-" ++ show (length entries) ++ "/"

184 let dirname = "Formula-" ++ show (length entries) ++ "/"

177 let fname = dirname ++ "content.xml"

185 let fname = dirname ++ "content.xml"

178 let entry = toEntry fname epochtime (fromStringLazy mathml)

186 let entry = toEntry fname epochtime (fromStringLazy mathml)

179− modifyIORef entriesRef (entry:)

187+ P.modifyIORef entriesRef (entry:)

180 return $ RawInline (Format "opendocument") $ render Nothing $

188 return $ RawInline (Format "opendocument") $ render Nothing $

181 inTags False "draw:frame" [("text:anchor-type",

189 inTags False "draw:frame" [("text:anchor-type",

182 if t == DisplayMath

190 if t == DisplayMath