master...241c152 · typeable/pandoc

git.iko.soy/typeable/pandoc

on 241c152 help sign in

pandoc.cabal+3−2

since splitsnapshots

unifiedsplit

@@ -291,10 +291,10 @@ Library

291 old-time,

292 deepseq >= 1.3 && < 1.5,

293 JuicyPixels >= 3.1.6.1 && < 3.3,

294− filemanip >= 0.3 && < 0.4,

294+ Glob >= 0.7 && < 0.8,

295 cmark >= 0.5 && < 0.6,

296 doctemplates >= 0.1 && < 0.2,

297− ghc-prim >= 0.2

297+ free >= 4

298 if flag(old-locale)

299 Build-Depends: old-locale >= 1 && < 1.1,

300 time >= 1.2 && < 1.5

@@ -385,6 +385,7 @@ Library

385 Text.Pandoc.SelfContained,

386 Text.Pandoc.Process,

387 Text.Pandoc.CSS

388+ Text.Pandoc.Free

388 Other-Modules: Text.Pandoc.Readers.Docx.Lists,

389 Other-Modules: Text.Pandoc.Readers.Docx.Lists,

389 Text.Pandoc.Readers.Docx.Combine,

390 Text.Pandoc.Readers.Docx.Combine,

390 Text.Pandoc.Readers.Docx.Parse,

391 Text.Pandoc.Readers.Docx.Parse,

src/Text/Pandoc/Free.hsnew file+313

@@ -0,0 +1,313 @@

1+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable #-}

3+{-

6+This program is free software; you can redistribute it and/or modify

7+it under the terms of the GNU General Public License as published by

8+the Free Software Foundation; either version 2 of the License, or

9+(at your option) any later version.

10+

11+This program is distributed in the hope that it will be useful,

12+but WITHOUT ANY WARRANTY; without even the implied warranty of

13+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

14+GNU General Public License for more details.

15+

16+You should have received a copy of the GNU General Public License

17+along with this program; if not, write to the Free Software

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

19+-}

20+

21+{- |

22+ Module : Text.Pandoc.Free

24+ License : GNU GPL, version 2 or above

25+

26+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>

27+ Stability : alpha

28+ Portability : portable

29+

30+Pure implementations of the IO monads used in Pandoc's readers and writers.

31+-}

32+

33+module Text.Pandoc.Free ( PandocActionF(..)

34+ , PandocAction

35+ , runIO

36+ , runTest

37+ , TestState(..)

38+ , TestEnv(..)

39+ , liftF

40+ --

41+ , lookupEnv

42+ , getCurrentTime

43+ , getPOSIXTime

44+ , getDefaultReferenceDocx

45+ , getDefaultReferenceODT

46+ , newStdGen

47+ , newUniqueHash

48+ , newUUID

49+ , readFileStrict

50+ , readFileLazy

51+ , readFileUTF8

52+ , readDataFile

53+ , fetchItem

54+ , fetchItem'

55+ , warn

56+ , fail

57+ , glob

58+ ) where

59+

60+import Prelude hiding (readFile, fail)

61+import qualified Control.Monad as M (fail)

62+import System.Random (StdGen, next)

63+import qualified System.Random as IO (newStdGen)

64+import Codec.Archive.Zip (Archive, fromArchive)

65+import Data.Unique (hashUnique)

66+import qualified Data.Unique as IO (newUnique)

67+import qualified Text.Pandoc.Shared as IO ( fetchItem

68+ , fetchItem'

69+ , getDefaultReferenceDocx

70+ , getDefaultReferenceODT

71+ , warn

72+ , readDataFile)

73+import Text.Pandoc.MediaBag (MediaBag, lookupMedia)

74+import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)

75+import qualified Data.Time.Clock.POSIX as IO (getPOSIXTime)

76+import Text.Pandoc.Compat.Time (UTCTime)

77+import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)

78+import Text.Pandoc.MIME (MimeType, getMimeType)

79+import qualified Data.ByteString as B

80+import qualified Data.ByteString.Lazy as BL

81+import Control.Monad.Free

82+import qualified Control.Exception as E

83+import qualified System.Environment as IO (lookupEnv)

84+import Text.Pandoc.UUID

85+import qualified Text.Pandoc.UUID as IO (getRandomUUID)

86+import qualified Text.Pandoc.UTF8 as UTF8 (readFile, toString)

87+import System.FilePath.Glob (match, compile)

88+import System.FilePath ((</>))

89+import qualified System.FilePath.Glob as IO (glob)

90+import Control.Monad.State hiding (fail)

91+import Control.Monad.Reader hiding (fail)

92+import Data.Word (Word8)

93+import Data.Typeable

94+

95+data PandocActionF nxt =

96+ LookupEnv String (Maybe String -> nxt)

97+ | GetCurrentTime (UTCTime -> nxt)

98+ | GetPOSIXTime (POSIXTime -> nxt)

99+ | GetDefaultReferenceDocx (Maybe FilePath) (Archive -> nxt)

100+ | GetDefaultReferenceODT (Maybe FilePath) (Archive -> nxt)

101+ | NewStdGen (StdGen -> nxt)

102+ | NewUniqueHash (Int -> nxt)

103+ | NewUUID (UUID -> nxt)

104+ | ReadFileStrict FilePath (B.ByteString -> nxt)

105+ | ReadFileLazy FilePath (BL.ByteString -> nxt)

106+ | ReadFileUTF8 FilePath (String -> nxt)

107+ | ReadDataFile (Maybe FilePath) FilePath (B.ByteString -> nxt)

108+ | FetchItem (Maybe String) (String)

109+ (Either E.SomeException (B.ByteString, Maybe MimeType) -> nxt)

110+ | FetchItem' MediaBag (Maybe String) (String)

111+ (Either E.SomeException (B.ByteString, Maybe MimeType) -> nxt)

112+ | Glob String ([FilePath] -> nxt)

113+ | Warn String nxt

114+ | Fail String

115+ deriving Functor

116+

117+type PandocAction = Free PandocActionF

118+

119+lookupEnv :: String -> PandocAction (Maybe String)

120+lookupEnv s = liftF $ LookupEnv s id

121+

122+getCurrentTime :: PandocAction UTCTime

123+getCurrentTime = liftF $ GetCurrentTime id

124+

125+getPOSIXTime :: PandocAction POSIXTime

126+getPOSIXTime = liftF $ GetPOSIXTime id

127+

128+getDefaultReferenceDocx :: Maybe FilePath -> PandocAction Archive

129+getDefaultReferenceDocx fp = liftF $ GetDefaultReferenceDocx fp id

130+

131+getDefaultReferenceODT :: Maybe FilePath -> PandocAction Archive

132+getDefaultReferenceODT fp = liftF $ GetDefaultReferenceODT fp id

133+

134+newStdGen :: PandocAction StdGen

135+newStdGen = liftF $ NewStdGen id

136+

137+newUniqueHash :: PandocAction Int

138+newUniqueHash = liftF $ NewUniqueHash id

139+

140+newUUID :: PandocAction UUID

141+newUUID = liftF $ NewUUID id

142+

143+readFileStrict :: FilePath -> PandocAction B.ByteString

144+readFileStrict fp = liftF $ ReadFileStrict fp id

145+

146+readFileLazy :: FilePath -> PandocAction BL.ByteString

147+readFileLazy fp = liftF $ ReadFileLazy fp id

148+

149+readFileUTF8 :: FilePath -> PandocAction String

150+readFileUTF8 fp = liftF $ ReadFileUTF8 fp id

151+

152+readDataFile :: Maybe FilePath -> FilePath -> PandocAction B.ByteString

153+readDataFile mfp fp = liftF $ ReadDataFile mfp fp id

154+

155+fetchItem :: Maybe String ->

156+ String ->

157+ PandocAction (Either E.SomeException (B.ByteString, Maybe MimeType))

158+fetchItem ms s = liftF $ FetchItem ms s id

159+

160+

