From 76c55466d3087224eccdc47c804ab2904be50df5 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 10 Feb 2017 23:59:47 +0100 Subject: Use new warnings throughout the code base. --- src/Text/Pandoc/App.hs | 3 +- src/Text/Pandoc/Class.hs | 53 +++++++----------- src/Text/Pandoc/Logging.hs | 105 ++++++++++++++++++++++++----------- src/Text/Pandoc/Parsing.hs | 10 +++- src/Text/Pandoc/Readers/Docx.hs | 9 ++- src/Text/Pandoc/Readers/EPUB.hs | 4 +- src/Text/Pandoc/Readers/HTML.hs | 10 ++-- src/Text/Pandoc/Readers/LaTeX.hs | 19 +++++-- src/Text/Pandoc/Readers/Markdown.hs | 25 ++++----- src/Text/Pandoc/Readers/MediaWiki.hs | 6 +- src/Text/Pandoc/Readers/RST.hs | 61 ++++++++++---------- src/Text/Pandoc/Readers/TWiki.hs | 6 +- src/Text/Pandoc/Readers/Textile.hs | 6 +- src/Text/Pandoc/Writers/Docx.hs | 5 +- src/Text/Pandoc/Writers/EPUB.hs | 8 +-- src/Text/Pandoc/Writers/FB2.hs | 10 ++-- src/Text/Pandoc/Writers/ICML.hs | 8 +-- src/Text/Pandoc/Writers/Math.hs | 6 +- src/Text/Pandoc/Writers/ODT.hs | 8 +-- src/Text/Pandoc/Writers/RTF.hs | 15 +++-- test/Tests/Readers/Docx.hs | 2 +- 21 files changed, 203 insertions(+), 176 deletions(-) diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index e99767f0b..91d0711c1 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -348,8 +348,7 @@ convertWithOpts opts = do x <- f rs <- getLog return (x, rs) - let isWarning (WARNING, _) = True - isWarning _ = False + let isWarning msg = messageVerbosity msg == WARNING when (optFailIfWarnings opts && any isWarning reports) $ err 3 "Failing because there were warnings." return res diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index b1958510c..0788a9d86 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -41,8 +41,6 @@ module Text.Pandoc.Class ( PandocMonad(..) , getPOSIXTime , getZonedTime , readFileFromDirs - , warning - , warningWithPos , report , getLog , setVerbosity @@ -73,7 +71,7 @@ import qualified Text.Pandoc.Shared as IO ( readDataFile import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Compat.Time (UTCTime) import Text.Pandoc.Logging -import Text.Parsec (ParsecT, SourcePos) +import Text.Parsec (ParsecT) import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime) import Text.Pandoc.MIME (MimeType, getMimeType) import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds @@ -131,7 +129,7 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m) modifyCommonState :: (CommonState -> CommonState) -> m () modifyCommonState f = getCommonState >>= putCommonState . f - logOutput :: Verbosity -> String -> m () + logOutput :: LogMessage -> m () -- Functions defined for all PandocMonad instances @@ -139,25 +137,17 @@ setVerbosity :: PandocMonad m => Verbosity -> m () setVerbosity verbosity = modifyCommonState $ \st -> st{ stVerbosity = verbosity } -getLog :: PandocMonad m => m [(Verbosity, String)] +getLog :: PandocMonad m => m [LogMessage] getLog = reverse <$> getsCommonState stLog -warning :: PandocMonad m => String -> m () -warning msg = report WARNING msg - -warningWithPos :: PandocMonad m - => SourcePos - -> String - -> ParsecT s st m () -warningWithPos pos msg = lift $ warning $ msg ++ " " ++ show pos - -report :: PandocMonad m => Verbosity -> String -> m () -report level msg = do +report :: PandocMonad m => LogMessage -> m () +report msg = do verbosity <- getsCommonState stVerbosity + let level = messageVerbosity msg when (level <= verbosity) $ do - logOutput verbosity msg + logOutput msg unless (level == DEBUG) $ - modifyCommonState $ \st -> st{ stLog = (level, msg) : stLog st } + modifyCommonState $ \st -> st{ stLog = msg : stLog st } setMediaBag :: PandocMonad m => MediaBag -> m () setMediaBag mb = modifyCommonState $ \st -> st{stMediaBag = mb} @@ -187,17 +177,15 @@ getZonedTime = do return $ utcToZonedTime tz t -- | Read file, checking in any number of directories. -readFileFromDirs :: PandocMonad m => [FilePath] -> FilePath -> m String -readFileFromDirs [] f = do - warning $ "Could not load include file " ++ f ++ ", skipping." - return "" +readFileFromDirs :: PandocMonad m => [FilePath] -> FilePath -> m (Maybe String) +readFileFromDirs [] _ = return Nothing readFileFromDirs (d:ds) f = catchError - (UTF8.toStringLazy <$> readFileLazy (d f)) + ((Just . UTF8.toStringLazy) <$> readFileLazy (d f)) (\_ -> readFileFromDirs ds f) -- -data CommonState = CommonState { stLog :: [(Verbosity, String)] +data CommonState = CommonState { stLog :: [LogMessage] , stMediaBag :: MediaBag , stInputFiles :: Maybe [FilePath] , stOutputFile :: Maybe FilePath @@ -266,8 +254,9 @@ instance PandocMonad PandocIO where Left _ -> throwError $ PandocFileReadError fp getCommonState = PandocIO $ lift get putCommonState x = PandocIO $ lift $ put x - logOutput level msg = - liftIO $ UTF8.hPutStrLn stderr $ printf "%-7s %s" (show level) msg + logOutput msg = + liftIO $ UTF8.hPutStrLn stderr $ printf "%-7s %s" + (show (messageVerbosity msg)) (showLogMessage msg) -- | Specialized version of parseURIReference that disallows -- single-letter schemes. Reason: these are usually windows absolute @@ -466,7 +455,7 @@ instance PandocMonad PandocPure where getCommonState = PandocPure $ lift $ get putCommonState x = PandocPure $ lift $ put x - logOutput _level _msg = return () + logOutput _msg = return () instance PandocMonad m => PandocMonad (ParsecT s st m) where lookupEnv = lift . lookupEnv @@ -482,7 +471,7 @@ instance PandocMonad m => PandocMonad (ParsecT s st m) where getModificationTime = lift . getModificationTime getCommonState = lift getCommonState putCommonState = lift . putCommonState - logOutput lvl = lift . logOutput lvl + logOutput = lift . logOutput instance PandocMonad m => PandocMonad (ReaderT r m) where lookupEnv = lift . lookupEnv @@ -498,7 +487,7 @@ instance PandocMonad m => PandocMonad (ReaderT r m) where getModificationTime = lift . getModificationTime getCommonState = lift getCommonState putCommonState = lift . putCommonState - logOutput lvl = lift . logOutput lvl + logOutput = lift . logOutput instance (PandocMonad m, Monoid w) => PandocMonad (WriterT w m) where lookupEnv = lift . lookupEnv @@ -514,7 +503,7 @@ instance (PandocMonad m, Monoid w) => PandocMonad (WriterT w m) where getModificationTime = lift . getModificationTime getCommonState = lift getCommonState putCommonState = lift . putCommonState - logOutput lvl = lift . logOutput lvl + logOutput = lift . logOutput instance (PandocMonad m, Monoid w) => PandocMonad (RWST r w st m) where lookupEnv = lift . lookupEnv @@ -530,7 +519,7 @@ instance (PandocMonad m, Monoid w) => PandocMonad (RWST r w st m) where getModificationTime = lift . getModificationTime getCommonState = lift getCommonState putCommonState = lift . putCommonState - logOutput lvl = lift . logOutput lvl + logOutput = lift . logOutput instance PandocMonad m => PandocMonad (StateT st m) where lookupEnv = lift . lookupEnv @@ -546,5 +535,5 @@ instance PandocMonad m => PandocMonad (StateT st m) where getModificationTime = lift . getModificationTime getCommonState = lift getCommonState putCommonState = lift . putCommonState - logOutput lvl = lift . logOutput lvl + logOutput = lift . logOutput diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 8d9575625..8b2b85a45 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -52,31 +52,35 @@ instance ToJSON Verbosity where toJSON x = toJSON (show x) data LogMessage = - SkippedInput String SourcePos - | YamlSectionNotAnObject SourcePos + SkippedContent String SourcePos + | CouldNotParseYamlMetadata String SourcePos | DuplicateLinkReference String SourcePos | DuplicateNoteReference String SourcePos + | ReferenceNotFound String SourcePos | ParsingUnescaped String SourcePos + | CouldNotLoadIncludeFile String SourcePos + | ParsingTrace String SourcePos | InlineNotRendered Inline | BlockNotRendered Block - | DocxCommentWillNotRetainFormatting String + | DocxParserWarning String | CouldNotFetchResource String String - | CouldNotDetermineImageSize String + | CouldNotDetermineImageSize String String | CouldNotDetermineMimeType String - | CouldNotConvertTeXMath String + | CouldNotConvertTeXMath String String deriving (Show, Eq, Data, Ord, Typeable, Generic) instance ToJSON LogMessage where toJSON x = object $ "verbosity" .= toJSON (messageVerbosity x) : case x of - SkippedInput s pos -> - ["type" .= String "SkippedInput", + SkippedContent s pos -> + ["type" .= String "SkippedContent", "contents" .= Text.pack s, "source" .= Text.pack (sourceName pos), "line" .= sourceLine pos, "column" .= sourceColumn pos] - YamlSectionNotAnObject pos -> + CouldNotParseYamlMetadata s pos -> ["type" .= String "YamlSectionNotAnObject", + "message" .= Text.pack s, "source" .= Text.pack (sourceName pos), "line" .= toJSON (sourceLine pos), "column" .= toJSON (sourceColumn pos)] @@ -92,75 +96,114 @@ instance ToJSON LogMessage where "source" .= Text.pack (sourceName pos), "line" .= toJSON (sourceLine pos), "column" .= toJSON (sourceColumn pos)] + ReferenceNotFound s pos -> + ["type" .= String "ReferenceNotFound", + "contents" .= Text.pack s, + "source" .= Text.pack (sourceName pos), + "line" .= toJSON (sourceLine pos), + "column" .= toJSON (sourceColumn pos)] ParsingUnescaped s pos -> ["type" .= String "ParsingUnescaped", "contents" .= Text.pack s, "source" .= Text.pack (sourceName pos), "line" .= toJSON (sourceLine pos), "column" .= toJSON (sourceColumn pos)] + CouldNotLoadIncludeFile fp pos -> + ["type" .= String "CouldNotLoadIncludeFile", + "path" .= Text.pack fp, + "source" .= Text.pack (sourceName pos), + "line" .= toJSON (sourceLine pos), + "column" .= toJSON (sourceColumn pos)] + ParsingTrace s pos -> + ["type" .= String "ParsingTrace", + "contents" .= Text.pack s, + "source" .= Text.pack (sourceName pos), + "line" .= sourceLine pos, + "column" .= sourceColumn pos] InlineNotRendered il -> ["type" .= String "InlineNotRendered", "contents" .= toJSON il] BlockNotRendered bl -> ["type" .= String "BlockNotRendered", "contents" .= toJSON bl] - DocxCommentWillNotRetainFormatting s -> - ["type" .= String "DocxCommentWillNotRetainFormatting", - "commentId" .= Text.pack s] + DocxParserWarning s -> + ["type" .= String "DocxParserWarning", + "contents" .= Text.pack s] CouldNotFetchResource fp s -> ["type" .= String "CouldNotFetchResource", "path" .= Text.pack fp, "message" .= Text.pack s] - CouldNotDetermineImageSize fp -> + CouldNotDetermineImageSize fp s -> ["type" .= String "CouldNotDetermineImageSize", - "path" .= Text.pack fp] + "path" .= Text.pack fp, + "message" .= Text.pack s] CouldNotDetermineMimeType fp -> ["type" .= String "CouldNotDetermineMimeType", "path" .= Text.pack fp] - CouldNotConvertTeXMath s -> + CouldNotConvertTeXMath s msg -> ["type" .= String "CouldNotConvertTeXMath", - "contents" .= Text.pack s] + "contents" .= Text.pack s, + "message" .= Text.pack msg] + +showPos :: SourcePos -> String +showPos pos = sn ++ "line " ++ + show (sourceLine pos) ++ " column " ++ show (sourceColumn pos) + where sn = if sourceName pos == "source" || sourceName pos == "" + then "" + else sourceName pos ++ " " showLogMessage :: LogMessage -> String showLogMessage msg = case msg of - SkippedInput s pos -> - "Skipped '" ++ s ++ "' at " ++ show pos - YamlSectionNotAnObject pos -> - "YAML metadata section is not an object at " ++ show pos + SkippedContent s pos -> + "Skipped '" ++ s ++ "' at " ++ showPos pos + CouldNotParseYamlMetadata s pos -> + "Could not parse YAML metadata at " ++ showPos pos ++ + if null s then "" else (": " ++ s) DuplicateLinkReference s pos -> - "Duplicate link reference '" ++ s ++ "' at " ++ show pos + "Duplicate link reference '" ++ s ++ "' at " ++ showPos pos DuplicateNoteReference s pos -> - "Duplicate note reference '" ++ s ++ "' at " ++ show pos + "Duplicate note reference '" ++ s ++ "' at " ++ showPos pos + ReferenceNotFound s pos -> + "Reference not found for '" ++ s ++ "' at " ++ showPos pos ParsingUnescaped s pos -> - "Parsing unescaped '" ++ s ++ "' at " ++ show pos + "Parsing unescaped '" ++ s ++ "' at " ++ showPos pos + CouldNotLoadIncludeFile fp pos -> + "Could not load include file '" ++ fp ++ "' at " ++ showPos pos + ParsingTrace s pos -> + "Parsing trace at " ++ showPos pos ++ ": " ++ s InlineNotRendered il -> "Not rendering " ++ show il BlockNotRendered bl -> "Not rendering " ++ show bl - DocxCommentWillNotRetainFormatting s -> - "Docx comment with id '" ++ s ++ "' will not retain formatting" + DocxParserWarning s -> + "Docx parser warning: " ++ s CouldNotFetchResource fp s -> "Could not fetch resource '" ++ fp ++ "'" ++ if null s then "" else (": " ++ s) - CouldNotDetermineImageSize fp -> - "Could not determine image size for '" ++ fp ++ "'" + CouldNotDetermineImageSize fp s -> + "Could not determine image size for '" ++ fp ++ "'" ++ + if null s then "" else (": " ++ s) CouldNotDetermineMimeType fp -> "Could not determine mime type for '" ++ fp ++ "'" - CouldNotConvertTeXMath s -> - "Could not convert TeX math '" ++ s ++ "', rendering as TeX" + CouldNotConvertTeXMath s m -> + "Could not convert TeX math '" ++ s ++ "', rendering as TeX" ++ + if null m then "" else (':':'\n':m) messageVerbosity:: LogMessage -> Verbosity messageVerbosity msg = case msg of - SkippedInput{} -> INFO - YamlSectionNotAnObject{} -> WARNING + SkippedContent{} -> INFO + CouldNotParseYamlMetadata{} -> WARNING DuplicateLinkReference{} -> WARNING DuplicateNoteReference{} -> WARNING + ReferenceNotFound{} -> WARNING + CouldNotLoadIncludeFile{} -> WARNING ParsingUnescaped{} -> INFO + ParsingTrace{} -> DEBUG InlineNotRendered{} -> INFO BlockNotRendered{} -> INFO - DocxCommentWillNotRetainFormatting{} -> INFO + DocxParserWarning{} -> WARNING CouldNotFetchResource{} -> WARNING CouldNotDetermineImageSize{} -> WARNING CouldNotDetermineMimeType{} -> WARNING diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index f45ac2f71..933d0161e 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -188,7 +188,8 @@ import Text.TeXMath.Readers.TeX.Macros (applyMacros, Macro, import Text.HTML.TagSoup.Entity ( lookupEntity ) import Text.Pandoc.Asciify (toAsciiChar) import Data.Monoid ((<>)) -import Text.Pandoc.Class (PandocMonad, readFileFromDirs) +import Text.Pandoc.Class (PandocMonad, readFileFromDirs, report) +import Text.Pandoc.Logging import Data.Default import qualified Data.Set as Set import Control.Monad.Reader @@ -1289,7 +1290,12 @@ insertIncludedFile blocks dirs f = do when (f `elem` containers) $ throwError $ PandocParseError $ "Include file loop at " ++ show oldPos updateState $ \s -> s{ stateContainers = f : stateContainers s } - contents <- readFileFromDirs dirs f + mbcontents <- readFileFromDirs dirs f + contents <- case mbcontents of + Just s -> return s + Nothing -> do + report $ CouldNotLoadIncludeFile f oldPos + return "" setPosition $ newPos f 1 1 setInput contents bs <- blocks diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 2b92cceee..8936a0403 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -100,6 +100,7 @@ import Text.Pandoc.Error import Control.Monad.Except (throwError) import Text.Pandoc.Class (PandocMonad) import qualified Text.Pandoc.Class as P +import Text.Pandoc.Logging readDocx :: PandocMonad m => ReaderOptions @@ -108,12 +109,13 @@ readDocx :: PandocMonad m readDocx opts bytes | Right archive <- toArchiveOrFail bytes , Right (docx, parserWarnings) <- archiveToDocxWithWarnings archive = do - mapM_ P.warning parserWarnings + mapM_ (P.report . DocxParserWarning) parserWarnings (meta, blks) <- docxToOutput opts docx return $ Pandoc meta blks readDocx _ _ = throwError $ PandocSomeError "couldn't parse docx file" +-- TODO remove this for 2.0: readDocxWithWarnings :: PandocMonad m => ReaderOptions -> B.ByteString @@ -333,8 +335,9 @@ blocksToInlinesWarn cmtId blks = do notParaOrPlain (Para _) = False notParaOrPlain (Plain _) = False notParaOrPlain _ = True - when (not $ null $ filter notParaOrPlain blkList) - ((lift . lift) $ P.warning $ "Docx comment " ++ cmtId ++ " will not retain formatting") + when (not $ null $ filter notParaOrPlain blkList) $ + lift $ P.report $ DocxParserWarning $ + "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/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index 49a035c37..2eaa842b6 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -13,7 +13,6 @@ import Text.Pandoc.Definition hiding (Attr) import Text.Pandoc.Readers.HTML (readHtml) import Text.Pandoc.Walk (walk, query) import Text.Pandoc.Options ( ReaderOptions(..)) -import Text.Pandoc.Logging (Verbosity(..)) import Text.Pandoc.Extensions (enableExtension, Extension(Ext_raw_html)) import Text.Pandoc.Shared (escapeURI, collapseFilePath, addMetaField) import Network.URI (unEscapeString) @@ -35,7 +34,7 @@ import qualified Data.Map as M (Map, lookup, fromList, elems) import Data.Monoid ((<>)) import Control.DeepSeq (deepseq, NFData) import Text.Pandoc.Error -import Text.Pandoc.Class (PandocMonad, report) +import Text.Pandoc.Class (PandocMonad) import qualified Text.Pandoc.Class as P type Items = M.Map String (FilePath, MimeType) @@ -71,7 +70,6 @@ archiveToEPUB os archive = do os' = os {readerExtensions = enableExtension Ext_raw_html (readerExtensions os)} parseSpineElem :: PandocMonad m => FilePath -> (FilePath, MimeType) -> m Pandoc parseSpineElem (normalise -> r) (normalise -> path, mime) = do - report DEBUG ("parseSpineElem called with path " ++ show path) doc <- mimeToReader mime r path let docSpan = B.doc $ B.para $ B.spanWith (takeFileName path, [], []) mempty return $ docSpan <> doc diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index c452d2acf..6b571fca5 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -48,7 +48,7 @@ import Text.Pandoc.Shared ( extractSpaces, renderTags', addMetaField import Text.Pandoc.Options (ReaderOptions(readerExtensions), extensionEnabled, Extension (Ext_epub_html_exts, Ext_raw_html, Ext_native_divs, Ext_native_spans)) -import Text.Pandoc.Logging (Verbosity(..)) +import Text.Pandoc.Logging import Text.Pandoc.Parsing hiding ((<|>)) import Text.Pandoc.Walk import qualified Data.Map as M @@ -59,7 +59,6 @@ import Control.Monad ( guard, mzero, void, unless ) import Control.Arrow ((***)) import Control.Applicative ( (<|>) ) import Data.Monoid (First (..)) -import Text.Printf (printf) import Text.TeXMath (readMathML, writeTeX) import Data.Default (Default (..), def) import Control.Monad.Reader (ask, asks, local, ReaderT, runReaderT, lift) @@ -69,7 +68,7 @@ import Data.Monoid ((<>)) import Text.Parsec.Error import qualified Data.Set as Set import Text.Pandoc.Error -import Text.Pandoc.Class (PandocMonad, report, warningWithPos) +import Text.Pandoc.Class (PandocMonad, report) import Control.Monad.Except (throwError) -- | Convert HTML-formatted string to 'Pandoc' document. @@ -177,8 +176,7 @@ block = do , pPlain , pRawHtmlBlock ] - report DEBUG $ printf "line %d: %s" - (sourceLine pos) (take 60 $ show $ B.toList res) + report $ ParsingTrace (take 60 $ show $ B.toList res) pos return res namespaces :: PandocMonad m => [(String, TagParser m Inlines)] @@ -378,7 +376,7 @@ ignore raw = do -- raw can be null for tags like ; see paRawTag -- in this case we don't want a warning: unless (null raw) $ - warningWithPos pos $ "Skipped " ++ raw + report $ SkippedContent raw pos return mempty pHtmlBlock :: PandocMonad m => String -> TagParser m String diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index cc69786cf..0cce8bcb1 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -38,6 +38,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Walk import Text.Pandoc.Shared import Text.Pandoc.Options +import Text.Pandoc.Logging import Text.Pandoc.Parsing hiding ((<|>), many, optional, space, mathDisplay, mathInline) import Data.Char ( chr, ord, isLetter, isAlphaNum ) @@ -51,7 +52,7 @@ import qualified Data.Map as M import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension) import Text.Pandoc.ImageSize (numUnit, showFl) import Control.Monad.Except (throwError) -import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, warningWithPos, +import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, report, readFileFromDirs) -- | Parse LaTeX from string and return 'Pandoc' document. @@ -235,7 +236,7 @@ inline = (mempty <$ comment) <|> (str . (:[]) <$> tildeEscape) <|> (do res <- oneOf "#&~^'`\"[]" pos <- getPosition - warningWithPos pos ("Parsing unescaped '" ++ [res] ++ "'") + report $ ParsingUnescaped [res] pos return $ str [res]) inlines :: PandocMonad m => LP m Inlines @@ -312,7 +313,7 @@ optargs = snd <$> withRaw (skipopts *> skipMany (try $ optional sp *> braced)) ignore :: (Monoid a, PandocMonad m) => String -> ParserT s u m a ignore raw = do pos <- getPosition - warningWithPos pos $ "Skipped " ++ raw + report $ SkippedContent raw pos return mempty ignoreBlocks :: PandocMonad m => String -> (String, LP m Blocks) @@ -943,14 +944,14 @@ rawEnv name = do let beginCommand = "\\begin{" ++ name ++ "}" ++ rawOptions unless parseRaw $ do pos1 <- getPosition - warningWithPos pos1 $ "Skipped " ++ beginCommand + report $ SkippedContent beginCommand pos1 (bs, raw) <- withRaw $ env name blocks raw' <- applyMacros' raw if parseRaw then return $ rawBlock "latex" $ beginCommand ++ raw' else do pos2 <- getPosition - warningWithPos pos2 $ "Skipped \\end{" ++ name ++ "}" + report $ SkippedContent ("\\end{" ++ name ++ "}") pos2 return bs ---- @@ -982,10 +983,16 @@ include = do inputListing :: PandocMonad m => LP m Blocks inputListing = do + pos <- getPosition options <- option [] keyvals f <- filter (/='"') <$> braced dirs <- (splitBy (==':') . fromMaybe ".") <$> lookupEnv "TEXINPUTS" - codeLines <- lines <$> readFileFromDirs dirs f + mbCode <- readFileFromDirs dirs f + codeLines <- case mbCode of + Just s -> return $ lines s + Nothing -> do + report $ CouldNotLoadIncludeFile f pos + return [] let (ident,classes,kvs) = parseListingsOptions options let language = case lookup "language" options >>= fromListingsLanguage of Just l -> [l] diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index e35b70240..9ed0c5880 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -51,7 +51,7 @@ import qualified Text.Pandoc.UTF8 as UTF8 import qualified Data.Vector as V import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) import Text.Pandoc.Options -import Text.Pandoc.Logging (Verbosity(..)) +import Text.Pandoc.Logging import Text.Pandoc.Shared import Text.Pandoc.Pretty (charWidth) import Text.Pandoc.XML (fromEntities) @@ -62,12 +62,10 @@ import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockT import Control.Monad import System.FilePath (takeExtension, addExtension) import Text.HTML.TagSoup -import Text.Printf (printf) import Data.Monoid ((<>)) import Control.Monad.Trans (lift) import Control.Monad.Except (throwError, catchError) import Text.Pandoc.Class (PandocMonad, report) -import qualified Text.Pandoc.Class as P type MarkdownParser m = ParserT [Char] ParserState m @@ -270,7 +268,8 @@ yamlMetaBlock = try $ do ) nullMeta hashmap Right Yaml.Null -> return nullMeta Right _ -> do - P.warningWithPos pos "YAML header is not an object" + report $ CouldNotParseYamlMetadata "not an object" + pos return nullMeta Left err' -> do case err' of @@ -281,15 +280,13 @@ yamlMetaBlock = try $ do yamlLine = yline , yamlColumn = ycol }}) -> - P.warningWithPos (setSourceLine + report $ CouldNotParseYamlMetadata + problem (setSourceLine (setSourceColumn pos (sourceColumn pos + ycol)) (sourceLine pos + 1 + yline)) - $ "Could not parse YAML header: " ++ - problem - _ -> P.warningWithPos pos - $ "Could not parse YAML header: " ++ - show err' + _ -> report $ CouldNotParseYamlMetadata + (show err') pos return nullMeta updateState $ \st -> st{ stateMeta' = stateMeta' st <> (return meta') } return mempty @@ -406,7 +403,7 @@ referenceKey = try $ do let oldkeys = stateKeys st let key = toKey raw case M.lookup key oldkeys of - Just _ -> P.warningWithPos pos $ "Duplicate link reference `" ++ raw ++ "'" + Just _ -> report $ DuplicateLinkReference raw pos Nothing -> return () updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys } return $ return mempty @@ -472,7 +469,7 @@ noteBlock = try $ do let newnote = (ref, parsed) oldnotes <- stateNotes' <$> getState case lookup ref oldnotes of - Just _ -> P.warningWithPos pos $ "Duplicate note reference `" ++ ref ++ "'" + Just _ -> report $ DuplicateNoteReference ref pos Nothing -> return () updateState $ \s -> s { stateNotes' = newnote : oldnotes } return mempty @@ -512,8 +509,8 @@ block = do , para , plain ] "block" - report DEBUG $ printf "line %d: %s" (sourceLine pos) - (take 60 $ show $ B.toList $ runF res defaultParserState) + report $ ParsingTrace + (take 60 $ show $ B.toList $ runF res defaultParserState) pos return res -- diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index e70509bd1..14f9da9b6 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -41,7 +41,7 @@ import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) import Data.Monoid ((<>)) import Text.Pandoc.Options -import Text.Pandoc.Logging (Verbosity(..)) +import Text.Pandoc.Logging import Text.Pandoc.Readers.HTML ( htmlTag, isBlockTag, isCommentTag ) import Text.Pandoc.XML ( fromEntities ) import Text.Pandoc.Parsing hiding ( nested ) @@ -56,7 +56,6 @@ import qualified Data.Map as M import qualified Data.Set as Set import Data.Char (isDigit, isSpace) import Data.Maybe (fromMaybe) -import Text.Printf (printf) import Control.Monad.Except (throwError) import Text.Pandoc.Class (PandocMonad, report) @@ -207,8 +206,7 @@ block = do <|> blockTag <|> (B.rawBlock "mediawiki" <$> template) <|> para - report DEBUG $ printf "line %d: %s" (sourceLine pos) - (take 60 $ show $ B.toList res) + report $ ParsingTrace (take 60 $ show $ B.toList res) pos return res para :: PandocMonad m => MWParser m Blocks diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 3fbb533a8..c5ddbbad8 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -36,6 +36,7 @@ import Text.Pandoc.Builder (setMeta, fromList) import Text.Pandoc.Shared import Text.Pandoc.Parsing import Text.Pandoc.Options +import Text.Pandoc.Logging import Text.Pandoc.Error import Control.Monad ( when, liftM, guard, mzero ) import Data.List ( findIndex, intercalate, isInfixOf, @@ -49,8 +50,7 @@ import Data.Sequence (viewr, ViewR(..)) import Data.Char (toLower, isHexDigit, isSpace, toUpper) import Data.Monoid ((<>)) import Control.Monad.Except (throwError) -import Text.Pandoc.Class (PandocMonad, warning, readFileFromDirs, - warningWithPos) +import Text.Pandoc.Class (PandocMonad, report, readFileFromDirs) -- | Parse reStructuredText string and return Pandoc document. readRST :: PandocMonad m @@ -421,8 +421,12 @@ include = try $ do when (f `elem` containers) $ throwError $ PandocParseError $ "Include file loop at " ++ show oldPos updateState $ \s -> s{ stateContainers = f : stateContainers s } - contents <- readFileFromDirs ["."] f - let contentLines = lines contents + mbContents <- readFileFromDirs ["."] f + contentLines <- case mbContents of + Just s -> return $ lines s + Nothing -> do + report $ CouldNotLoadIncludeFile f oldPos + return [] let numLines = length contentLines let startLine' = case startLine of Nothing -> 1 @@ -688,7 +692,7 @@ directive' = do return $ B.divWith attrs children other -> do pos <- getPosition - warningWithPos pos $ "ignoring unknown directive: " ++ other + report $ SkippedContent (".. " ++ other) pos return mempty -- TODO: @@ -696,6 +700,7 @@ directive' = do -- change Text.Pandoc.Definition.Format to fix addNewRole :: PandocMonad m => String -> [(String, String)] -> RSTParser m Blocks addNewRole roleString fields = do + pos <- getPosition (role, parentRole) <- parseFromString inheritedRole roleString customRoles <- stateRstCustomRoles <$> getState let getBaseRole (r, f, a) roles = @@ -716,22 +721,18 @@ addNewRole roleString fields = do -- warn about syntax we ignore flip mapM_ fields $ \(key, _) -> case key of - "language" -> when (baseRole /= "code") $ warning $ - "ignoring :language: field because the parent of role :" ++ - role ++ ": is :" ++ baseRole ++ ": not :code:" - "format" -> when (baseRole /= "raw") $ warning $ - "ignoring :format: field because the parent of role :" ++ - role ++ ": is :" ++ baseRole ++ ": not :raw:" - _ -> warning $ "ignoring unknown field :" ++ key ++ - ": in definition of role :" ++ role ++ ": in" + "language" -> when (baseRole /= "code") $ report $ + SkippedContent ":language: [because parent of role is not :code:]" + pos + "format" -> when (baseRole /= "raw") $ report $ + SkippedContent ":format: [because parent of role is not :raw:]" pos + _ -> report $ SkippedContent (":" ++ key ++ ":") pos when (parentRole == "raw" && countKeys "format" > 1) $ - warning $ - "ignoring :format: fields after the first in the definition of role :" - ++ role ++": in" + report $ SkippedContent ":format: [after first in definition of role]" + pos when (parentRole == "code" && countKeys "language" > 1) $ - warning $ - "ignoring :language: fields after the first in the definition of role :" - ++ role ++": in" + report $ SkippedContent + ":language: [after first in definition of role]" pos updateState $ \s -> s { stateRstCustomRoles = @@ -1011,9 +1012,9 @@ simpleTable headless = do case B.toList tbl of [Table c a _w h l] -> return $ B.singleton $ Table c a (replicate (length a) 0) h l - _ -> do - warning "tableWith returned something unexpected" - return tbl -- TODO error? + _ -> + throwError $ PandocShouldNeverHappenError + "tableWith returned something unexpected" where sep = return () -- optional (simpleTableSep '-') @@ -1132,7 +1133,7 @@ renderRole contents fmt role attr = case role of renderRole contents newFmt newRole newAttr Nothing -> do pos <- getPosition - warningWithPos pos $ "ignoring unknown role :" ++ custom ++ ": in" + report $ SkippedContent (":" ++ custom ++ ":") pos return $ B.str contents -- Undefined role where titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour @@ -1217,9 +1218,7 @@ explicitLink = try $ do case M.lookup key keyTable of Nothing -> do pos <- getPosition - warningWithPos pos $ - "Could not find reference for " ++ - show key + report $ ReferenceNotFound (show key) pos return ("","",nullAttr) Just ((s,t),a) -> return (s,t,a) _ -> return (src, "", nullAttr) @@ -1242,9 +1241,7 @@ referenceLink = try $ do ((src,tit), attr) <- case M.lookup key keyTable of Nothing -> do pos <- getPosition - warningWithPos pos $ - "Could not find reference for " ++ - show key + report $ ReferenceNotFound (show key) pos return (("",""),nullAttr) Just val -> return val -- if anonymous link, remove key so it won't be used again @@ -1273,8 +1270,7 @@ subst = try $ do case M.lookup key substTable of Nothing -> do pos <- getPosition - warningWithPos pos $ - "Could not find reference for " ++ show key + report $ ReferenceNotFound (show key) pos return mempty Just target -> return target @@ -1288,8 +1284,7 @@ note = try $ do case lookup ref notes of Nothing -> do pos <- getPosition - warningWithPos pos $ - "Could not find note for " ++ show ref + report $ ReferenceNotFound (show ref) pos return mempty Just raw -> do -- We temporarily empty the note list while parsing the note, diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index af9b38895..3b89f2ee9 100644 --- a/src/Text/Pandoc/Readers/TWiki.hs +++ b/src/Text/Pandoc/Readers/TWiki.hs @@ -35,11 +35,10 @@ module Text.Pandoc.Readers.TWiki ( readTWiki import Text.Pandoc.Definition import qualified Text.Pandoc.Builder as B import Text.Pandoc.Options -import Text.Pandoc.Logging (Verbosity(..)) +import Text.Pandoc.Logging import Text.Pandoc.Parsing hiding (enclosed, macro, nested) import Text.Pandoc.Readers.HTML (htmlTag, isCommentTag) import Control.Monad -import Text.Printf (printf) import Text.Pandoc.XML (fromEntities) import Data.Maybe (fromMaybe) import Text.HTML.TagSoup @@ -133,8 +132,7 @@ block = do <|> blockElements <|> para skipMany blankline - report DEBUG $ printf "line %d: %s" (sourceLine pos) - (take 60 $ show $ B.toList res) + report $ ParsingTrace (take 60 $ show $ B.toList res) pos return res blockElements :: PandocMonad m => TWParser m B.Blocks diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index f404079ec..6594b9ab8 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -56,8 +56,8 @@ import Text.Pandoc.Definition import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) import qualified Text.Pandoc.Builder as B import Text.Pandoc.Options -import Text.Pandoc.Logging (Verbosity(..)) import Text.Pandoc.Parsing +import Text.Pandoc.Logging import Text.Pandoc.Readers.HTML ( htmlTag, isBlockTag, isInlineTag ) import Text.Pandoc.Shared (trim) import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock ) @@ -67,7 +67,6 @@ import Data.List ( intercalate, transpose, intersperse ) import Data.Char ( digitToInt, isUpper ) import Control.Monad ( guard, liftM ) import Data.Monoid ((<>)) -import Text.Printf import Text.Pandoc.Class (PandocMonad, report) import Control.Monad.Except (throwError) @@ -141,8 +140,7 @@ block :: PandocMonad m => ParserT [Char] ParserState m Blocks block = do res <- choice blockParsers "block" pos <- getPosition - report DEBUG $ printf "line %d: %s" (sourceLine pos) - (take 60 $ show $ B.toList res) + report $ ParsingTrace (take 60 $ show $ B.toList res) pos return res commentBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 6a53485c4..235358bf6 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -65,8 +65,9 @@ import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef, import Control.Applicative ((<|>)) import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing) import Data.Char (ord, isSpace, toLower) -import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Class (PandocMonad, report) import qualified Text.Pandoc.Class as P +import Text.Pandoc.Logging data ListMarker = NoMarker | BulletMarker @@ -1173,7 +1174,7 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do res <- runExceptT $ lift (P.fetchItem (writerSourceURL opts) src) case res of Left (_ :: PandocError) -> do - P.warning ("Could not find image `" ++ src ++ "', skipping...") + report $ CouldNotFetchResource src "" -- 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 7e9a20a0c..247014c20 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -29,6 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to EPUB. -} module Text.Pandoc.Writers.EPUB ( writeEPUB2, writeEPUB3 ) where +import Text.Pandoc.Logging import qualified Data.Map as M import qualified Data.Set as Set import Data.Maybe ( fromMaybe, catMaybes ) @@ -65,7 +66,7 @@ import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType) import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags) import Control.Monad.Except (throwError, catchError) import Text.Pandoc.Error -import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Class (PandocMonad, report) import qualified Text.Pandoc.Class as P -- A Chapter includes a list of blocks and maybe a section @@ -415,7 +416,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do let matchingGlob f = do xs <- lift $ P.glob f when (null xs) $ - lift $ P.warning $ f ++ " did not match any font files." + report $ CouldNotFetchResource f "glob 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') @@ -883,8 +884,7 @@ modifyMediaRef opts oldsrc = do (oldsrc, (new, Just entry)):media} return new) (\e -> do - P.warning $ "Could not find media `" ++ oldsrc ++ - "', skipping...\n" ++ show e + report $ CouldNotFetchResource oldsrc (show e) return oldsrc) transformBlock :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 600d34499..6325b5f73 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -41,13 +41,13 @@ import qualified Text.XML.Light.Cursor as XC import qualified Data.ByteString.Char8 as B8 import Control.Monad.Except (throwError, catchError) - +import Text.Pandoc.Logging import Text.Pandoc.Definition import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def) import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize, linesToPara) import Text.Pandoc.Error -import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Class (PandocMonad, report) import qualified Text.Pandoc.Class as P -- | Data to be written at the end of the document: @@ -244,14 +244,12 @@ fetchImage href link = do catchError (do (bs, mbmime) <- P.fetchItem Nothing link case mbmime of Nothing -> do - P.warning ("Could not determine mime type for " - ++ link) + report $ CouldNotDetermineMimeType link return Nothing Just mime -> return $ Just (mime, B8.unpack $ encode bs)) (\e -> - do P.warning ("Could not fetch " ++ link ++ - ":\n" ++ show e) + do report $ CouldNotFetchResource link (show e) return Nothing) case mbimg of Just (imgtype, imgdata) -> do diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 41bca11b2..50edc1865 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -30,7 +30,8 @@ import Control.Monad.State import Control.Monad.Except (runExceptT) import Network.URI (isURI) import qualified Data.Set as Set -import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Class (PandocMonad, report) +import Text.Pandoc.Logging import qualified Text.Pandoc.Class as P type Style = [String] @@ -538,14 +539,13 @@ imageICML opts style attr (src, _) = do res <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src imgS <- case res of Left (_ :: PandocError) -> do - lift $ P.warning $ "Could not find image `" ++ src ++ "', skipping..." + report $ CouldNotFetchResource src "" return def Right (img, _) -> do case imageSize img of Right size -> return size Left msg -> do - lift $ P.warning $ "Could not determine image size in `" ++ - src ++ "': " ++ msg + report $ CouldNotDetermineImageSize src msg return def let (ow, oh) = sizeInPoints imgS (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS diff --git a/src/Text/Pandoc/Writers/Math.hs b/src/Text/Pandoc/Writers/Math.hs index b959ce972..b7419ddf9 100644 --- a/src/Text/Pandoc/Writers/Math.hs +++ b/src/Text/Pandoc/Writers/Math.hs @@ -6,6 +6,7 @@ where import Text.Pandoc.Class import Text.Pandoc.Definition +import Text.Pandoc.Logging import Text.TeXMath (Exp, writePandoc, DisplayType(..), readTeX) -- | Converts a raw TeX math formula to a list of 'Pandoc' inlines. @@ -20,7 +21,7 @@ texMathToInlines mt inp = do case res of Right (Just ils) -> return ils Right (Nothing) -> do - warning $ "Could not render TeX math as unicode, rendering as raw TeX:\n" ++ inp + report $ CouldNotConvertTeXMath inp "" return [mkFallback mt inp] Left il -> return [il] @@ -40,8 +41,7 @@ convertMath writer mt str = do case writer dt <$> readTeX str of Right r -> return (Right r) Left e -> do - warning $ "Could not convert TeX math, rendering as raw TeX:\n" ++ - str ++ "\n" ++ e + report $ CouldNotConvertTeXMath str e return (Left $ mkFallback mt str) where dt = case mt of DisplayMath -> DisplayBlock diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 5672719f9..ee5fa4c24 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -50,8 +50,9 @@ import Text.Pandoc.Error (PandocError) import Text.Pandoc.XML import Text.Pandoc.Pretty import System.FilePath ( takeExtension, takeDirectory, (<.>)) -import Text.Pandoc.Class ( PandocMonad ) +import Text.Pandoc.Class ( PandocMonad, report ) import qualified Text.Pandoc.Class as P +import Text.Pandoc.Logging data ODTState = ODTState { stEntries :: [Entry] } @@ -149,14 +150,13 @@ transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do res <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src case res of Left (_ :: PandocError) -> do - lift $ P.warning $ "Could not find image `" ++ src ++ "', skipping..." + report $ CouldNotFetchResource src "" return $ Emph lab Right (img, mbMimeType) -> do (ptX, ptY) <- case imageSize img of Right s -> return $ sizeInPoints s Left msg -> do - lift $ P.warning $ "Could not determine image size in `" ++ - src ++ "': " ++ msg + report $ CouldNotDetermineImageSize src msg return (100, 100) let dims = case (getDim Width, getDim Height) of diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 77f01e4a1..25c631b9f 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -37,7 +37,7 @@ import Text.Pandoc.Writers.Shared import Text.Pandoc.Writers.Math import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Walk -import Text.Pandoc.Class (warning) +import Text.Pandoc.Logging import Data.List ( isSuffixOf, intercalate ) import Data.Char ( ord, chr, isDigit ) import qualified Data.ByteString as B @@ -46,7 +46,7 @@ import Text.Printf ( printf ) import Text.Pandoc.ImageSize import Control.Monad.Except (throwError, runExceptT, lift) import Text.Pandoc.Error -import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Class (PandocMonad, report) import qualified Text.Pandoc.Class as P -- | Convert Image inlines into a raw RTF embedded image, read from a file, @@ -65,8 +65,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do _ -> throwError $ PandocSomeError "Unknown file type" sizeSpec <- case imageSize imgdata of Left msg -> do - warning $ "Could not determine image size in `" ++ - src ++ "': " ++ msg + report $ CouldNotDetermineImageSize src msg return "" Right sz -> return $ "\\picw" ++ show xpx ++ "\\pich" ++ show ypx ++ @@ -79,17 +78,17 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do concat bytes ++ "}" if B.null imgdata then do - warning $ "Image " ++ src ++ " contained no data, skipping." + report $ CouldNotFetchResource src "image contained no data" return x else return $ RawInline (Format "rtf") raw | otherwise -> do - warning $ "Image " ++ src ++ " is not a jpeg or png, skipping." + report $ CouldNotFetchResource src "image is not a jpeg or png" return x Right (_, Nothing) -> do - warning $ "Could not determine image type for " ++ src ++ ", skipping." + report $ CouldNotDetermineMimeType src return x Left ( e :: PandocError ) -> do - warning $ "Could not fetch image " ++ src ++ "\n" ++ show e + report $ CouldNotFetchResource src (show e) return x rtfEmbedImage _ x = return x diff --git a/test/Tests/Readers/Docx.hs b/test/Tests/Readers/Docx.hs index 548553579..e73065012 100644 --- a/test/Tests/Readers/Docx.hs +++ b/test/Tests/Readers/Docx.hs @@ -61,7 +61,7 @@ testForWarningsWithOptsIO :: ReaderOptions -> String -> FilePath -> [String] -> testForWarningsWithOptsIO opts name docxFile expected = do df <- B.readFile docxFile logs <- runIOorExplode (readDocx opts df >> P.getLog) - let warns = [s | (WARNING, s) <- logs] + let warns = [m | DocxParserWarning m <- logs] return $ test id name (unlines warns, unlines expected) testForWarningsWithOpts :: ReaderOptions -> String -> FilePath -> [String] -> Test -- cgit v1.2.3