32c68da · typeable/pandoc

git.iko.soy/typeable/pandoc

Introduce pure versions of IO Writers.

Using Text.Pandoc.Free, introduce pure versions of Docx, EPUB, ICML, and ODT writers. Each of the pure versions is exported along with the IO version (produced by running `runIO` on the pure reader). Ideally, this should make the writers easier to test.

commit32c68dada92eb142949c5be5224a3ddf20fcf484 authorJesse Rosenthal <jrosenthal@jhu.edu> dateSat 24 Sep 2016, 17:52 (10 years ago) parent0ab4af2

4 files changed+124−90

compare with master

unifiedsplit

src/Text/Pandoc/Writers/Docx.hs+39−27 src/Text/Pandoc/Writers/EPUB.hs+44−37 src/Text/Pandoc/Writers/ICML.hs+13−6 src/Text/Pandoc/Writers/ODT.hs+28−20

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

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

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

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

22{-

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

2828

2929Conversion of 'Pandoc' documents to docx.

3030-}

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

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

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

3333import qualified Data.ByteString as B

3434import qualified Data.ByteString.Lazy as BL

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

3838import qualified Text.Pandoc.UTF8 as UTF8

3939import Codec.Archive.Zip

4040import Data.Time.Clock.POSIX

41−import System.Environment

4241import Text.Pandoc.Compat.Time

4342import Text.Pandoc.Definition

4443import Text.Pandoc.Generic

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

5756import Control.Monad.State

5857import Skylighting

5958import Data.Unique (hashUnique, newUnique)

60−import System.Random (randomRIO)

59+import System.Random (randomR)

6160import Text.Printf (printf)

6261import qualified Control.Exception as E

6362import Data.Monoid ((<>))

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

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

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

6968import 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 ()

7073

7174data ListMarker = NoMarker

7275 | BulletMarker

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

146149 , stDynamicTextProps = []

147150 }

148151

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

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

150153

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

152155mknode s attrs =

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

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

214217metaValueToInlines _ = []

215218

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

219+

220+

217221writeDocx :: WriterOptions -- ^ Writer options

218222 -> Pandoc -- ^ Document to convert

219223 -> 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

221232 let datadir = writerUserDataDir opts

222233 let doc' = walk fixDisplayMath $ doc

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

224− utctime <- getCurrentTime

225− distArchive <- getDefaultReferenceDocx datadir

234+ username <- P.lookupEnv "USERNAME"

235+ utctime <- P.getCurrentTime

236+ distArchive <- P.getDefaultReferenceDocx datadir

226237 refArchive <- case writerReferenceDocx opts of

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

228− Nothing -> getDefaultReferenceDocx datadir

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

239+ Nothing -> P.getDefaultReferenceDocx datadir

229240

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

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

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

603614 $ backgroundColor style )

604615 ]

605616

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

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

607618copyChildren refArchive distArchive path timestamp elNames = do

608619 ref <- parseXml refArchive distArchive path

609620 dist <- parseXml distArchive distArchive path

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

622633baseListId :: Int

623634baseListId = 1000

624635

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

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

626637mkNumbering lists = do

627638 elts <- mapM mkAbstractNum (ordNub lists)

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

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

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

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

640651

641−mkAbstractNum :: ListMarker -> IO Element

652+mkAbstractNum :: ListMarker -> DocxAction Element

642653mkAbstractNum marker = do

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

654+ gen <- P.newStdGen

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

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

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

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

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

695707getNumId :: WS Int

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

697709

710+

698711makeTOC :: WriterOptions -> WS [Element]

699712makeTOC opts | writerTableOfContents opts = do

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

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

781794 let sty' = getStyleId styleName $ sCharStyleMap styleMaps

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

783796

784−getUniqueId :: MonadIO m => m String

797+getUniqueId :: DocxAction String

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

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

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

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

788801

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

790803dynamicStyleKey :: String

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