161+fetchItem' :: MediaBag ->

162+ Maybe String ->

163+ String ->

164+ PandocAction (Either E.SomeException (B.ByteString, Maybe MimeType))

165+fetchItem' mb ms s = liftF $ FetchItem' mb ms s id

166+

167+warn :: String -> PandocAction ()

168+warn s = liftF $ Warn s ()

169+

170+fail :: String -> PandocAction b

171+fail s = liftF $ Fail s

172+

173+glob :: String -> PandocAction [FilePath]

174+glob s = liftF $ Glob s id

175+

176+runIO :: PandocAction nxt -> IO nxt

177+runIO (Free (LookupEnv s f)) = IO.lookupEnv s >>= runIO . f

178+runIO (Free (GetCurrentTime f)) = IO.getCurrentTime >>= runIO . f

179+runIO (Free (GetPOSIXTime f)) = IO.getPOSIXTime >>= runIO . f

180+runIO (Free (GetDefaultReferenceDocx mfp f)) =

181+ IO.getDefaultReferenceDocx mfp >>= runIO . f

182+runIO (Free (GetDefaultReferenceODT mfp f)) =

183+ IO.getDefaultReferenceODT mfp >>= runIO . f

184+runIO (Free (NewStdGen f)) = IO.newStdGen >>= runIO . f

185+runIO (Free (NewUniqueHash f)) = hashUnique <$> IO.newUnique >>= runIO . f

186+runIO (Free (NewUUID f)) = IO.getRandomUUID >>= runIO . f

187+runIO (Free (ReadFileStrict fp f)) = B.readFile fp >>= runIO . f

188+runIO (Free (ReadFileLazy fp f)) = BL.readFile fp >>= runIO . f

189+runIO (Free (ReadFileUTF8 fp f)) = UTF8.readFile fp >>= runIO . f

190+runIO (Free (ReadDataFile mfp fp f)) = IO.readDataFile mfp fp >>= runIO . f

191+runIO (Free (Fail s)) = M.fail s

192+runIO (Free (FetchItem sourceUrl nm f)) =

193+ IO.fetchItem sourceUrl nm >>= runIO . f

194+runIO (Free (FetchItem' media sourceUrl nm f)) =

195+ IO.fetchItem' media sourceUrl nm >>= runIO . f

196+runIO (Free (Warn s nxt)) = IO.warn s >> runIO nxt

197+runIO (Free (Glob s f)) = IO.glob s >>= runIO . f

198+runIO (Pure r) = return r

199+

200+data TestState = TestState { stStdGen :: StdGen

201+ , stWord8Store :: [Word8] -- should be

202+ -- inifinite,

203+ -- i.e. [1..]

204+ , stWarnings :: [String]

205+ , stUniqStore :: [Int] -- should be

206+ -- inifinite and

207+ -- contain every

208+ -- element at most

209+ -- once, e.g. [1..]

210+ }

211+

212+data TestEnv = TestEnv { envEnv :: [(String, String)]

213+ , envTime :: UTCTime

214+ , envReferenceDocx :: Archive

215+ , envReferenceODT :: Archive

216+ , envFiles :: [(FilePath, B.ByteString)]

217+ , envUserDataDir :: [(FilePath, B.ByteString)]

218+ , envCabalDataDir :: [(FilePath, B.ByteString)]

219+ , envFontFiles :: [FilePath]

220+ }

221+

222+data TestException = TestException

223+ deriving (Show, Typeable)

224+

225+instance E.Exception TestException

226+

227+type Testing = ReaderT TestEnv (State TestState)

228+

229+runTest :: PandocAction nxt -> Testing nxt

230+runTest (Free (LookupEnv s f)) = do

231+ env <- asks envEnv

232+ return (lookup s env) >>= runTest . f

233+runTest (Free (GetCurrentTime f)) =

234+ asks envTime >>= runTest . f

235+runTest (Free (GetPOSIXTime f)) =

236+ (utcTimeToPOSIXSeconds <$> asks envTime) >>= runTest . f

237+runTest (Free (GetDefaultReferenceDocx _ f)) =

238+ asks envReferenceDocx >>= runTest . f

239+runTest (Free (GetDefaultReferenceODT _ f)) =

240+ asks envReferenceODT >>= runTest . f

241+runTest (Free (NewStdGen f)) = do

242+ g <- gets stStdGen

243+ let (_, nxtGen) = next g

244+ modify $ \st -> st { stStdGen = nxtGen }

245+ return g >>= runTest . f

246+runTest (Free (NewUniqueHash f)) = do

247+ uniqs <- gets stUniqStore

248+ case uniqs of

249+ u : us -> do

250+ modify $ \st -> st { stUniqStore = us }

251+ return u >>= runTest . f

252+ _ -> M.fail "uniq store ran out of elements"

253+runTest (Free (NewUUID f)) = do

254+ word8s <- gets stWord8Store

255+ case word8s of

256+ -- note we use f' because f is a param of the function

257+ a:b:c:d:e:f':g:h:i:j:k:l:m:n:o:p:remaining -> do

258+ modify $ \st -> st { stWord8Store = remaining }

259+ return (UUID a b c d e f' g h i j k l m n o p) >>= runTest . f

260+ _ -> M.fail "word8 supply was not infinite"

261+runTest (Free (ReadFileStrict fp f)) = do

262+ fps <- asks envFiles

263+ case lookup fp fps of

264+ Just bs -> return bs >>= runTest . f

265+ Nothing -> error "openFile: does not exist"

266+runTest (Free (ReadFileLazy fp f)) = do

267+ fps <- asks envFiles

268+ case lookup fp fps of

269+ Just bs -> return (BL.fromStrict bs) >>= runTest . f

270+ Nothing -> error "openFile: does not exist"

271+runTest (Free (ReadFileUTF8 fp f)) = do

272+ fps <- asks envFiles

273+ case lookup fp fps of

274+ Just bs -> return (UTF8.toString bs) >>= runTest . f

275+ Nothing -> error "openFile: does not exist"

276+-- A few different cases of readDataFile to reimplement, for when

277+-- there is no filepath and it falls through to readDefaultDataFile

278+runTest (Free (ReadDataFile Nothing "reference.docx" f)) = do

279+ (B.concat . BL.toChunks . fromArchive) <$>

280+ (runTest $ getDefaultReferenceDocx Nothing) >>=

281+ runTest . f

282+runTest (Free (ReadDataFile Nothing "reference.odt" f)) = do

283+ (B.concat . BL.toChunks . fromArchive) <$>

284+ (runTest $ getDefaultReferenceODT Nothing) >>=

285+ runTest . f

286+runTest (Free (ReadDataFile Nothing fname f)) = do

287+ let fname' = if fname == "MANUAL.txt" then fname else "data" </> fname

288+ runTest (readFileStrict fname') >>= runTest . f

289+runTest (Free (ReadDataFile (Just userDir) fname f)) = do

290+ userDirFiles <- asks envUserDataDir

291+ case lookup (userDir </> fname) userDirFiles of

292+ Just bs -> return bs >>= runTest . f

293+ Nothing -> runTest (readDataFile Nothing fname) >>= runTest . f

294+runTest (Free (Fail s)) = M.fail s

295+runTest (Free (FetchItem _ fp f)) = do

296+ fps <- asks envFiles

297+ case lookup fp fps of

298+ Just bs -> return (Right (bs, getMimeType fp)) >>= runTest . f

299+ Nothing -> return (Left $ E.toException TestException) >>= runTest . f

300+runTest (Free (FetchItem' media sourceUrl nm f)) = do

301+ case lookupMedia nm media of

302+ Nothing -> runTest (fetchItem sourceUrl nm) >>= runTest . f

303+ Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime)) >>= runTest . f

304+runTest (Free (Warn s nxt)) = do

305+ modify $ \st -> st { stWarnings = s : stWarnings st }

306+ runTest nxt

307+runTest (Free (Glob s f)) = do

308+ fontFiles <- asks envFontFiles

309+ return (filter (match (compile s)) fontFiles) >>= runTest . f

310+runTest (Pure r) = return r

311+

312+

313+

src/Text/Pandoc/UUID.hs+1−1

@@ -29,7 +29,7 @@ UUID generation using Version 4 (random method) described

29in RFC4122. See http://tools.ietf.org/html/rfc4122

30-}

32−module Text.Pandoc.UUID ( UUID, getRandomUUID ) where

32+module Text.Pandoc.UUID ( UUID(..), getRandomUUID ) where

34import Text.Printf ( printf )

35import System.Random ( randomIO )

src/Text/Pandoc/Writers/Docx.hs+37−28

@@ -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,8 +56,7 @@ import Text.Pandoc.Readers.Docx.Util (elemName)

57import Control.Monad.Reader

56import Control.Monad.Reader

58import Control.Monad.State

57import Control.Monad.State

59import Text.Highlighting.Kate

58import Text.Highlighting.Kate

60−import Data.Unique (hashUnique, newUnique)

61−import System.Random (randomRIO)

59+import System.Random (randomR)

62import Text.Printf (printf)

60import Text.Printf (printf)

63import qualified Control.Exception as E

61import qualified Control.Exception as E

64import Data.Monoid ((<>))

62import Data.Monoid ((<>))

@@ -67,6 +65,8 @@ import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,

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

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

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

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

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

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

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

69+import qualified Text.Pandoc.Free as P

71data ListMarker = NoMarker

72 | BulletMarker

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

146 , stDynamicTextProps = []

147 }

148

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

149+type WS = ReaderT WriterEnv (StateT WriterState (PandocAction))

150

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

152mknode s attrs =

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

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

214metaValueToInlines _ = []

215

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

216+

217+

217writeDocx :: WriterOptions -- ^ Writer options

218writeDocx :: WriterOptions -- ^ Writer options

218 -> Pandoc -- ^ Document to convert

219 -> Pandoc -- ^ Document to convert

219 -> IO BL.ByteString

220 -> IO BL.ByteString

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

221+writeDocx opts doc = runIO $ writeDocxPure opts doc

222+

223+

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

225+writeDocxPure :: WriterOptions -- ^ Writer options

226+ -> Pandoc -- ^ Document to convert

227+ -> PandocAction BL.ByteString

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

221 let datadir = writerUserDataDir opts

229 let datadir = writerUserDataDir opts

222 let doc' = walk fixDisplayMath $ doc

230 let doc' = walk fixDisplayMath $ doc

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

231+ username <- P.lookupEnv "USERNAME"

224− utctime <- getCurrentTime

232+ utctime <- P.getCurrentTime

225− distArchive <- getDefaultReferenceDocx datadir

233+ distArchive <- P.getDefaultReferenceDocx datadir

226 refArchive <- case writerReferenceDocx opts of

234 refArchive <- case writerReferenceDocx opts of

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

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

228− Nothing -> getDefaultReferenceDocx datadir

236+ Nothing -> P.getDefaultReferenceDocx datadir

229

237

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

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

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

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

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

603 $ backgroundColor style )

611 $ backgroundColor style )

