aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc.hs3
-rw-r--r--src/Text/Pandoc/Class.hs12
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs4
-rw-r--r--src/Text/Pandoc/Readers/RST.hs10
-rw-r--r--src/Text/Pandoc/Readers/TWiki.hs2
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs2
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs4
-rw-r--r--src/Text/Pandoc/Writers/ICML.hs4
-rw-r--r--src/Text/Pandoc/Writers/Math.hs4
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs4
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs34
11 files changed, 42 insertions, 41 deletions
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index 036d3cdf5..3c3a79bb7 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -322,8 +322,7 @@ writers = [
,("dokuwiki" , StringWriter writeDokuWiki)
,("zimwiki" , StringWriter writeZimWiki)
,("textile" , StringWriter writeTextile)
- ,("rtf" , StringWriter $ \o ->
- writeRTFWithEmbeddedImages o)
+ ,("rtf" , StringWriter writeRTF)
,("org" , StringWriter writeOrg)
,("asciidoc" , StringWriter writeAsciiDoc)
,("haddock" , StringWriter writeHaddock)
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 1059f5324..3337de40a 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/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
--- function from Shared? Perhaps "addWarning"?
-warn :: PandocMonad m => String -> m ()
-warn msg = modify $ \st -> st{stWarnings = msg : stWarnings st}
+addWarning :: PandocMonad m => String -> m ()
+addWarning 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
--
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 37fe5c532..16542fd1f 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/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
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 078d2963c..df6a8114b 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/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"
diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs
index b2b136f39..cc4f8f39c 100644
--- a/src/Text/Pandoc/Readers/TWiki.hs
+++ b/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
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 90261dede..3b1df6bd9 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/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
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index e41aa96ad..b1266c4c9 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/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) ++
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 7c42671f1..482e20f4b 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/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
diff --git a/src/Text/Pandoc/Writers/Math.hs b/src/Text/Pandoc/Writers/Math.hs
index a7fe6d648..552db8b32 100644
--- a/src/Text/Pandoc/Writers/Math.hs
+++ b/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
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 02e84e26e..db9090e29 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/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 =
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index f71c97334..32f70cb31 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/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
- then x
- else RawInline (Format "rtf") raw
- _ -> return x
+ if B.null imgdata
+ then do
+ addWarning $ "Image " ++ src ++ " contained no data, skipping."
+ 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 18:15:28 +0000