diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Class.hs | 22 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 10 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 14 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/TWiki.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ICML.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Math.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 12 |
11 files changed, 40 insertions, 42 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 3337de40a..7227742b2 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -36,8 +36,8 @@ module Text.Pandoc.Class ( PandocMonad(..) , PureState(..) , getPOSIXTime , getZonedTime - , addWarning - , addWarningWithPos + , warning + , warningWithPos , getWarnings , getMediaBag , setMediaBag @@ -121,8 +121,8 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState C -- Functions defined for all PandocMonad instances -addWarning :: PandocMonad m => String -> m () -addWarning msg = modify $ \st -> st{stWarnings = msg : stWarnings st} +warning :: PandocMonad m => String -> m () +warning msg = modify $ \st -> st{stWarnings = msg : stWarnings st} getWarnings :: PandocMonad m => m [String] getWarnings = gets stWarnings @@ -152,14 +152,12 @@ getZonedTime = do tz <- getCurrentTimeZone return $ utcToZonedTime tz t -addWarningWithPos :: PandocMonad m - => Maybe SourcePos - -> String - -> ParserT [Char] ParserState m () -addWarningWithPos mbpos msg = - lift $ - addWarning $ - msg ++ maybe "" (\pos -> " " ++ show pos) mbpos +warningWithPos :: PandocMonad m + => Maybe SourcePos + -> String + -> ParserT [Char] ParserState m () +warningWithPos mbpos msg = + lift $ warning $ msg ++ maybe "" (\pos -> " " ++ show pos) mbpos -- diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 16542fd1f..490fdf878 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.addWarning parserWarnings + mapM_ P.warning 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.addWarning $ "Docx comment " ++ cmtId ++ " will not retain formatting") + ((lift . lift) $ P.warning $ "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/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index b59e5a5f1..012edfe3b 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -280,7 +280,7 @@ yamlMetaBlock = try $ do ) nullMeta hashmap Right Yaml.Null -> return nullMeta Right _ -> do - P.addWarningWithPos (Just pos) "YAML header is not an object" + P.warningWithPos (Just pos) "YAML header is not an object" return nullMeta Left err' -> do case err' of @@ -291,13 +291,13 @@ yamlMetaBlock = try $ do yamlLine = yline , yamlColumn = ycol }}) -> - P.addWarningWithPos (Just $ setSourceLine + P.warningWithPos (Just $ setSourceLine (setSourceColumn pos (sourceColumn pos + ycol)) (sourceLine pos + 1 + yline)) $ "Could not parse YAML header: " ++ problem - _ -> P.addWarningWithPos (Just pos) + _ -> P.warningWithPos (Just pos) $ "Could not parse YAML header: " ++ show err' return nullMeta @@ -420,7 +420,7 @@ referenceKey = try $ do let oldkeys = stateKeys st let key = toKey raw case M.lookup key oldkeys of - Just _ -> P.addWarningWithPos (Just pos) $ "Duplicate link reference `" ++ raw ++ "'" + Just _ -> P.warningWithPos (Just pos) $ "Duplicate link reference `" ++ raw ++ "'" Nothing -> return () updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys } return $ return mempty @@ -486,7 +486,7 @@ noteBlock = try $ do let newnote = (ref, parsed) oldnotes <- stateNotes' <$> getState case lookup ref oldnotes of - Just _ -> P.addWarningWithPos (Just pos) $ "Duplicate note reference `" ++ ref ++ "'" + Just _ -> P.warningWithPos (Just pos) $ "Duplicate note reference `" ++ ref ++ "'" Nothing -> return () updateState $ \s -> s { stateNotes' = newnote : oldnotes } return mempty diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index df6a8114b..5e8aa20f5 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -626,7 +626,7 @@ directive' = do return $ B.divWith attrs children other -> do pos <- getPosition - P.addWarningWithPos (Just pos) $ "ignoring unknown directive: " ++ other + P.warningWithPos (Just pos) $ "ignoring unknown directive: " ++ other return mempty -- TODO: @@ -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.addWarning $ + "language" -> when (baseRole /= "code") $ lift $ P.warning $ "ignoring :language: field because the parent of role :" ++ role ++ ": is :" ++ baseRole ++ ": not :code:" - "format" -> when (baseRole /= "raw") $ lift $ P.addWarning $ + "format" -> when (baseRole /= "raw") $ lift $ P.warning $ "ignoring :format: field because the parent of role :" ++ role ++ ": is :" ++ baseRole ++ ": not :raw:" - _ -> lift $ P.addWarning $ "ignoring unknown field :" ++ key ++ + _ -> lift $ P.warning $ "ignoring unknown field :" ++ key ++ ": in definition of role :" ++ role ++ ": in" when (parentRole == "raw" && countKeys "format" > 1) $ - lift $ P.addWarning $ + lift $ P.warning $ "ignoring :format: fields after the first in the definition of role :" ++ role ++": in" when (parentRole == "code" && countKeys "language" > 1) $ - lift $ P.addWarning $ + lift $ P.warning $ "ignoring :language: fields after the first in the definition of role :" ++ role ++": in" @@ -1065,7 +1065,7 @@ renderRole contents fmt role attr = case role of renderRole contents newFmt newRole newAttr Nothing -> do pos <- getPosition - P.addWarningWithPos (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in" + P.warningWithPos (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in" return $ B.str contents -- Undefined role where titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index cc4f8f39c..b4546883b 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.addWarning warns + mapM_ P.warning warns return doc Left e -> throwError e diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 3b1df6bd9..0f040d19b 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.addWarning ("Could not find image `" ++ src ++ "', skipping...") + (lift . lift) $ P.warning ("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 b1266c4c9..1c3a44207 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.addWarning $ f ++ " did not match any font files." + lift $ P.warning $ 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.addWarning $ "Could not find media `" ++ oldsrc ++ "', skipping..." + lift $ P.warning $ "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 482e20f4b..6bc7436d8 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.addWarning $ "Could not find image `" ++ src ++ "', skipping..." + lift $ P.warning $ "Could not find image `" ++ src ++ "', skipping..." return def Right (img, _) -> do case imageSize img of Right size -> return size Left msg -> do - lift $ P.addWarning $ "Could not determine image size in `" ++ + lift $ P.warning $ "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 552db8b32..b959ce972 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 - addWarning $ "Could not render TeX math as unicode, rendering as raw TeX:\n" ++ inp + warning $ "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 - addWarning $ "Could not convert TeX math, rendering as raw TeX:\n" ++ + warning $ "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 db9090e29..b17b18a21 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.addWarning $ "Could not find image `" ++ src ++ "', skipping..." + lift $ P.warning $ "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.addWarning $ "Could not determine image size in `" ++ + lift $ P.warning $ "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 32f70cb31..a3351a705 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -36,7 +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 Text.Pandoc.Class (warning) 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 - addWarning $ "Could not determine image size in `" ++ + warning $ "Could not determine image size in `" ++ src ++ "': " ++ msg return "" Right sz -> return $ "\\picw" ++ show xpx ++ @@ -78,17 +78,17 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do concat bytes ++ "}" if B.null imgdata then do - addWarning $ "Image " ++ src ++ " contained no data, skipping." + warning $ "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." + warning $ "Image " ++ src ++ " is not a jpeg or png, skipping." return x Right (_, Nothing) -> do - addWarning $ "Could not determine image type for " ++ src ++ ", skipping." + warning $ "Could not determine image type for " ++ src ++ ", skipping." return x Left e -> do - addWarning $ "Could not fetch image " ++ src ++ "\n" ++ show e + warning $ "Could not fetch image " ++ src ++ "\n" ++ show e return x rtfEmbedImage _ x = return x |