604 ]

612 ]

605

613

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

614+copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> PandocAction Entry

607copyChildren refArchive distArchive path timestamp elNames = do

615copyChildren refArchive distArchive path timestamp elNames = do

608 ref <- parseXml refArchive distArchive path

616 ref <- parseXml refArchive distArchive path

609 dist <- parseXml distArchive distArchive path

617 dist <- parseXml distArchive distArchive path

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

622baseListId :: Int

630baseListId :: Int

623baseListId = 1000

631baseListId = 1000

624

632

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

633+mkNumbering :: [ListMarker] -> PandocAction [Element]

626mkNumbering lists = do

634mkNumbering lists = do

627 elts <- mapM mkAbstractNum (ordNub lists)

635 elts <- mapM mkAbstractNum (ordNub lists)

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

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

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

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

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

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

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

640

648

641−mkAbstractNum :: ListMarker -> IO Element

649+mkAbstractNum :: ListMarker -> PandocAction Element

642mkAbstractNum marker = do

650mkAbstractNum marker = do

651+ gen <- P.newStdGen

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

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

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

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

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

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

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

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

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

695getNumId :: WS Int

704getNumId :: WS Int

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

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

697

706

707+

698makeTOC :: WriterOptions -> WS [Element]

708makeTOC :: WriterOptions -> WS [Element]

699makeTOC opts | writerTableOfContents opts = do

709makeTOC opts | writerTableOfContents opts = do

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

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

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

781 let sty' = getStyleId styleName $ sCharStyleMap styleMaps

791 let sty' = getStyleId styleName $ sCharStyleMap styleMaps

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

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

783

793

784−getUniqueId :: MonadIO m => m String

794+getUniqueId :: PandocAction String

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

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

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

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

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

797+getUniqueId = (show . (+ 20)) <$> P.newUniqueHash

788

798

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

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

790dynamicStyleKey :: String

800dynamicStyleKey :: String

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

825 then uniqueIdent lst usedIdents

835 then uniqueIdent lst usedIdents

826 else ident

836 else ident

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

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

828− id' <- getUniqueId

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

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

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

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

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

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

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

@@ -1133,7 +1143,7 @@ inlineToOpenXML' opts (Code attrs str) = do

1133 else unhighlighted

1143 else unhighlighted

1134inlineToOpenXML' opts (Note bs) = do

1144inlineToOpenXML' opts (Note bs) = do

1135 notes <- gets stFootnotes

1145 notes <- gets stFootnotes

1136− notenum <- getUniqueId

1146+ notenum <- (lift . lift) getUniqueId

1137 footnoteStyle <- rStyleM "Footnote Reference"

1147 footnoteStyle <- rStyleM "Footnote Reference"

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

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

1139 [ mknode "w:rPr" [] footnoteStyle

1149 [ mknode "w:rPr" [] footnoteStyle

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

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

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

1165 Just i -> return i

1175 Just i -> return i

1166 Nothing -> do

1176 Nothing -> do

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

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

1168 modify $ \st -> st{ stExternalLinks =

1178 modify $ \st -> st{ stExternalLinks =

1169 M.insert src i extlinks }

1179 M.insert src i extlinks }

1170 return i

1180 return i

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

1176 case M.lookup src imgs of

1186 case M.lookup src imgs of

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

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

1178 Nothing -> do

1188 Nothing -> do

1179− res <- liftIO $

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

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

1181 case res of

1190 case res of

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

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

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

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

1184 -- emit alt text

1193 -- emit alt text

1185 inlinesToOpenXML opts alt

1194 inlinesToOpenXML opts alt

1186 Right (img, mt) -> do

1195 Right (img, mt) -> do

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

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

1188 let (xpt,ypt) = desiredSizeInPoints opts attr

1197 let (xpt,ypt) = desiredSizeInPoints opts attr

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

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

1190 -- 12700 emu = 1 pt

1199 -- 12700 emu = 1 pt

@@ -1262,13 +1271,13 @@ defaultFootnotes = [ mknode "w:footnote"

1262 [ mknode "w:r" [] $

1271 [ mknode "w:r" [] $

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

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

1264

1273

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

1274+parseXml :: Archive -> Archive -> String -> PandocAction Element

1266parseXml refArchive distArchive relpath =

1275parseXml refArchive distArchive relpath =

1267 case findEntryByPath relpath refArchive `mplus`

1276 case findEntryByPath relpath refArchive `mplus`

1268 findEntryByPath relpath distArchive of

1277 findEntryByPath relpath distArchive of

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

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

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

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

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

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

1272 Just d -> return d

1281 Just d -> return d

1273

1282

1274-- | Scales the image to fit the page

1283-- | Scales the image to fit the page

src/Text/Pandoc/Writers/EPUB.hs+77−61

@@ -28,26 +28,22 @@ 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 )

33import qualified Data.Map as M

32import qualified Data.Map as M

34import qualified Data.Set as Set

33import qualified Data.Set as Set

35import Data.Maybe ( fromMaybe, catMaybes )

34import Data.Maybe ( fromMaybe, catMaybes )

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

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

37−import System.Environment ( getEnv )

38import Text.Printf (printf)

36import Text.Printf (printf)

39import System.FilePath ( takeExtension, takeFileName )

37import System.FilePath ( takeExtension, takeFileName )

40−import System.FilePath.Glob ( namesMatching )

41import Network.HTTP ( urlEncode )

38import Network.HTTP ( urlEncode )

42import qualified Data.ByteString.Lazy as B

39import qualified Data.ByteString.Lazy as B

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

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

44import qualified Text.Pandoc.UTF8 as UTF8

41import qualified Text.Pandoc.UTF8 as UTF8

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

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

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

47import Text.Pandoc.Compat.Time

43import Text.Pandoc.Compat.Time

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

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

49− , normalizeDate, readDataFile, stringify, warn

45+ , normalizeDate, stringify

50− , hierarchicalize, fetchItem' )

46+ , hierarchicalize )

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

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

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

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

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

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

@@ -57,18 +53,18 @@ import Text.Pandoc.Options ( WriterOptions(..)

57 , ObfuscationMethod(NoObfuscation) )

53 , ObfuscationMethod(NoObfuscation) )

58import Text.Pandoc.Definition

54import Text.Pandoc.Definition

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

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

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

56+import Control.Monad.State (modify, get, gets, State, StateT, put, evalState, evalStateT, lift)

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

57+import Control.Monad (mplus, when)

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

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

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

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

64 , onlyElems, node, ppElement)

60 , onlyElems, node, ppElement)

