2710fc4 · typeable/pandoc

git.iko.soy/typeable/pandoc

Class: Renamed 'warn' to 'addWarning' and consolidated RTF writer.

* Renaming Text.Pandoc.Class.warn to addWarning avoids conflict with Text.Pandoc.Shared.warn. * Removed writeRTFWithEmbeddedImages from Text.Pandoc.Writers.RTF. This is no longer needed; we automatically handle embedded images using the PandocM functions. [API change]

commit2710fc426130738715fdf1ac6dd0c111a5ac8340 authorJohn MacFarlane <jgm@berkeley.edu> dateSat 3 Dec 2016, 17:10 (10 years ago) parent5ab8909

11 files changed+42−41

compare with master

unifiedsplit

src/Text/Pandoc.hs+1−2 src/Text/Pandoc/Class.hs+5−7 src/Text/Pandoc/Readers/Docx.hs+2−2 src/Text/Pandoc/Readers/RST.hs+5−5 src/Text/Pandoc/Readers/TWiki.hs+1−1 src/Text/Pandoc/Writers/Docx.hs+1−1 src/Text/Pandoc/Writers/EPUB.hs+2−2 src/Text/Pandoc/Writers/ICML.hs+2−2 src/Text/Pandoc/Writers/Math.hs+2−2 src/Text/Pandoc/Writers/ODT.hs+2−2 src/Text/Pandoc/Writers/RTF.hs+19−15

src/Text/Pandoc.hs+1−2

