From 77912ddc56650aacc47a4e6fe722e758a77b06e2 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Tue, 22 Nov 2016 10:56:59 +0100
Subject: [PATCH] Put 'warn' in MonadIO. Add warnings for math conversions in
docx.
---
src/Text/Pandoc/Shared.hs | 9 +++++----
src/Text/Pandoc/Writers/Docx.hs | 6 ++++--
src/Text/Pandoc/Writers/ICML.hs | 4 ++--
3 files changed, 11 insertions(+), 8 deletions(-)
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 4c10a5572..f06f5f1c7 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -127,6 +127,7 @@ import Text.Pandoc.MIME (MimeType, getMimeType)
import System.FilePath ( (</>), takeExtension, dropExtension)
import Data.Generics (Typeable, Data)
import qualified Control.Monad.State as S
+import Control.Monad.Trans (MonadIO (..))
import qualified Control.Exception as E
import Control.Monad (msum, unless, MonadPlus(..))
import Text.Pandoc.Pretty (charWidth)
@@ -974,7 +975,7 @@ openURL u
UTF8.toString `fmap` lookup hContentType (responseHeaders resp))
#else
| otherwise = E.try $ getBodyAndMimeType `fmap` browse
- (do S.liftIO $ UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..."
+ (do liftIO $ UTF8.hPutStrLn stderr $ "Fetching " ++ u ++ "..."
setOutHandler $ const (return ())
setAllowRedirects True
request (getRequest' u'))
@@ -997,10 +998,10 @@ err exitCode msg = do
exitWith $ ExitFailure exitCode
return undefined
-warn :: String -> IO ()
-warn msg = do
+warn :: MonadIO m => String -> m ()
+warn msg = liftIO $ do
name <- getProgName
- UTF8.hPutStrLn stderr $ name ++ ": " ++ msg
+ UTF8.hPutStrLn stderr $ "[" ++ name ++ " warning] " ++ msg
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft f (Left x) = Left (f x)
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index b6da3dc69..6cc90f4d9 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -1115,7 +1115,9 @@ inlineToOpenXML' opts (Math mathType str) = do
when (displayType == DisplayBlock) setFirstPara
case writeOMML displayType <$> readTeX str of
Right r -> return [r]
- Left _ -> inlinesToOpenXML opts (texMathToInlines mathType str)
+ Left e -> do
+ warn $ "Cannot convert the following TeX math, skipping:\n" ++ str
+ inlinesToOpenXML opts (texMathToInlines mathType str)
inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst
inlineToOpenXML' opts (Code attrs str) = do
let unhighlighted = intercalate [br] `fmap`
@@ -1180,7 +1182,7 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do
fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
case res of
Left (_ :: E.SomeException) -> do
- liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
+ warn $ "Could not find image `" ++ src ++ "', skipping..."
-- emit alt text
inlinesToOpenXML opts alt
Right (img, mt) -> do
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 125deb08c..09d1a9c79 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -534,13 +534,13 @@ imageICML opts style attr (src, _) = do
res <- liftIO $ fetchItem (writerSourceURL opts) src
imgS <- case res of
Left (_) -> do
- liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..."
+ warn $ "Could not find image `" ++ src ++ "', skipping..."
return def
Right (img, _) -> do
case imageSize img of
Right size -> return size
Left msg -> do
- return $ warn $ "Could not determine image size in `" ++
+ warn $ "Could not determine image size in `" ++
src ++ "': " ++ msg
return def
let (ow, oh) = sizeInPoints imgS