65−import Text.Pandoc.UUID (getRandomUUID)

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

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

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

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

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

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

69−import qualified Control.Exception as E

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

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

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

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

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

67+import qualified Text.Pandoc.Free as P

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

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

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

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

@@ -76,6 +72,11 @@ import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)

76-- in filenames, chapter0003.xhtml.

72-- in filenames, chapter0003.xhtml.

77data Chapter = Chapter (Maybe [Int]) [Block]

73data Chapter = Chapter (Maybe [Int]) [Block]

75+data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]

76+ }

77+

78+type E = StateT EPUBState PandocAction

79+

79data EPUBMetadata = EPUBMetadata{

80data EPUBMetadata = EPUBMetadata{

80 epubIdentifier :: [Identifier]

81 epubIdentifier :: [Identifier]

81 , epubTitle :: [Title]

82 , epubTitle :: [Title]

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

143removeNote (Note _) = Str ""

144removeNote (Note _) = Str ""

144removeNote x = x

145removeNote x = x

145

146

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

147+getEPUBMetadata :: WriterOptions -> Meta -> E EPUBMetadata

147getEPUBMetadata opts meta = do

148getEPUBMetadata opts meta = do

148 let md = metadataFromMeta opts meta

149 let md = metadataFromMeta opts meta

149 let elts = onlyElems $ parseXML $ writerEpubMetadata opts

150 let elts = onlyElems $ parseXML $ writerEpubMetadata opts

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

151 let addIdentifier m =

152 let addIdentifier m =

152 if null (epubIdentifier m)

153 if null (epubIdentifier m)

153 then do

154 then do

154− randomId <- fmap show getRandomUUID

155+ randomId <- fmap show (lift P.newUUID)

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

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

156 else return m

157 else return m

157 let addLanguage m =

158 let addLanguage m =

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

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

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

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

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

161 Nothing -> do

162 Nothing -> do

162− localeLang <- E.catch (liftM

163+ mLang <- lift $ P.lookupEnv "LANG"

164+ let localeLang =

165+ case mLang of

166+ Just lang ->

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

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

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

168+ takeWhile (/='.') lang

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

169+ Nothing -> "en-US"

166 return m{ epubLanguage = localeLang }

170 return m{ epubLanguage = localeLang }

167 else return m

171 else return m

168 let fixDate m =

172 let fixDate m =

169 if null (epubDate m)

173 if null (epubDate m)

170 then do

174 then do

171− currentTime <- getCurrentTime

175+ currentTime <- lift P.getCurrentTime

172 return $ m{ epubDate = [ Date{

176 return $ m{ epubDate = [ Date{

173 dateText = showDateTimeISO8601 currentTime

177 dateText = showDateTimeISO8601 currentTime

174 , dateEvent = Nothing } ] }

178 , dateEvent = Nothing } ] }

@@ -333,10 +337,24 @@ metadataFromMeta opts meta = EPUBMetadata{

333writeEPUB :: WriterOptions -- ^ Writer options

337writeEPUB :: WriterOptions -- ^ Writer options

334 -> Pandoc -- ^ Document to convert

338 -> Pandoc -- ^ Document to convert

335 -> IO B.ByteString

339 -> IO B.ByteString

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

340+writeEPUB opts doc = runIO $ writeEPUBPure opts doc

341+

342+writeEPUBPure :: WriterOptions -- ^ Writer options

343+ -> Pandoc -- ^ Document to convert

344+ -> PandocAction B.ByteString

345+writeEPUBPure opts doc =

346+ let initState = EPUBState { stMediaPaths = []

347+ }

348+ in

349+ evalStateT (pandocToEPUB opts doc) initState

350+

351+pandocToEPUB :: WriterOptions

352+ -> Pandoc

353+ -> E B.ByteString

354+pandocToEPUB opts doc@(Pandoc meta _) = do

337 let version = fromMaybe EPUB2 (writerEpubVersion opts)

355 let version = fromMaybe EPUB2 (writerEpubVersion opts)

338 let epub3 = version == EPUB3

356 let epub3 = version == EPUB3

339− epochtime <- floor `fmap` getPOSIXTime

357+ epochtime <- floor <$> lift P.getPOSIXTime

340 let mkEntry path content = toEntry path epochtime content

358 let mkEntry path content = toEntry path epochtime content

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

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

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

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

@@ -362,7 +380,7 @@ writeEPUB opts doc@(Pandoc meta _) = do

362 let cpContent = renderHtml $ writeHtml

380 let cpContent = renderHtml $ writeHtml

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

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

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

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

365− imgContent <- B.readFile img

383+ imgContent <- lift $ P.readFileLazy img

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

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

367 , [mkEntry coverImage imgContent] )

385 , [mkEntry coverImage imgContent] )

368

386

@@ -373,18 +391,17 @@ writeEPUB opts doc@(Pandoc meta _) = do

373 let tpEntry = mkEntry "title_page.xhtml" tpContent

391 let tpEntry = mkEntry "title_page.xhtml" tpContent

374

392

375 -- handle pictures

393 -- handle pictures

376− mediaRef <- newIORef []

394+ -- mediaRef <- P.newIORef []

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

395+ Pandoc _ blocks <- walkM (transformInline opts') doc >>=

378− walkM (transformBlock opts' mediaRef)

396+ walkM (transformBlock opts')

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

397+ picEntries <- (catMaybes . map (snd . snd)) <$> (gets stMediaPaths)

380−

381 -- handle fonts

398 -- handle fonts

382 let matchingGlob f = do

399 let matchingGlob f = do

383− xs <- namesMatching f

400+ xs <- lift $ P.glob f

384 when (null xs) $

401 when (null xs) $

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

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

386 return xs

403 return xs

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

404+ let mkFontEntry f = mkEntry (takeFileName f) `fmap` (lift $ P.readFileLazy f)

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

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

389 fontEntries <- mapM mkFontEntry fontFiles

406 fontEntries <- mapM mkFontEntry fontFiles

390

407

@@ -521,7 +538,7 @@ writeEPUB opts doc@(Pandoc meta _) = do

521 let uuid = case epubIdentifier metadata of

538 let uuid = case epubIdentifier metadata of

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

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

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

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

524− currentTime <- getCurrentTime

541+ currentTime <- lift $ P.getCurrentTime

525 let contentsData = UTF8.fromStringLazy $ ppTopElement $

542 let contentsData = UTF8.fromStringLazy $ ppTopElement $

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

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

527 EPUB2 -> "2.0"

544 EPUB2 -> "2.0"

@@ -693,10 +710,10 @@ writeEPUB opts doc@(Pandoc meta _) = do

693

710

694 -- stylesheet

711 -- stylesheet

695 stylesheet <- case epubStylesheet metadata of

712 stylesheet <- case epubStylesheet metadata of

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

713+ Just (StylesheetPath fp) -> lift $ P.readFileUTF8 fp

697 Just (StylesheetContents s) -> return s

714 Just (StylesheetContents s) -> return s

698 Nothing -> UTF8.toString `fmap`

715 Nothing -> UTF8.toString `fmap`

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

716+ (lift $ P.readDataFile (writerUserDataDir opts) "epub.css")

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

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

701

718

702 -- construct archive

719 -- construct archive

@@ -813,78 +830,77 @@ showDateTimeISO8601 :: UTCTime -> String

813showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"

830showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"

814

831

815transformTag :: WriterOptions

832transformTag :: WriterOptions

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

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

817 -> Tag String

834 -> Tag String

818− -> IO (Tag String)

835+ -> E (Tag String)

819−transformTag opts mediaRef tag@(TagOpen name attr)

836+transformTag opts tag@(TagOpen name attr)

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

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

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

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

822 let src = fromAttrib "src" tag

839 let src = fromAttrib "src" tag

823 let poster = fromAttrib "poster" tag

840 let poster = fromAttrib "poster" tag

824− newsrc <- modifyMediaRef opts mediaRef src

841+ newsrc <- modifyMediaRef opts src

825− newposter <- modifyMediaRef opts mediaRef poster

842+ newposter <- modifyMediaRef opts poster

826 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++

843 let attr' = filter (\(x,_) -> x /= "src" && x /= "poster") attr ++

827 [("src", newsrc) | not (null newsrc)] ++

844 [("src", newsrc) | not (null newsrc)] ++

828 [("poster", newposter) | not (null newposter)]

845 [("poster", newposter) | not (null newposter)]

829 return $ TagOpen name attr'

846 return $ TagOpen name attr'

830−transformTag _ _ tag = return tag

847+transformTag _ tag = return tag

831

848

832modifyMediaRef :: WriterOptions

849modifyMediaRef :: WriterOptions

833− -> IORef [(FilePath, (FilePath, Maybe Entry))]

834 -> FilePath

850 -> FilePath

835− -> IO FilePath

851+ -> E FilePath

836−modifyMediaRef _ _ "" = return ""

852+modifyMediaRef _ "" = return ""

837−modifyMediaRef opts mediaRef oldsrc = do

853+modifyMediaRef opts oldsrc = do

838− media <- readIORef mediaRef

854+ media <- gets stMediaPaths

839 case lookup oldsrc media of

855 case lookup oldsrc media of

840 Just (n,_) -> return n

856 Just (n,_) -> return n

841 Nothing -> do

857 Nothing -> do

842− res <- fetchItem' (writerMediaBag opts)

858+ res <- lift $ P.fetchItem' (writerMediaBag opts)

843 (writerSourceURL opts) oldsrc

859 (writerSourceURL opts) oldsrc

844 (new, mbEntry) <-

860 (new, mbEntry) <-

845 case res of

861 case res of

846 Left _ -> do

862 Left _ -> do

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

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

848 return (oldsrc, Nothing)

864 return (oldsrc, Nothing)

849 Right (img,mbMime) -> do

865 Right (img,mbMime) -> do

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

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

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

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

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

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

853− epochtime <- floor `fmap` getPOSIXTime

869+ epochtime <- floor `fmap` lift P.getPOSIXTime

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

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

855 return (new, Just entry)

871 return (new, Just entry)

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

872+ modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}

857 return new

873 return new

858

874

859transformBlock :: WriterOptions

875transformBlock :: WriterOptions

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

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

861 -> Block

877 -> Block

862− -> IO Block

878+ -> E Block

863−transformBlock opts mediaRef (RawBlock fmt raw)

879+transformBlock opts (RawBlock fmt raw)

864 | fmt == Format "html" = do

880 | fmt == Format "html" = do

865 let tags = parseTags raw

881 let tags = parseTags raw

866− tags' <- mapM (transformTag opts mediaRef) tags

882+ tags' <- mapM (transformTag opts) tags

867 return $ RawBlock fmt (renderTags' tags')

883 return $ RawBlock fmt (renderTags' tags')

868−transformBlock _ _ b = return b

884+transformBlock _ b = return b

869

885

870transformInline :: WriterOptions

886transformInline :: WriterOptions

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

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

872 -> Inline

888 -> Inline

873− -> IO Inline

889+ -> E Inline

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

890+transformInline opts (Image attr lab (src,tit)) = do

875− newsrc <- modifyMediaRef opts mediaRef src

891+ newsrc <- modifyMediaRef opts src

876 return $ Image attr lab (newsrc, tit)

892 return $ Image attr lab (newsrc, tit)

877−transformInline opts mediaRef (x@(Math t m))

893+transformInline opts (x@(Math t m))

878 | WebTeX url <- writerHTMLMathMethod opts = do

894 | WebTeX url <- writerHTMLMathMethod opts = do

879− newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m)

895+ newsrc <- modifyMediaRef opts (url ++ urlEncode m)

880 let mathclass = if t == DisplayMath then "display" else "inline"

896 let mathclass = if t == DisplayMath then "display" else "inline"

881 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]

897 return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")]

882−transformInline opts mediaRef (RawInline fmt raw)

898+transformInline opts (RawInline fmt raw)

883 | fmt == Format "html" = do

899 | fmt == Format "html" = do

884 let tags = parseTags raw

900 let tags = parseTags raw

885− tags' <- mapM (transformTag opts mediaRef) tags

901+ tags' <- mapM (transformTag opts) tags

886 return $ RawInline fmt (renderTags' tags')

902 return $ RawInline fmt (renderTags' tags')

887−transformInline _ _ x = return x

903+transformInline _ x = return x

888

904

889(!) :: (t -> Element) -> [(String, String)] -> t -> Element

905(!) :: (t -> Element) -> [(String, String)] -> t -> Element

890(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)

906(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)

src/Text/Pandoc/Writers/FB2.hs+82−95

@@ -25,29 +25,28 @@ FictionBook is an XML-based e-book format. For more information see:

25<http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1>

27-}

28−module Text.Pandoc.Writers.FB2 (writeFB2) where

28+module Text.Pandoc.Writers.FB2 (writeFB2, writeFB2Pure) where

30−import Control.Monad.State (StateT, evalStateT, get, modify)

30+import Control.Monad.State (StateT, evalStateT, get, modify, lift)

31−import Control.Monad.State (liftM, liftM2, liftIO)

31+import Control.Monad.State (liftM)

32import Data.ByteString.Base64 (encode)

33import Data.Char (toLower, isSpace, isAscii, isControl)

34import Data.List (intersperse, intercalate, isPrefixOf, stripPrefix)

35import Data.Either (lefts, rights)

36−import Network.Browser (browse, request, setAllowRedirects, setOutHandler)

36+import Network.HTTP (urlEncode)

37−import Network.HTTP (catchIO_, getRequest, getHeaders, getResponseBody)

38−import Network.HTTP (lookupHeader, HeaderName(..), urlEncode)

39−import Network.URI (isURI, unEscapeString)

37+import Network.URI (isURI)

40−import System.FilePath (takeExtension)

41import Text.XML.Light

38import Text.XML.Light

42−import qualified Control.Exception as E

43−import qualified Data.ByteString as B

44import qualified Text.XML.Light as X

39import qualified Text.XML.Light as X

45import qualified Text.XML.Light.Cursor as XC

40import qualified Text.XML.Light.Cursor as XC

41+import qualified Data.ByteString.Char8 as B8

42+

47import Text.Pandoc.Definition

44import Text.Pandoc.Definition

48import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)