825838 then uniqueIdent lst usedIdents

826839 else ident

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

828− id' <- getUniqueId

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

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

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

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

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

11371150 else unhighlighted

11381151inlineToOpenXML' opts (Note bs) = do

11391152 notes <- gets stFootnotes

1140− notenum <- getUniqueId

1153+ notenum <- (lift . lift) getUniqueId

11411154 footnoteStyle <- rStyleM "Footnote Reference"

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

11431156 [ mknode "w:rPr" [] footnoteStyle

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

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

11691182 Just i -> return i

11701183 Nothing -> do

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

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

11721185 modify $ \st -> st{ stExternalLinks =

11731186 M.insert src i extlinks }

11741187 return i

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

11801193 case M.lookup src imgs of

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

11821195 Nothing -> do

1183− res <- liftIO $

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

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

11851197 case res of

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

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

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

11881200 -- emit alt text

11891201 inlinesToOpenXML opts alt

11901202 Right (img, mt) -> do

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

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

11921204 let (xpt,ypt) = desiredSizeInPoints opts attr

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

11941206 -- 12700 emu = 1 pt

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

12721284 [ mknode "w:r" [] $

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

12741286

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

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

12761288parseXml refArchive distArchive relpath =

12771289 case findEntryByPath relpath refArchive `mplus`

12781290 findEntryByPath relpath distArchive of

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

12801292 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"

12821294 Just d -> return d

12831295

12841296-- | 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

2828

2929Conversion of 'Pandoc' documents to EPUB.

3030-}

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

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

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

32+import Data.IORef ( IORef )

3333import qualified Data.Map as M

3434import qualified Data.Set as Set

3535import Data.Maybe ( fromMaybe, catMaybes )

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

37−import System.Environment ( getEnv )

3837import Text.Printf (printf)

3938import System.FilePath ( takeExtension, takeFileName )

40−import System.FilePath.Glob ( namesMatching )

4139import Network.HTTP ( urlEncode )

4240import qualified Data.ByteString.Lazy as B

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

4442import qualified Text.Pandoc.UTF8 as UTF8

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

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

4744import Text.Pandoc.Compat.Time

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

49− , normalizeDate, readDataFile, stringify, warn

50− , hierarchicalize, fetchItem' )

46+ , normalizeDate, stringify

47+ , hierarchicalize )

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

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

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

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

5855import Text.Pandoc.Definition

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

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

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

58+import Control.Monad (mplus, when)

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

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

6461 , onlyElems, node, ppElement)

65−import Text.Pandoc.UUID (getRandomUUID)

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

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

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

69−import qualified Control.Exception as E

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

7166import 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))]

7271

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

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

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

143142removeNote (Note _) = Str ""

144143removeNote x = x

145144

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

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

147146getEPUBMetadata opts meta = do

148147 let md = metadataFromMeta opts meta

149148 let elts = onlyElems $ parseXML $ writerEpubMetadata opts

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

151150 let addIdentifier m =

152151 if null (epubIdentifier m)

153152 then do

154− randomId <- fmap show getRandomUUID

153+ randomId <- fmap show P.newUUID

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

156155 else return m

157156 let addLanguage m =

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

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

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

161160 Nothing -> do