@@ -322,8 +322,7 @@ writers = [

322322 ,("dokuwiki" , StringWriter writeDokuWiki)

323323 ,("zimwiki" , StringWriter writeZimWiki)

324324 ,("textile" , StringWriter writeTextile)

325− ,("rtf" , StringWriter $ \o ->

326− writeRTFWithEmbeddedImages o)

325+ ,("rtf" , StringWriter writeRTF)

327326 ,("org" , StringWriter writeOrg)

328327 ,("asciidoc" , StringWriter writeAsciiDoc)

329328 ,("haddock" , StringWriter writeHaddock)

src/Text/Pandoc/Class.hs+5−7

@@ -36,14 +36,14 @@ module Text.Pandoc.Class ( PandocMonad(..)

3636 , PureState(..)

3737 , getPOSIXTime

3838 , getZonedTime

39− , warn

39+ , addWarning

40+ , addWarningWithPos

4041 , getWarnings

4142 , getMediaBag

4243 , setMediaBag

4344 , insertMedia

4445 , getInputFiles

4546 , getOutputFile

46− , addWarningWithPos

4747 , PandocIO(..)

4848 , PandocPure(..)

4949 , FileInfo(..)

@@ -121,10 +121,8 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState C

121121

122122-- Functions defined for all PandocMonad instances

123123

124−-- TODO should we rename this to avoid conflict with the like-named

125−-- function from Shared? Perhaps "addWarning"?

126−warn :: PandocMonad m => String -> m ()

127−warn msg = modify $ \st -> st{stWarnings = msg : stWarnings st}

124+addWarning :: PandocMonad m => String -> m ()

125+addWarning msg = modify $ \st -> st{stWarnings = msg : stWarnings st}

128126

129127getWarnings :: PandocMonad m => m [String]

130128getWarnings = gets stWarnings

@@ -160,7 +158,7 @@ addWarningWithPos :: PandocMonad m

160158 -> ParserT [Char] ParserState m ()

161159addWarningWithPos mbpos msg =

162160 lift $

163− warn $

161+ addWarning $

164162 msg ++ maybe "" (\pos -> " " ++ show pos) mbpos

165163

166164--

src/Text/Pandoc/Readers/Docx.hs+2−2

@@ -108,7 +108,7 @@ readDocx :: PandocMonad m

108108readDocx opts bytes

109109 | Right archive <- toArchiveOrFail bytes

110110 , Right (docx, parserWarnings) <- archiveToDocxWithWarnings archive = do

111− mapM_ P.warn parserWarnings

111+ mapM_ P.addWarning parserWarnings

112112 (meta, blks) <- docxToOutput opts docx

113113 return $ Pandoc meta blks

114114readDocx _ _ =

@@ -334,7 +334,7 @@ blocksToInlinesWarn cmtId blks = do

334334 notParaOrPlain (Plain _) = False

335335 notParaOrPlain _ = True

336336 when (not $ null $ filter notParaOrPlain blkList)

337− ((lift . lift) $ P.warn $ "Docx comment " ++ cmtId ++ " will not retain formatting")

337+ ((lift . lift) $ P.addWarning $ "Docx comment " ++ cmtId ++ " will not retain formatting")

338338 return $ fromList $ blocksToInlines blkList

339339

340340parPartToInlines :: PandocMonad m => ParPart -> DocxContext m Inlines

src/Text/Pandoc/Readers/RST.hs+5−5

@@ -654,20 +654,20 @@ addNewRole roleString fields = do

654654

655655 -- warn about syntax we ignore

656656 flip mapM_ fields $ \(key, _) -> case key of

657− "language" -> when (baseRole /= "code") $ lift $ P.warn $

657+ "language" -> when (baseRole /= "code") $ lift $ P.addWarning $

658658 "ignoring :language: field because the parent of role :" ++

659659 role ++ ": is :" ++ baseRole ++ ": not :code:"

660− "format" -> when (baseRole /= "raw") $ lift $ P.warn $

660+ "format" -> when (baseRole /= "raw") $ lift $ P.addWarning $

661661 "ignoring :format: field because the parent of role :" ++

662662 role ++ ": is :" ++ baseRole ++ ": not :raw:"

663− _ -> lift $ P.warn $ "ignoring unknown field :" ++ key ++

663+ _ -> lift $ P.addWarning $ "ignoring unknown field :" ++ key ++

664664 ": in definition of role :" ++ role ++ ": in"

665665 when (parentRole == "raw" && countKeys "format" > 1) $

666− lift $ P.warn $

666+ lift $ P.addWarning $

667667 "ignoring :format: fields after the first in the definition of role :"

668668 ++ role ++": in"

669669 when (parentRole == "code" && countKeys "language" > 1) $

670− lift $ P.warn $

670+ lift $ P.addWarning $

671671 "ignoring :language: fields after the first in the definition of role :"

672672 ++ role ++": in"

673673

src/Text/Pandoc/Readers/TWiki.hs+1−1

@@ -58,7 +58,7 @@ readTWiki :: PandocMonad m

5858 -> m Pandoc

5959readTWiki opts s = case readTWikiWithWarnings' opts s of

6060 Right (doc, warns) -> do

61− mapM_ P.warn warns

61+ mapM_ P.addWarning warns

6262 return doc

6363 Left e -> throwError e

6464

src/Text/Pandoc/Writers/Docx.hs+1−1

@@ -1182,7 +1182,7 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do

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

11831183 case res of

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

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

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

11861186 -- emit alt text

11871187 inlinesToOpenXML opts alt

11881188 Right (img, mt) -> do

src/Text/Pandoc/Writers/EPUB.hs+2−2

@@ -398,7 +398,7 @@ pandocToEPUB opts doc@(Pandoc meta _) = do

398398 let matchingGlob f = do

399399 xs <- lift $ P.glob f

400400 when (null xs) $

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

401+ lift $ P.addWarning $ f ++ " did not match any font files."

402402 return xs

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

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

@@ -864,7 +864,7 @@ modifyMediaRef opts oldsrc = do

864864 (new, mbEntry) <-

865865 case res of

866866 Left _ -> do

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

867+ lift $ P.addWarning $ "Could not find media `" ++ oldsrc ++ "', skipping..."

868868 return (oldsrc, Nothing)

869869 Right (img,mbMime) -> do

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

src/Text/Pandoc/Writers/ICML.hs+2−2

@@ -537,13 +537,13 @@ imageICML opts style attr (src, _) = do

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

538538 imgS <- case res of

539539 Left (_) -> do

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

540+ lift $ P.addWarning $ "Could not find image `" ++ src ++ "', skipping..."

541541 return def

542542 Right (img, _) -> do

543543 case imageSize img of

544544 Right size -> return size

545545 Left msg -> do

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

546+ lift $ P.addWarning $ "Could not determine image size in `" ++

547547 src ++ "': " ++ msg

548548 return def

549549 let (ow, oh) = sizeInPoints imgS

src/Text/Pandoc/Writers/Math.hs+2−2

@@ -20,7 +20,7 @@ texMathToInlines mt inp = do

2020 case res of

2121 Right (Just ils) -> return ils

2222 Right (Nothing) -> do

23− warn $ "Could not render TeX math as unicode, rendering as raw TeX:\n" ++ inp

23+ addWarning $ "Could not render TeX math as unicode, rendering as raw TeX:\n" ++ inp

2424 return [mkFallback mt inp]

2525 Left il -> return [il]

2626

@@ -40,7 +40,7 @@ convertMath writer mt str = do

4040 case writer dt <$> readTeX str of

4141 Right r -> return (Right r)

4242 Left e -> do

43− warn $ "Could not convert TeX math, rendering as raw TeX:\n" ++

43+ addWarning $ "Could not convert TeX math, rendering as raw TeX:\n" ++

4444 str ++ "\n" ++ e

4545 return (Left $ mkFallback mt str)

4646 where dt = case mt of

src/Text/Pandoc/Writers/ODT.hs+2−2

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

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

148148 case res of

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

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

150+ lift $ P.addWarning $ "Could not find image `" ++ src ++ "', skipping..."

151151 return $ Emph lab

152152 Right (img, mbMimeType) -> do

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

154154 Right s -> return $ sizeInPoints s

155155 Left msg -> do

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

156+ lift $ P.addWarning $ "Could not determine image size in `" ++

157157 src ++ "': " ++ msg

158158 return (100, 100)

159159 let dims =

src/Text/Pandoc/Writers/RTF.hs+19−15

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

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

2929-}

3030module Text.Pandoc.Writers.RTF ( writeRTF

31− , writeRTFWithEmbeddedImages

3231 ) where

3332import Text.Pandoc.Definition

3433import Text.Pandoc.Options

@@ -37,6 +36,7 @@ import Text.Pandoc.Writers.Shared

3736import Text.Pandoc.Writers.Math

3837import Text.Pandoc.Templates (renderTemplate')

3938import Text.Pandoc.Walk

39+import Text.Pandoc.Class (addWarning)

4040import Data.List ( isSuffixOf, intercalate )

4141import Data.Char ( ord, chr, isDigit )

4242import qualified Data.ByteString as B

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

6464 _ -> throwError $ PandocSomeError "Unknown file type"

6565 sizeSpec <- case imageSize imgdata of

6666 Left msg -> do

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

67+ addWarning $ "Could not determine image size in `" ++

6868 src ++ "': " ++ msg

6969 return ""

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

@@ -76,23 +76,27 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do

7676 (xpt, ypt) = desiredSizeInPoints opts attr sz

7777 let raw = "{\\pict" ++ filetype ++ sizeSpec ++ "\\bin " ++

7878 concat bytes ++ "}"

79− return $ if B.null imgdata

80− then x

81− else RawInline (Format "rtf") raw

82− _ -> return x

79+ if B.null imgdata

80+ then do

81+ addWarning $ "Image " ++ src ++ " contained no data, skipping."

82+ return x

83+ else return $ RawInline (Format "rtf") raw

84+ | otherwise -> do

85+ addWarning $ "Image " ++ src ++ " is not a jpeg or png, skipping."

86+ return x

87+ Right (_, Nothing) -> do

88+ addWarning $ "Could not determine image type for " ++ src ++ ", skipping."

89+ return x

90+ Left e -> do

91+ addWarning $ "Could not fetch image " ++ src ++ "\n" ++ show e

92+ return x

8393rtfEmbedImage _ x = return x

8494

85−-- | Convert Pandoc to a string in rich text format, with

86−-- images embedded as encoded binary data. TODO get rid of this,

87−-- we don't need it now that we have writeRTF in PandocMonad.

88−writeRTFWithEmbeddedImages :: PandocMonad m

89− => WriterOptions -> Pandoc -> m String

90−writeRTFWithEmbeddedImages options doc =

91− writeRTF options =<< walkM (rtfEmbedImage options) doc

92−

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

9496writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m String

95−writeRTF options (Pandoc meta@(Meta metamap) blocks) = do

97+writeRTF options doc = do

98+ -- handle images

99+ Pandoc meta@(Meta metamap) blocks <- walkM (rtfEmbedImage options) doc

96100 let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta

97101 let toPlain (MetaBlocks [Para ils]) = MetaInlines ils

98102 toPlain x = x