45import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)

49import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,

46import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,

50 linesToPara)

47 linesToPara)

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

49+import qualified Text.Pandoc.Free as P

52-- | Data to be written at the end of the document:

51-- | Data to be written at the end of the document:

53-- (foot)notes, URLs, references, images.

52-- (foot)notes, URLs, references, images.

@@ -60,7 +59,7 @@ data FbRenderState = FbRenderState

60 } deriving (Show)

59 } deriving (Show)

62-- | FictionBook building monad.

61-- | FictionBook building monad.

63−type FBM = StateT FbRenderState IO

62+type FBM = StateT FbRenderState PandocAction

65newFB :: FbRenderState

64newFB :: FbRenderState

66newFB = FbRenderState { footnotes = [], imagesToFetch = []

65newFB = FbRenderState { footnotes = [], imagesToFetch = []

@@ -76,14 +75,24 @@ instance Show ImageMode where

76writeFB2 :: WriterOptions -- ^ conversion options

75writeFB2 :: WriterOptions -- ^ conversion options

77 -> Pandoc -- ^ document to convert

76 -> Pandoc -- ^ document to convert

78 -> IO String -- ^ FictionBook2 document (not encoded yet)

77 -> IO String -- ^ FictionBook2 document (not encoded yet)

78+writeFB2 opts doc = runIO $ writeFB2Pure opts doc

79+

80+writeFB2Pure :: WriterOptions

81+ -> Pandoc

82+ -> PandocAction String

83+writeFB2Pure opts doc = flip evalStateT newFB $ pandocToFB2 opts doc

84+

85+pandocToFB2 :: WriterOptions

86+ -> Pandoc

87+ -> FBM String

79−writeFB2 opts (Pandoc meta blocks) = flip evalStateT newFB $ do

88+pandocToFB2 opts (Pandoc meta blocks) = do

80 modify (\s -> s { writerOptions = opts { writerStandalone = True } })

89 modify (\s -> s { writerOptions = opts { writerStandalone = True } })

81 desc <- description meta

90 desc <- description meta

82 fp <- frontpage meta

91 fp <- frontpage meta

83 secs <- renderSections 1 blocks

92 secs <- renderSections 1 blocks

84 let body = el "body" $ fp ++ secs

93 let body = el "body" $ fp ++ secs

85 notes <- renderFootnotes

94 notes <- renderFootnotes

86− (imgs,missing) <- liftM imagesToFetch get >>= \s -> liftIO (fetchImages s)

95+ (imgs,missing) <- liftM imagesToFetch get >>= \s -> lift (fetchImages s)

87 let body' = replaceImagesWithAlt missing body

96 let body' = replaceImagesWithAlt missing body

88 let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)

97 let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)