162− localeLang <- E.catch (liftM

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

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

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

161+ mLang <- P.lookupEnv "LANG"

162+ let localeLang =

163+ case mLang of

164+ Just lang ->

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

166+ takeWhile (/='.') lang

167+ Nothing -> "en-US"

166168 return m{ epubLanguage = localeLang }

167169 else return m

168170 let fixDate m =

169171 if null (epubDate m)

170172 then do

171− currentTime <- getCurrentTime

173+ currentTime <- P.getCurrentTime

172174 return $ m{ epubDate = [ Date{

173175 dateText = showDateTimeISO8601 currentTime

174176 , dateEvent = Nothing } ] }

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

333335writeEPUB :: WriterOptions -- ^ Writer options

334336 -> Pandoc -- ^ Document to convert

335337 -> 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

337344 let version = fromMaybe EPUB2 (writerEpubVersion opts)

338345 let epub3 = version == EPUB3

339− epochtime <- floor `fmap` getPOSIXTime

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

340347 let mkEntry path content = toEntry path epochtime content

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

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

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

361368 let cpContent = renderHtml $ writeHtml

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

363370 (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

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

366373 , [mkEntry coverImage imgContent] )

367374

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

372379 let tpEntry = mkEntry "title_page.xhtml" tpContent

373380

374381 -- handle pictures

375− mediaRef <- newIORef []

382+ mediaRef <- P.newIORef []

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

377384 walkM (transformBlock opts' mediaRef)

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

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

379386

380387 -- handle fonts

381388 let matchingGlob f = do

382− xs <- namesMatching f

389+ xs <- P.namesMatching f

383390 when (null xs) $

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

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

385392 return xs

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

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

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

388395 fontEntries <- mapM mkFontEntry fontFiles

389396

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

520527 let uuid = case epubIdentifier metadata of

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

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

523− currentTime <- getCurrentTime

530+ currentTime <- P.getCurrentTime

524531 let contentsData = UTF8.fromStringLazy $ ppTopElement $

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

526533 EPUB2 -> "2.0"

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

692699

693700 -- stylesheet

694701 stylesheet <- case epubStylesheet metadata of

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

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

696703 Just (StylesheetContents s) -> return s

697704 Nothing -> UTF8.toString `fmap`

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

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

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

700707

701708 -- construct archive

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

814821transformTag :: WriterOptions

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

816823 -> Tag String

817− -> IO (Tag String)

824+ -> EPUBAction (Tag String)

818825transformTag opts mediaRef tag@(TagOpen name attr)

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

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

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

831838modifyMediaRef :: WriterOptions

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

833840 -> FilePath

834− -> IO FilePath

841+ -> EPUBAction FilePath

835842modifyMediaRef _ _ "" = return ""

836843modifyMediaRef opts mediaRef oldsrc = do

837− media <- readIORef mediaRef

844+ media <- P.readIORef mediaRef

838845 case lookup oldsrc media of

839846 Just (n,_) -> return n

840847 Nothing -> do

841− res <- fetchItem' (writerMediaBag opts)

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

842849 (writerSourceURL opts) oldsrc

843850 (new, mbEntry) <-

844851 case res of

845852 Left _ -> do

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

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

847854 return (oldsrc, Nothing)

848855 Right (img,mbMime) -> do

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

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

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

852− epochtime <- floor `fmap` getPOSIXTime

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

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

854861 return (new, Just entry)

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

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

856863 return new

857864

858865transformBlock :: WriterOptions

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

860867 -> Block

861− -> IO Block

868+ -> EPUBAction Block

862869transformBlock opts mediaRef (RawBlock fmt raw)

863870 | fmt == Format "html" = do

864871 let tags = parseTags raw

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

869876transformInline :: WriterOptions

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

871878 -> Inline

872− -> IO Inline

879+ -> EPUBAction Inline

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

874881 newsrc <- modifyMediaRef opts mediaRef src

875882 return $ Image attr lab (newsrc, tit)

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

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

1818import Text.Pandoc.XML

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

2020import Text.Pandoc.Writers.Shared

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

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

2222import Text.Pandoc.Options

2323import Text.Pandoc.Templates (renderTemplate')

2424import Text.Pandoc.Pretty

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

2828import Control.Monad.State

2929import Network.URI (isURI)

3030import 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 ()

3135

3236type Style = [String]

3337type Hyperlink = [(Int, String)]

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

4044 , maxListDepth :: Int

4145 }

4246

43−type WS a = StateT WriterState IO a

47+type WS a = StateT WriterState ICMLAction a

4448

4549defaultWriterState :: WriterState

4650defaultWriterState = WriterState{

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

121125footnoteName = "Footnote"

122126citeName = "Cite"

123127

124−

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

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

127−writeICML opts (Pandoc meta blocks) = do

130+writeICML opts doc = runIO $ writeICMLPure opts doc

131+

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

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

134+writeICMLPure opts (Pandoc meta blocks) = do

128135 let colwidth = if writerWrapText opts == WrapAuto

129136 then Just $ writerColumns opts

130137 else Nothing

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

532539-- | Assemble an ICML Image.

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

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

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

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

536543 imgS <- case res of

537544 Left (_) -> do

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

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

539546 return def

540547 Right (img, _) -> do

541548 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

2828

2929Conversion of 'Pandoc' documents to ODT.

3030-}

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

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

3232import Data.IORef

3333import Data.List ( isPrefixOf )

3434import Data.Maybe ( fromMaybe )

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

3838import Text.Pandoc.UTF8 ( fromStringLazy )

3939import Codec.Archive.Zip

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

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

42− getDefaultReferenceODT )

41+import Text.Pandoc.Shared ( stringify )

4342import Text.Pandoc.ImageSize

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

4544import Text.Pandoc.Definition

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

5049import Text.Pandoc.XML

5150import Text.Pandoc.Pretty

5251import qualified Control.Exception as E

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

5452import 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]

