555e9ca · 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.

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

4 files changed+125−91

compare with master

unifiedsplit

src/Text/Pandoc/Writers/Docx.hs+40−28 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+40−28

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

5756import Control.Monad.Reader

5857import Control.Monad.State

5958import Text.Highlighting.Kate

60−import Data.Unique (hashUnique, newUnique)

61−import System.Random (randomRIO)

59+import Data.Unique (hashUnique)

60+import System.Random (randomR)

6261import Text.Printf (printf)

6362import qualified Control.Exception as E

6463import 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')] ()

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

11331146 else unhighlighted

11341147inlineToOpenXML' opts (Note bs) = do

11351148 notes <- gets stFootnotes

1136− notenum <- getUniqueId

1149+ notenum <- (lift . lift) getUniqueId

11371150 footnoteStyle <- rStyleM "Footnote Reference"

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

11391152 [ mknode "w:rPr" [] footnoteStyle

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

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

11651178 Just i -> return i

11661179 Nothing -> do

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

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

11681181 modify $ \st -> st{ stExternalLinks =

11691182 M.insert src i extlinks }

11701183 return i

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

11761189 case M.lookup src imgs of

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

11781191 Nothing -> do

1179− res <- liftIO $

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

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

11811193 case res of

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

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

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

11841196 -- emit alt text

11851197 inlinesToOpenXML opts alt

11861198 Right (img, mt) -> do

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

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

11881200 let (xpt,ypt) = desiredSizeInPoints opts attr

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

11901202 -- 12700 emu = 1 pt

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

12621274 [ mknode "w:r" [] $

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

12641276

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

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

12661278parseXml refArchive distArchive relpath =

12671279 case findEntryByPath relpath refArchive `mplus`

12681280 findEntryByPath relpath distArchive of

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

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

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

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

12721284 Just d -> return d

12731285

12741286-- | 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")

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

362369 let cpContent = renderHtml $ writeHtml

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

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

365− imgContent <- B.readFile img

372+ imgContent <- P.readFileLazy img

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

367374 , [mkEntry coverImage imgContent] )

368375

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

373380 let tpEntry = mkEntry "title_page.xhtml" tpContent

374381

375382 -- handle pictures

376− mediaRef <- newIORef []

383+ mediaRef <- P.newIORef []

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

378385 walkM (transformBlock opts' mediaRef)

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

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

380387

381388 -- handle fonts

382389 let matchingGlob f = do

383− xs <- namesMatching f

390+ xs <- P.namesMatching f

384391 when (null xs) $

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

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

386393 return xs

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

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

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

389396 fontEntries <- mapM mkFontEntry fontFiles

390397

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

521528 let uuid = case epubIdentifier metadata of

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

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

524− currentTime <- getCurrentTime

531+ currentTime <- P.getCurrentTime

525532 let contentsData = UTF8.fromStringLazy $ ppTopElement $

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

527534 EPUB2 -> "2.0"

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

693700

694701 -- stylesheet

695702 stylesheet <- case epubStylesheet metadata of

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

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

697704 Just (StylesheetContents s) -> return s

698705 Nothing -> UTF8.toString `fmap`

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

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

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

701708

702709 -- construct archive

@@ -815,7 +822,7 @@ showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"

815822transformTag :: WriterOptions

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

817824 -> Tag String

818− -> IO (Tag String)

825+ -> EPUBAction (Tag String)

819826transformTag opts mediaRef tag@(TagOpen name attr)

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

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

@@ -832,34 +839,34 @@ transformTag _ _ tag = return tag

832839modifyMediaRef :: WriterOptions

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

834841 -> FilePath

835− -> IO FilePath

842+ -> EPUBAction FilePath

836843modifyMediaRef _ _ "" = return ""

837844modifyMediaRef opts mediaRef oldsrc = do

838− media <- readIORef mediaRef

845+ media <- P.readIORef mediaRef

839846 case lookup oldsrc media of

840847 Just (n,_) -> return n

841848 Nothing -> do

842− res <- fetchItem' (writerMediaBag opts)

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

843850 (writerSourceURL opts) oldsrc

844851 (new, mbEntry) <-

845852 case res of

846853 Left _ -> do

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

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

848855 return (oldsrc, Nothing)

849856 Right (img,mbMime) -> do

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

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

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

853− epochtime <- floor `fmap` getPOSIXTime

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

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

855862 return (new, Just entry)

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

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

857864 return new

858865

859866transformBlock :: WriterOptions

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

861868 -> Block

862− -> IO Block

869+ -> EPUBAction Block

863870transformBlock opts mediaRef (RawBlock fmt raw)

864871 | fmt == Format "html" = do

865872 let tags = parseTags raw

@@ -870,7 +877,7 @@ transformBlock _ _ b = return b

870877transformInline :: WriterOptions

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

872879 -> Inline

873− -> IO Inline

880+ -> EPUBAction Inline

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

875882 newsrc <- modifyMediaRef opts mediaRef src

876883 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

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

531538-- | Assemble an ICML Image.

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

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

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

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

535542 imgS <- case res of

536543 Left (_) -> do

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

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

538545 return def

539546 Right (img, _) -> do

540547 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