89 return $ xml_head ++ (showContent fb2_xml) ++ "\n"

98 return $ xml_head ++ (showContent fb2_xml) ++ "\n"

@@ -94,53 +103,58 @@ writeFB2 opts (Pandoc meta blocks) = flip evalStateT newFB $ do

94 xlink = "http://www.w3.org/1999/xlink"

103 xlink = "http://www.w3.org/1999/xlink"

95 in [ uattr "xmlns" xmlns

104 in [ uattr "xmlns" xmlns

96 , attr ("xmlns", "l") xlink ]

105 , attr ("xmlns", "l") xlink ]

97− --

106+

98− frontpage :: Meta -> FBM [Content]

107+frontpage :: Meta -> FBM [Content]

99− frontpage meta' = do

108+frontpage meta' = do

100− t <- cMapM toXml . docTitle $ meta'

109+ t <- cMapM toXml . docTitle $ meta'

101− return $

110+ return $

102− [ el "title" (el "p" t)

111+ [ el "title" (el "p" t)

103− , el "annotation" (map (el "p" . cMap plain)

112+ , el "annotation" (map (el "p" . cMap plain)

104− (docAuthors meta' ++ [docDate meta']))

113+ (docAuthors meta' ++ [docDate meta']))

105− ]

114+ ]

115+

106− description :: Meta -> FBM Content

116+description :: Meta -> FBM Content

107− description meta' = do

117+description meta' = do

108− bt <- booktitle meta'

118+ bt <- booktitle meta'

109− let as = authors meta'

119+ let as = authors meta'

110− dd <- docdate meta'

120+ dd <- docdate meta'

111− return $ el "description"

121+ return $ el "description"

112− [ el "title-info" (bt ++ as ++ dd)

122+ [ el "title-info" (bt ++ as ++ dd)

113− , el "document-info" [ el "program-used" "pandoc" ] -- FIXME: +version

123+ , el "document-info" [ el "program-used" "pandoc" ] -- FIXME: +version

114− ]

124+ ]

125+

115− booktitle :: Meta -> FBM [Content]

126+booktitle :: Meta -> FBM [Content]

116− booktitle meta' = do

127+booktitle meta' = do

117− t <- cMapM toXml . docTitle $ meta'

128+ t <- cMapM toXml . docTitle $ meta'

118− return $ if null t

129+ return $ if null t

119− then []

130+ then []

120− else [ el "book-title" t ]

131+ else [ el "book-title" t ]

132+

121− authors :: Meta -> [Content]

133+authors :: Meta -> [Content]

122− authors meta' = cMap author (docAuthors meta')

134+authors meta' = cMap author (docAuthors meta')

135+

123− author :: [Inline] -> [Content]

136+author :: [Inline] -> [Content]

124− author ss =

137+author ss =

125− let ws = words . cMap plain $ ss

138+ let ws = words . cMap plain $ ss

126− email = (el "email") `fmap` (take 1 $ filter ('@' `elem`) ws)

139+ email = (el "email") `fmap` (take 1 $ filter ('@' `elem`) ws)

127− ws' = filter ('@' `notElem`) ws

140+ ws' = filter ('@' `notElem`) ws

128− names = case ws' of

141+ names = case ws' of

129− (nickname:[]) -> [ el "nickname" nickname ]

142+ (nickname:[]) -> [ el "nickname" nickname ]

130− (fname:lname:[]) -> [ el "first-name" fname

143+ (fname:lname:[]) -> [ el "first-name" fname

131− , el "last-name" lname ]

144+ , el "last-name" lname ]

132− (fname:rest) -> [ el "first-name" fname

145+ (fname:rest) -> [ el "first-name" fname

133− , el "middle-name" (concat . init $ rest)

146+ , el "middle-name" (concat . init $ rest)

134− , el "last-name" (last rest) ]

147+ , el "last-name" (last rest) ]

135− ([]) -> []

148+ ([]) -> []

136− in list $ el "author" (names ++ email)

149+ in list $ el "author" (names ++ email)

150+

137− docdate :: Meta -> FBM [Content]

151+docdate :: Meta -> FBM [Content]

138− docdate meta' = do

152+docdate meta' = do

139− let ss = docDate meta'

153+ let ss = docDate meta'

140− d <- cMapM toXml ss

154+ d <- cMapM toXml ss

141− return $ if null d

155+ return $ if null d

142− then []

156+ then []

143− else [el "date" d]

157+ else [el "date" d]

144

158

145-- | Divide the stream of blocks into sections and convert to XML

159-- | Divide the stream of blocks into sections and convert to XML

146-- representation.

160-- representation.

@@ -210,14 +224,14 @@ renderFootnotes = do

210

224

211-- | Fetch images and encode them for the FictionBook XML.

225-- | Fetch images and encode them for the FictionBook XML.

212-- Return image data and a list of hrefs of the missing images.

226-- Return image data and a list of hrefs of the missing images.

213−fetchImages :: [(String,String)] -> IO ([Content],[String])

227+fetchImages :: [(String,String)] -> PandocAction ([Content],[String])

214fetchImages links = do

228fetchImages links = do

215 imgs <- mapM (uncurry fetchImage) links