5557

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

5759writeODT :: WriterOptions -- ^ Writer options

5860 -> Pandoc -- ^ Document to convert

5961 -> 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

6169 let datadir = writerUserDataDir opts

6270 let title = docTitle meta

6371 refArchive <-

6472 case writerReferenceODT opts of

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

66− Nothing -> getDefaultReferenceODT datadir

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

74+ Nothing -> P.getDefaultReferenceODT datadir

6775 -- handle formulas and pictures

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

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

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

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

71− epochtime <- floor `fmap` getPOSIXTime

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

7280 let contentEntry = toEntry "content.xml" epochtime

7381 $ fromStringLazy newContents

74− picEntries <- readIORef picEntriesRef

82+ picEntries <- P.readIORef picEntriesRef

7583 let archive = foldr addEntryToArchive refArchive

7684 $ contentEntry : picEntries

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

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

126134 return $ fromArchive archive''

127135

128136-- | transform both Image and Math elements

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

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

130138transformPicMath 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

132140 case res of

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

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

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

135143 return $ Emph lab

136144 Right (img, mbMimeType) -> do

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

138146 Right s -> return $ sizeInPoints s

139147 Left msg -> do

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

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

141149 src ++ "': " ++ msg

142150 return (100, 100)

143151 let dims =

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

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

156164 Nothing -> Nothing

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

158− entries <- readIORef entriesRef

166+ entries <- P.readIORef entriesRef

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

160168 (mbMimeType >>= extensionFromMimeType)

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

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

163− epochtime <- floor `fmap` getPOSIXTime

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

164172 let entry = toEntry newsrc epochtime $ toLazy img

165− modifyIORef entriesRef (entry:)

173+ P.modifyIORef entriesRef (entry:)

166174 return $ Image newattr lab (newsrc, t)

167175transformPicMath _ entriesRef (Math t math) = do

168− entries <- readIORef entriesRef

176+ entries <- P.readIORef entriesRef

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

170178 case writeMathML dt <$> readTeX math of

171179 Left _ -> return $ Math t math

172180 Right r -> do

173181 let conf = useShortEmptyTags (const False) defaultConfigPP

174182 let mathml = ppcTopElement conf r

175− epochtime <- floor `fmap` getPOSIXTime

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

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

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

178186 let entry = toEntry fname epochtime (fromStringLazy mathml)

179− modifyIORef entriesRef (entry:)

187+ P.modifyIORef entriesRef (entry:)

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

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

182190 if t == DisplayMath