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]

src/Text/Pandoc.hs

@@ -322,8 +322,7 @@ writers = [
   ,("dokuwiki"     , StringWriter writeDokuWiki)
   ,("zimwiki"      , StringWriter writeZimWiki)
   ,("textile"      , StringWriter writeTextile)
-  ,("rtf"          , StringWriter $ \o ->
+  ,("rtf"          , StringWriter writeRTF)
-     writeRTFWithEmbeddedImages o)
   ,("org"          , StringWriter writeOrg)
   ,("asciidoc"     , StringWriter writeAsciiDoc)
   ,("haddock"      , StringWriter writeHaddock)

src/Text/Pandoc/Class.hs

@@ -36,14 +36,14 @@ module Text.Pandoc.Class ( PandocMonad(..)
                          , PureState(..)
                          , getPOSIXTime
                          , getZonedTime
-                         , warn
+                         , addWarning
+                         , addWarningWithPos
                          , getWarnings
                          , getMediaBag
                          , setMediaBag
                          , insertMedia
                          , getInputFiles
                          , getOutputFile
-                         , addWarningWithPos
                          , PandocIO(..)
                          , PandocPure(..)
                          , FileInfo(..)
@@ -121,10 +121,8 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState C
 
 -- Functions defined for all PandocMonad instances
 
--- TODO should we rename this to avoid conflict with the like-named
+addWarning :: PandocMonad m => String -> m ()
--- function from Shared?  Perhaps "addWarning"?
+addWarning msg = modify $ \st -> st{stWarnings = msg : stWarnings st}
-warn :: PandocMonad m => String -> m ()
-warn msg = modify $ \st -> st{stWarnings = msg : stWarnings st}
 
 getWarnings :: PandocMonad m => m [String]
 getWarnings = gets stWarnings
@@ -160,7 +158,7 @@ addWarningWithPos :: PandocMonad m
                   -> ParserT [Char] ParserState m ()
 addWarningWithPos mbpos msg =
   lift $
-  warn $
+  addWarning $
   msg ++ maybe "" (\pos -> " " ++ show pos) mbpos
 
 --

src/Text/Pandoc/Readers/Docx.hs

@@ -108,7 +108,7 @@ readDocx :: PandocMonad m
 readDocx opts bytes
   | Right archive <- toArchiveOrFail bytes
   , Right (docx, parserWarnings) <- archiveToDocxWithWarnings archive = do
-      mapM_ P.warn parserWarnings
+      mapM_ P.addWarning parserWarnings
       (meta, blks) <- docxToOutput opts docx
       return $ Pandoc meta blks
 readDocx _ _ =
@@ -334,7 +334,7 @@ blocksToInlinesWarn cmtId blks = do
       notParaOrPlain (Plain _) = False
       notParaOrPlain _ = True
   when (not $ null $ filter notParaOrPlain blkList)
-    ((lift . lift) $ P.warn $ "Docx comment " ++ cmtId ++ " will not retain formatting")
+    ((lift . lift) $ P.addWarning $ "Docx comment " ++ cmtId ++ " will not retain formatting")
   return $ fromList $ blocksToInlines blkList
 
 parPartToInlines :: PandocMonad m => ParPart -> DocxContext m Inlines

src/Text/Pandoc/Readers/RST.hs

@@ -654,20 +654,20 @@ addNewRole roleString fields = do
 
     -- warn about syntax we ignore
     flip mapM_ fields $ \(key, _) -> case key of
-        "language" -> when (baseRole /= "code") $ lift $ P.warn $
+        "language" -> when (baseRole /= "code") $ lift $ P.addWarning $
             "ignoring :language: field because the parent of role :" ++
             role ++ ": is :" ++ baseRole ++ ": not :code:"
-        "format" -> when (baseRole /= "raw") $ lift $ P.warn $
+        "format" -> when (baseRole /= "raw") $ lift $ P.addWarning $
             "ignoring :format: field because the parent of role :" ++
             role ++ ": is :" ++ baseRole ++ ": not :raw:"
-        _ -> lift $ P.warn $ "ignoring unknown field :" ++ key ++
+        _ -> lift $ P.addWarning $ "ignoring unknown field :" ++ key ++
              ": in definition of role :" ++ role ++ ": in"
     when (parentRole == "raw" && countKeys "format" > 1) $
-        lift $ P.warn $
+        lift $ P.addWarning $
         "ignoring :format: fields after the first in the definition of role :"
         ++ role ++": in"
     when (parentRole == "code" && countKeys "language" > 1) $
-        lift $ P.warn $
+        lift $ P.addWarning $
         "ignoring :language: fields after the first in the definition of role :"
         ++ role ++": in"
 

src/Text/Pandoc/Readers/TWiki.hs

@@ -58,7 +58,7 @@ readTWiki :: PandocMonad m
           -> m Pandoc
 readTWiki opts s = case readTWikiWithWarnings' opts s of
   Right (doc, warns) -> do
-    mapM_ P.warn warns
+    mapM_ P.addWarning warns
     return doc
   Left e -> throwError e
 

src/Text/Pandoc/Writers/Docx.hs

@@ -1182,7 +1182,7 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do
       res <- (lift . lift) $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
       case res of
         Left (_ :: E.SomeException) -> do
-          (lift . lift) $ P.warn ("Could not find image `" ++ src ++ "', skipping...")
+          (lift . lift) $ P.addWarning ("Could not find image `" ++ src ++ "', skipping...")
           -- emit alt text
           inlinesToOpenXML opts alt
         Right (img, mt) -> do

src/Text/Pandoc/Writers/EPUB.hs

@@ -398,7 +398,7 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
   let matchingGlob f = do
         xs <- lift $ P.glob f
         when (null xs) $
-          lift $ P.warn $ f ++ " did not match any font files."
+          lift $ P.addWarning $ f ++ " did not match any font files."
         return xs
   let mkFontEntry f = mkEntry (takeFileName f) `fmap` (lift $ P.readFileLazy f)
   fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
@@ -864,7 +864,7 @@ modifyMediaRef opts oldsrc = do
            (new, mbEntry) <-
                 case res of
                       Left _        -> do
-                        lift $ P.warn $ "Could not find media `" ++ oldsrc ++ "', skipping..."
+                        lift $ P.addWarning $ "Could not find media `" ++ oldsrc ++ "', skipping..."
                         return (oldsrc, Nothing)
                       Right (img,mbMime) -> do
                         let new = "media/file" ++ show (length media) ++

src/Text/Pandoc/Writers/ICML.hs

@@ -537,13 +537,13 @@ imageICML opts style attr (src, _) = do
   res  <- lift $ P.fetchItem (writerSourceURL opts) src
   imgS <- case res of
             Left (_) -> do
-              lift $ P.warn $ "Could not find image `" ++ src ++ "', skipping..."
+              lift $ P.addWarning $ "Could not find image `" ++ src ++ "', skipping..."
               return def
             Right (img, _) -> do
               case imageSize img of
                 Right size -> return size
                 Left msg   -> do
-                  lift $ P.warn $ "Could not determine image size in `" ++
+                  lift $ P.addWarning $ "Could not determine image size in `" ++
                     src ++ "': " ++ msg
                   return def
   let (ow, oh) = sizeInPoints imgS

src/Text/Pandoc/Writers/Math.hs

@@ -20,7 +20,7 @@ texMathToInlines mt inp = do
   case res of
        Right (Just ils)  -> return ils
        Right (Nothing)   -> do
-         warn $ "Could not render TeX math as unicode, rendering as raw TeX:\n" ++ inp
+         addWarning $ "Could not render TeX math as unicode, rendering as raw TeX:\n" ++ inp
          return [mkFallback mt inp]
        Left il           -> return [il]
 
@@ -40,7 +40,7 @@ convertMath writer mt str = do
   case writer dt <$> readTeX str of
        Right r  -> return (Right r)
        Left e   -> do
-         warn $ "Could not convert TeX math, rendering as raw TeX:\n" ++
+         addWarning $ "Could not convert TeX math, rendering as raw TeX:\n" ++
                  str ++ "\n" ++ e
          return (Left $ mkFallback mt str)
    where dt = case mt of

src/Text/Pandoc/Writers/ODT.hs

@@ -147,13 +147,13 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do
   res <- lift $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
   case res of
      Left (_ :: E.SomeException) -> do
-       lift $ P.warn $ "Could not find image `" ++ src ++ "', skipping..."
+       lift $ P.addWarning $ "Could not find image `" ++ src ++ "', skipping..."
        return $ Emph lab
      Right (img, mbMimeType) -> do
        (ptX, ptY) <- case imageSize img of
                        Right s  -> return $ sizeInPoints s
                        Left msg -> do
-                         lift $ P.warn $ "Could not determine image size in `" ++
+                         lift $ P.addWarning $ "Could not determine image size in `" ++
                            src ++ "': " ++ msg
                          return (100, 100)
        let dims =

src/Text/Pandoc/Writers/RTF.hs

@@ -28,7 +28,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Conversion of 'Pandoc' documents to RTF (rich text format).
 -}
 module Text.Pandoc.Writers.RTF ( writeRTF
-                               , writeRTFWithEmbeddedImages
                                ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
@@ -37,6 +36,7 @@ import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Writers.Math
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Walk
+import Text.Pandoc.Class (addWarning)
 import Data.List ( isSuffixOf, intercalate )
 import Data.Char ( ord, chr, isDigit )
 import qualified Data.ByteString as B
@@ -64,7 +64,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do
                        _            -> throwError $ PandocSomeError "Unknown file type"
          sizeSpec <- case imageSize imgdata of
                              Left msg -> do
-                               P.warn $ "Could not determine image size in `" ++
+                               addWarning $ "Could not determine image size in `" ++
                                  src ++ "': " ++ msg
                                return ""
                              Right sz -> return $ "\\picw" ++ show xpx ++
@@ -76,23 +76,27 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do
                                       (xpt, ypt) = desiredSizeInPoints opts attr sz
          let raw = "{\\pict" ++ filetype ++ sizeSpec ++ "\\bin " ++
                     concat bytes ++ "}"
-         return $ if B.null imgdata
+         if B.null imgdata
-                     then x
+            then do
-                     else RawInline (Format "rtf") raw
+              addWarning $ "Image " ++ src ++ " contained no data, skipping."
-       _ -> return x
+              return x
+            else return $ RawInline (Format "rtf") raw
+         | otherwise -> do
+           addWarning $ "Image " ++ src ++ " is not a jpeg or png, skipping."
+           return x
+       Right (_, Nothing) -> do
+         addWarning $ "Could not determine image type for " ++ src ++ ", skipping."
+         return x
+       Left e -> do
+         addWarning $ "Could not fetch image " ++ src ++ "\n" ++ show e
+         return x
 rtfEmbedImage _ x = return x
 
--- | Convert Pandoc to a string in rich text format, with
--- images embedded as encoded binary data.  TODO get rid of this,
--- we don't need it now that we have writeRTF in PandocMonad.
-writeRTFWithEmbeddedImages :: PandocMonad m
-                           => WriterOptions -> Pandoc -> m String
-writeRTFWithEmbeddedImages options doc =
-  writeRTF options =<< walkM (rtfEmbedImage options) doc
-
 -- | Convert Pandoc to a string in rich text format.
 writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeRTF options (Pandoc meta@(Meta metamap) blocks) = do
+writeRTF options doc = do
+  -- handle images
+  Pandoc meta@(Meta metamap) blocks <- walkM (rtfEmbedImage options) doc
   let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta
   let toPlain (MetaBlocks [Para ils]) = MetaInlines ils
       toPlain x = x