229 imgs <- mapM (uncurry fetchImage) links

216 return $ (rights imgs, lefts imgs)

230 return $ (rights imgs, lefts imgs)

217

231

218-- | Fetch image data from disk or from network and make a <binary> XML section.

232-- | Fetch image data from disk or from network and make a <binary> XML section.

219-- Return either (Left hrefOfMissingImage) or (Right xmlContent).

233-- Return either (Left hrefOfMissingImage) or (Right xmlContent).

220−fetchImage :: String -> String -> IO (Either String Content)

234+fetchImage :: String -> String -> PandocAction (Either String Content)

221fetchImage href link = do

235fetchImage href link = do

222 mbimg <-

236 mbimg <-

223 case (isURI link, readDataURI link) of

237 case (isURI link, readDataURI link) of

@@ -227,16 +241,11 @@ fetchImage href link = do

227 then return (Just (mime',base64))

241 then return (Just (mime',base64))

228 else return Nothing

242 else return Nothing

229 (True, Just _) -> return Nothing -- not base64-encoded

243 (True, Just _) -> return Nothing -- not base64-encoded

230− (True, Nothing) -> fetchURL link

231− (False, _) -> do

244+ _ -> do

232− d <- nothingOnError $ B.readFile (unEscapeString link)

245+ response <- P.fetchItem Nothing link

233− let t = case map toLower (takeExtension link) of

246+ case response of

234− ".png" -> Just "image/png"

247+ Right (bs, Just mime) -> return $ Just (mime, B8.unpack $ encode bs)

235− ".jpg" -> Just "image/jpeg"

248+ _ -> return $ Nothing

236− ".jpeg" -> Just "image/jpeg"

237− ".jpe" -> Just "image/jpeg"

238− _ -> Nothing -- only PNG and JPEG are supported in FB2

239− return $ liftM2 (,) t (liftM (toStr . encode) d)

240 case mbimg of

249 case mbimg of

241 Just (imgtype, imgdata) -> do

250 Just (imgtype, imgdata) -> do

242 return . Right $ el "binary"

251 return . Right $ el "binary"

@@ -244,11 +253,7 @@ fetchImage href link = do

244 , uattr "content-type" imgtype]

253 , uattr "content-type" imgtype]

245 , txt imgdata )

254 , txt imgdata )

246 _ -> return (Left ('#':href))

255 _ -> return (Left ('#':href))

247− where

256+

248− nothingOnError :: (IO B.ByteString) -> (IO (Maybe B.ByteString))

249− nothingOnError action = liftM Just action `E.catch` omnihandler

250− omnihandler :: E.SomeException -> IO (Maybe B.ByteString)

251− omnihandler _ = return Nothing

252

257

253-- | Extract mime type and encoded data from the Data URI.

258-- | Extract mime type and encoded data from the Data URI.

254readDataURI :: String -- ^ URI

259readDataURI :: String -- ^ URI

@@ -286,24 +291,6 @@ isMimeType s =

286 valid c = isAscii c && not (isControl c) && not (isSpace c) &&

291 valid c = isAscii c && not (isControl c) && not (isSpace c) &&

287 c `notElem` "()<>@,;:\\\"/[]?="

292 c `notElem` "()<>@,;:\\\"/[]?="

288

293

289−-- | Fetch URL, return its Content-Type and binary data on success.

290−fetchURL :: String -> IO (Maybe (String, String))

291−fetchURL url = do

292− flip catchIO_ (return Nothing) $ do

293− r <- browse $ do

294− setOutHandler (const (return ()))

295− setAllowRedirects True

296− liftM snd . request . getRequest $ url

297− let content_type = lookupHeader HdrContentType (getHeaders r)

298− content <- liftM (Just . toStr . encode . toBS) . getResponseBody $ Right r

299− return $ liftM2 (,) content_type content

300−

301−toBS :: String -> B.ByteString

302−toBS = B.pack . map (toEnum . fromEnum)

303−

304−toStr :: B.ByteString -> String

305−toStr = map (toEnum . fromEnum) . B.unpack

306−

307footnoteID :: Int -> String

294footnoteID :: Int -> String

308footnoteID i = "n" ++ (show i)

295footnoteID i = "n" ++ (show i)

309

296

src/Text/Pandoc/Writers/ICML.hs+11−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,8 @@ 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, PandocAction)

32+import qualified Text.Pandoc.Free as P

32type Style = [String]

34type Style = [String]

33type Hyperlink = [(Int, String)]

35type Hyperlink = [(Int, String)]

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

40 , maxListDepth :: Int

42 , maxListDepth :: Int

41 }

43 }

43−type WS a = StateT WriterState IO a

45+type WS a = StateT WriterState PandocAction a

45defaultWriterState :: WriterState

47defaultWriterState :: WriterState

46defaultWriterState = WriterState{

48defaultWriterState = WriterState{

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

121footnoteName = "Footnote"

123footnoteName = "Footnote"

122citeName = "Cite"

124citeName = "Cite"

123

125

124−

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

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

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

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

128+writeICML opts doc = runIO $ writeICMLPure opts doc

129+

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

131+writeICMLPure :: WriterOptions -> Pandoc -> PandocAction String

127−writeICML opts (Pandoc meta blocks) = do

132+writeICMLPure opts (Pandoc meta blocks) = do

128 let colwidth = if writerWrapText opts == WrapAuto

133 let colwidth = if writerWrapText opts == WrapAuto

129 then Just $ writerColumns opts

134 then Just $ writerColumns opts

130 else Nothing

135 else Nothing

@@ -531,10 +536,10 @@ styleToStrAttr style =

531-- | Assemble an ICML Image.

536-- | Assemble an ICML Image.

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

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

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

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

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

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

535 imgS <- case res of

540 imgS <- case res of

536 Left (_) -> do

541 Left (_) -> do

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

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

538 return def

543 return def

539 Right (img, _) -> do

544 Right (img, _) -> do

540 case imageSize img of

545 case imageSize img of

src/Text/Pandoc/Writers/ODT.hs+45−25

@@ -28,8 +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

32−import Data.IORef

33import Data.List ( isPrefixOf )

32import Data.List ( isPrefixOf )

34import Data.Maybe ( fromMaybe )

33import Data.Maybe ( fromMaybe )

35import Text.XML.Light.Output

34import Text.XML.Light.Output

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

38import Text.Pandoc.UTF8 ( fromStringLazy )

37import Text.Pandoc.UTF8 ( fromStringLazy )

39import Codec.Archive.Zip

38import Codec.Archive.Zip

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

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

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

40+import Text.Pandoc.Shared ( stringify )

42− getDefaultReferenceODT )

43import Text.Pandoc.ImageSize

41import Text.Pandoc.ImageSize

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

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

45import Text.Pandoc.Definition

43import Text.Pandoc.Definition

@@ -47,31 +45,53 @@ import Text.Pandoc.Walk

47import Text.Pandoc.Writers.Shared ( fixDisplayMath )

45import Text.Pandoc.Writers.Shared ( fixDisplayMath )

48import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )

46import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )

49import Control.Monad (liftM)

47import Control.Monad (liftM)

48+import Control.Monad.State

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+data ODTState = ODTState { stEntries :: [Entry]

57+ }

58+

59+type O = StateT ODTState PandocAction

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

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

57writeODT :: WriterOptions -- ^ Writer options

62writeODT :: WriterOptions -- ^ Writer options

58 -> Pandoc -- ^ Document to convert

63 -> Pandoc -- ^ Document to convert

59 -> IO B.ByteString

64 -> IO B.ByteString

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

65+writeODT opts doc = runIO $ writeODTPure opts doc

66+

67+writeODTPure :: WriterOptions

68+ -> Pandoc

69+ -> PandocAction B.ByteString

70+writeODTPure opts doc =

71+ let initState = ODTState{ stEntries = []

72+ }

73+ in

74+ evalStateT (pandocToODT opts doc) initState

75+

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

77+pandocToODT :: WriterOptions -- ^ Writer options

