2710fc4 · typeable/pandoc

src/Text/Pandoc.hs+1−2

compare with master

unifiedsplit

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

322 ,("dokuwiki" , StringWriter writeDokuWiki)

323 ,("zimwiki" , StringWriter writeZimWiki)

324 ,("textile" , StringWriter writeTextile)

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

325+ ,("rtf" , StringWriter writeRTF)

326− writeRTFWithEmbeddedImages o)

327 ,("org" , StringWriter writeOrg)

326 ,("org" , StringWriter writeOrg)

328 ,("asciidoc" , StringWriter writeAsciiDoc)

327 ,("asciidoc" , StringWriter writeAsciiDoc)

329 ,("haddock" , StringWriter writeHaddock)

328 ,("haddock" , StringWriter writeHaddock)

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

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

36 , PureState(..)

37 , getPOSIXTime

38 , getZonedTime

39− , warn

39+ , addWarning

40+ , addWarningWithPos

40 , getWarnings

41 , getWarnings

41 , getMediaBag

42 , getMediaBag

42 , setMediaBag

43 , setMediaBag

43 , insertMedia

44 , insertMedia

44 , getInputFiles

45 , getInputFiles

45 , getOutputFile

46 , getOutputFile

46− , addWarningWithPos

47 , PandocIO(..)

48 , PandocPure(..)

49 , FileInfo(..)

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

121

122-- Functions defined for all PandocMonad instances

123

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

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

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

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

128

126

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

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

130getWarnings = gets stWarnings

128getWarnings = gets stWarnings

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

160 -> ParserT [Char] ParserState m ()

158 -> ParserT [Char] ParserState m ()

161addWarningWithPos mbpos msg =

159addWarningWithPos mbpos msg =

162 lift $

160 lift $

163− warn $

161+ addWarning $

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

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

165

163

166--

164--

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

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

108readDocx opts bytes

109 | Right archive <- toArchiveOrFail bytes

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

111− mapM_ P.warn parserWarnings

111+ mapM_ P.addWarning parserWarnings

112 (meta, blks) <- docxToOutput opts docx

113 return $ Pandoc meta blks

114readDocx _ _ =

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

334 notParaOrPlain (Plain _) = False

335 notParaOrPlain _ = True

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

338 return $ fromList $ blocksToInlines blkList

339

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

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

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

654

655 -- warn about syntax we ignore

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

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

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

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

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

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

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

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

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

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

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

664 ": in definition of role :" ++ role ++ ": in"

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

666− lift $ P.warn $

666+ lift $ P.addWarning $

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

668 ++ role ++": in"

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

670− lift $ P.warn $

670+ lift $ P.addWarning $

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

672 ++ role ++": in"

673

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

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

58 -> m Pandoc

59readTWiki opts s = case readTWikiWithWarnings' opts s of

60 Right (doc, warns) -> do

61− mapM_ P.warn warns

61+ mapM_ P.addWarning warns

62 return doc

63 Left e -> throwError e

64

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

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

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

1183 case res of

1184 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...")

1186 -- emit alt text

1187 inlinesToOpenXML opts alt

1188 Right (img, mt) -> do

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

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

398 let matchingGlob f = do

399 xs <- lift $ P.glob f

400 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."

402 return xs

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

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

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

864 (new, mbEntry) <-

865 case res of

866 Left _ -> do

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

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

868 return (oldsrc, Nothing)

869 Right (img,mbMime) -> do

870 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

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

538 imgS <- case res of

539 Left (_) -> do

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

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

541 return def

542 Right (img, _) -> do

543 case imageSize img of

544 Right size -> return size

545 Left msg -> do

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

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

547 src ++ "': " ++ msg

548 return def

549 let (ow, oh) = sizeInPoints imgS

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

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

20 case res of

21 Right (Just ils) -> return ils

22 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

24 return [mkFallback mt inp]

25 Left il -> return [il]

26

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

40 case writer dt <$> readTeX str of

41 Right r -> return (Right r)

42 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" ++

44 str ++ "\n" ++ e

45 return (Left $ mkFallback mt str)

46 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

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

148 case res of

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

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

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

151 return $ Emph lab

152 Right (img, mbMimeType) -> do

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

154 Right s -> return $ sizeInPoints s

155 Left msg -> do

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

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

157 src ++ "': " ++ msg

158 return (100, 100)

159 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

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

29-}

30module Text.Pandoc.Writers.RTF ( writeRTF

31− , writeRTFWithEmbeddedImages

32 ) where

31 ) where

33import Text.Pandoc.Definition

32import Text.Pandoc.Definition

34import Text.Pandoc.Options

33import Text.Pandoc.Options

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

37import Text.Pandoc.Writers.Math

36import Text.Pandoc.Writers.Math

38import Text.Pandoc.Templates (renderTemplate')

37import Text.Pandoc.Templates (renderTemplate')

39import Text.Pandoc.Walk

38import Text.Pandoc.Walk

39+import Text.Pandoc.Class (addWarning)

40import Data.List ( isSuffixOf, intercalate )

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

42import qualified Data.ByteString as B

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

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

65 sizeSpec <- case imageSize imgdata of

66 Left msg -> do

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

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

68 src ++ "': " ++ msg

69 return ""

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

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

76 (xpt, ypt) = desiredSizeInPoints opts attr sz

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

78 concat bytes ++ "}"

79− return $ if B.null imgdata

79+ if B.null imgdata

80− then x

80+ then do

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

82+ return x

81− else RawInline (Format "rtf") raw

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

82− _ -> return x

92+ return x

83rtfEmbedImage _ x = return x

93rtfEmbedImage _ x = return x

84

94

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−

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

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

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

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

97+writeRTF options doc = do

98+ -- handle images

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

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

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

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

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

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

98 toPlain x = x

102 toPlain x = x