78+ -> Pandoc -- ^ Document to convert

79+ -> O B.ByteString

80+pandocToODT opts doc@(Pandoc meta _) = do

61 let datadir = writerUserDataDir opts

81 let datadir = writerUserDataDir opts

62 let title = docTitle meta

82 let title = docTitle meta

63 refArchive <-

83 refArchive <-

64 case writerReferenceODT opts of

84 case writerReferenceODT opts of

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

85+ Just f -> liftM toArchive $ lift $ P.readFileLazy f

66− Nothing -> getDefaultReferenceODT datadir

86+ Nothing -> lift $ P.getDefaultReferenceODT datadir

67 -- handle formulas and pictures

87 -- handle formulas and pictures

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

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

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

89+ doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc

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

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

71− epochtime <- floor `fmap` getPOSIXTime

91+ epochtime <- floor `fmap` (lift P.getPOSIXTime)

72 let contentEntry = toEntry "content.xml" epochtime

92 let contentEntry = toEntry "content.xml" epochtime

73 $ fromStringLazy newContents

93 $ fromStringLazy newContents

74− picEntries <- readIORef picEntriesRef

94+ picEntries <- gets stEntries

75 let archive = foldr addEntryToArchive refArchive

95 let archive = foldr addEntryToArchive refArchive

76 $ contentEntry : picEntries

96 $ contentEntry : picEntries

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

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

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

126 return $ fromArchive archive''

146 return $ fromArchive archive''

127

147

128-- | transform both Image and Math elements

148-- | transform both Image and Math elements

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

149+transformPicMath :: WriterOptions ->Inline -> O Inline

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

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

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

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

132 case res of

152 case res of

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

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

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

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

135 return $ Emph lab

155 return $ Emph lab

136 Right (img, mbMimeType) -> do

156 Right (img, mbMimeType) -> do

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

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

138 Right s -> return $ sizeInPoints s

158 Right s -> return $ sizeInPoints s

139 Left msg -> do

159 Left msg -> do

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

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

141 src ++ "': " ++ msg

161 src ++ "': " ++ msg

142 return (100, 100)

162 return (100, 100)

143 let dims =

163 let dims =

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

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

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

156 Nothing -> Nothing

176 Nothing -> Nothing

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

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

158− entries <- readIORef entriesRef

178+ entries <- gets stEntries

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

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

160 (mbMimeType >>= extensionFromMimeType)

180 (mbMimeType >>= extensionFromMimeType)

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

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

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

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

163− epochtime <- floor `fmap` getPOSIXTime

183+ epochtime <- floor `fmap` (lift P.getPOSIXTime)

164 let entry = toEntry newsrc epochtime $ toLazy img

184 let entry = toEntry newsrc epochtime $ toLazy img

165− modifyIORef entriesRef (entry:)

185+ modify $ \st -> st{ stEntries = entry : entries }

166 return $ Image newattr lab (newsrc, t)

186 return $ Image newattr lab (newsrc, t)

167−transformPicMath _ entriesRef (Math t math) = do

187+transformPicMath _ (Math t math) = do

168− entries <- readIORef entriesRef

188+ entries <- gets stEntries

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

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

170 case writeMathML dt <$> readTeX math of

190 case writeMathML dt <$> readTeX math of

171 Left _ -> return $ Math t math

191 Left _ -> return $ Math t math

172 Right r -> do

192 Right r -> do

173 let conf = useShortEmptyTags (const False) defaultConfigPP

193 let conf = useShortEmptyTags (const False) defaultConfigPP

174 let mathml = ppcTopElement conf r

194 let mathml = ppcTopElement conf r

175− epochtime <- floor `fmap` getPOSIXTime

195+ epochtime <- floor `fmap` (lift $ P.getPOSIXTime)

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

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

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

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

178 let entry = toEntry fname epochtime (fromStringLazy mathml)

198 let entry = toEntry fname epochtime (fromStringLazy mathml)

179− modifyIORef entriesRef (entry:)

199+ modify $ \st -> st{ stEntries = entry : entries }

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

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

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

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

182 if t == DisplayMath

202 if t == DisplayMath

@@ -189,4 +209,4 @@ transformPicMath _ entriesRef (Math t math) = do

189 , ("xlink:show", "embed")

209 , ("xlink:show", "embed")

190 , ("xlink:actuate", "onLoad")]

210 , ("xlink:actuate", "onLoad")]

191

211

192−transformPicMath _ _ x = return x

212+transformPicMath _ x = return x

src/Text/Pandoc/Writers/RTF.hs+13−4

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

28Conversion of 'Pandoc' documents to RTF (rich text format).

29-}

30−module Text.Pandoc.Writers.RTF ( writeRTF, writeRTFWithEmbeddedImages ) where

30+module Text.Pandoc.Writers.RTF ( writeRTF

31+ , writeRTFWithEmbeddedImages

32+ , writeRTFWithEmbeddedImagesPure

33+ ) where

31import Text.Pandoc.Definition

34import Text.Pandoc.Definition

32import Text.Pandoc.Options

35import Text.Pandoc.Options

33import Text.Pandoc.Shared

36import Text.Pandoc.Shared

@@ -41,13 +44,15 @@ import qualified Data.ByteString as B

41import qualified Data.Map as M

44import qualified Data.Map as M

42import Text.Printf ( printf )

45import Text.Printf ( printf )

43import Text.Pandoc.ImageSize

46import Text.Pandoc.ImageSize

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

48+import qualified Text.Pandoc.Free as P

45-- | Convert Image inlines into a raw RTF embedded image, read from a file,

50-- | Convert Image inlines into a raw RTF embedded image, read from a file,

46-- or a MediaBag, or the internet.

51-- or a MediaBag, or the internet.

47-- If file not found or filetype not jpeg or png, leave the inline unchanged.

52-- If file not found or filetype not jpeg or png, leave the inline unchanged.

48−rtfEmbedImage :: WriterOptions -> Inline -> IO Inline

53+rtfEmbedImage :: WriterOptions -> Inline -> PandocAction Inline

49rtfEmbedImage opts x@(Image attr _ (src,_)) = do

54rtfEmbedImage opts x@(Image attr _ (src,_)) = do

50− result <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

55+ result <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

51 case result of

56 case result of

52 Right (imgdata, Just mime)

57 Right (imgdata, Just mime)

53 | mime == "image/jpeg" || mime == "image/png" -> do

58 | mime == "image/jpeg" || mime == "image/png" -> do

@@ -58,7 +63,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do

58 _ -> error "Unknown file type"

63 _ -> error "Unknown file type"

59 sizeSpec <- case imageSize imgdata of

64 sizeSpec <- case imageSize imgdata of

60 Left msg -> do

65 Left msg -> do

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

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

62 src ++ "': " ++ msg

67 src ++ "': " ++ msg

63 return ""

68 return ""

64 Right sz -> return $ "\\picw" ++ show xpx ++

69 Right sz -> return $ "\\picw" ++ show xpx ++

@@ -80,6 +85,10 @@ rtfEmbedImage _ x = return x

80-- images embedded as encoded binary data.

85-- images embedded as encoded binary data.

81writeRTFWithEmbeddedImages :: WriterOptions -> Pandoc -> IO String

86writeRTFWithEmbeddedImages :: WriterOptions -> Pandoc -> IO String

82writeRTFWithEmbeddedImages options doc =

87writeRTFWithEmbeddedImages options doc =

88+ runIO $ writeRTF options `fmap` walkM (rtfEmbedImage options) doc

89+

90+writeRTFWithEmbeddedImagesPure :: WriterOptions -> Pandoc -> PandocAction String

91+writeRTFWithEmbeddedImagesPure options doc =

83 writeRTF options `fmap` walkM (rtfEmbedImage options) doc

92 writeRTF options `fmap` walkM (rtfEmbedImage options) doc

85-- | Convert Pandoc to a string in rich text format.

94-- | Convert Pandoc to a string in rich text format.