Class: rename addWarning[WithPos] to warning[WithPos].

There's already a function addWarning in Parsing!

Maybe we can dispense with that now, but I still like
'warning' better as a name.
This commit is contained in:
John MacFarlane 2016-12-03 18:42:17 +01:00
parent 63dc6bd025
commit a4bd650277
11 changed files with 40 additions and 42 deletions

View file

@ -36,8 +36,8 @@ module Text.Pandoc.Class ( PandocMonad(..)
, PureState(..) , PureState(..)
, getPOSIXTime , getPOSIXTime
, getZonedTime , getZonedTime
, addWarning , warning
, addWarningWithPos , warningWithPos
, getWarnings , getWarnings
, getMediaBag , getMediaBag
, setMediaBag , setMediaBag
@ -121,8 +121,8 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState C
-- Functions defined for all PandocMonad instances -- Functions defined for all PandocMonad instances
addWarning :: PandocMonad m => String -> m () warning :: PandocMonad m => String -> m ()
addWarning msg = modify $ \st -> st{stWarnings = msg : stWarnings st} warning msg = modify $ \st -> st{stWarnings = msg : stWarnings st}
getWarnings :: PandocMonad m => m [String] getWarnings :: PandocMonad m => m [String]
getWarnings = gets stWarnings getWarnings = gets stWarnings
@ -152,14 +152,12 @@ getZonedTime = do
tz <- getCurrentTimeZone tz <- getCurrentTimeZone
return $ utcToZonedTime tz t return $ utcToZonedTime tz t
addWarningWithPos :: PandocMonad m warningWithPos :: PandocMonad m
=> Maybe SourcePos => Maybe SourcePos
-> String -> String
-> ParserT [Char] ParserState m () -> ParserT [Char] ParserState m ()
addWarningWithPos mbpos msg = warningWithPos mbpos msg =
lift $ lift $ warning $ msg ++ maybe "" (\pos -> " " ++ show pos) mbpos
addWarning $
msg ++ maybe "" (\pos -> " " ++ show pos) mbpos
-- --

View file

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

View file

@ -280,7 +280,7 @@ yamlMetaBlock = try $ do
) nullMeta hashmap ) nullMeta hashmap
Right Yaml.Null -> return nullMeta Right Yaml.Null -> return nullMeta
Right _ -> do Right _ -> do
P.addWarningWithPos (Just pos) "YAML header is not an object" P.warningWithPos (Just pos) "YAML header is not an object"
return nullMeta return nullMeta
Left err' -> do Left err' -> do
case err' of case err' of
@ -291,13 +291,13 @@ yamlMetaBlock = try $ do
yamlLine = yline yamlLine = yline
, yamlColumn = ycol , yamlColumn = ycol
}}) -> }}) ->
P.addWarningWithPos (Just $ setSourceLine P.warningWithPos (Just $ setSourceLine
(setSourceColumn pos (setSourceColumn pos
(sourceColumn pos + ycol)) (sourceColumn pos + ycol))
(sourceLine pos + 1 + yline)) (sourceLine pos + 1 + yline))
$ "Could not parse YAML header: " ++ $ "Could not parse YAML header: " ++
problem problem
_ -> P.addWarningWithPos (Just pos) _ -> P.warningWithPos (Just pos)
$ "Could not parse YAML header: " ++ $ "Could not parse YAML header: " ++
show err' show err'
return nullMeta return nullMeta
@ -420,7 +420,7 @@ referenceKey = try $ do
let oldkeys = stateKeys st let oldkeys = stateKeys st
let key = toKey raw let key = toKey raw
case M.lookup key oldkeys of 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 () Nothing -> return ()
updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys } updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys }
return $ return mempty return $ return mempty
@ -486,7 +486,7 @@ noteBlock = try $ do
let newnote = (ref, parsed) let newnote = (ref, parsed)
oldnotes <- stateNotes' <$> getState oldnotes <- stateNotes' <$> getState
case lookup ref oldnotes of 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 () Nothing -> return ()
updateState $ \s -> s { stateNotes' = newnote : oldnotes } updateState $ \s -> s { stateNotes' = newnote : oldnotes }
return mempty return mempty

View file

@ -626,7 +626,7 @@ directive' = do
return $ B.divWith attrs children return $ B.divWith attrs children
other -> do other -> do
pos <- getPosition pos <- getPosition
P.addWarningWithPos (Just pos) $ "ignoring unknown directive: " ++ other P.warningWithPos (Just pos) $ "ignoring unknown directive: " ++ other
return mempty return mempty
-- TODO: -- TODO:
@ -654,20 +654,20 @@ addNewRole roleString fields = do
-- warn about syntax we ignore -- warn about syntax we ignore
flip mapM_ fields $ \(key, _) -> case key of 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 :" ++ "ignoring :language: field because the parent of role :" ++
role ++ ": is :" ++ baseRole ++ ": not :code:" 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 :" ++ "ignoring :format: field because the parent of role :" ++
role ++ ": is :" ++ baseRole ++ ": not :raw:" 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" ": in definition of role :" ++ role ++ ": in"
when (parentRole == "raw" && countKeys "format" > 1) $ when (parentRole == "raw" && countKeys "format" > 1) $
lift $ P.addWarning $ lift $ P.warning $
"ignoring :format: fields after the first in the definition of role :" "ignoring :format: fields after the first in the definition of role :"
++ role ++": in" ++ role ++": in"
when (parentRole == "code" && countKeys "language" > 1) $ when (parentRole == "code" && countKeys "language" > 1) $
lift $ P.addWarning $ lift $ P.warning $
"ignoring :language: fields after the first in the definition of role :" "ignoring :language: fields after the first in the definition of role :"
++ role ++": in" ++ role ++": in"
@ -1065,7 +1065,7 @@ renderRole contents fmt role attr = case role of
renderRole contents newFmt newRole newAttr renderRole contents newFmt newRole newAttr
Nothing -> do Nothing -> do
pos <- getPosition 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 return $ B.str contents -- Undefined role
where where
titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour

View file

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

View file

@ -1182,7 +1182,7 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do
res <- (lift . lift) $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src res <- (lift . lift) $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
case res of case res of
Left (_ :: E.SomeException) -> do 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 -- emit alt text
inlinesToOpenXML opts alt inlinesToOpenXML opts alt
Right (img, mt) -> do Right (img, mt) -> do

View file

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

View file

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

View file

@ -20,7 +20,7 @@ texMathToInlines mt inp = do
case res of case res of
Right (Just ils) -> return ils Right (Just ils) -> return ils
Right (Nothing) -> do 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] return [mkFallback mt inp]
Left il -> return [il] Left il -> return [il]
@ -40,7 +40,7 @@ convertMath writer mt str = do
case writer dt <$> readTeX str of case writer dt <$> readTeX str of
Right r -> return (Right r) Right r -> return (Right r)
Left e -> do 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 str ++ "\n" ++ e
return (Left $ mkFallback mt str) return (Left $ mkFallback mt str)
where dt = case mt of where dt = case mt of

View file

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

View file

@ -36,7 +36,7 @@ import Text.Pandoc.Writers.Shared
import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Math
import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Walk import Text.Pandoc.Walk
import Text.Pandoc.Class (addWarning) import Text.Pandoc.Class (warning)
import Data.List ( isSuffixOf, intercalate ) import Data.List ( isSuffixOf, intercalate )
import Data.Char ( ord, chr, isDigit ) import Data.Char ( ord, chr, isDigit )
import qualified Data.ByteString as B import qualified Data.ByteString as B
@ -64,7 +64,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do
_ -> throwError $ PandocSomeError "Unknown file type" _ -> throwError $ PandocSomeError "Unknown file type"
sizeSpec <- case imageSize imgdata of sizeSpec <- case imageSize imgdata of
Left msg -> do Left msg -> do
addWarning $ "Could not determine image size in `" ++ warning $ "Could not determine image size in `" ++
src ++ "': " ++ msg src ++ "': " ++ msg
return "" return ""
Right sz -> return $ "\\picw" ++ show xpx ++ Right sz -> return $ "\\picw" ++ show xpx ++
@ -78,17 +78,17 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do
concat bytes ++ "}" concat bytes ++ "}"
if B.null imgdata if B.null imgdata
then do then do
addWarning $ "Image " ++ src ++ " contained no data, skipping." warning $ "Image " ++ src ++ " contained no data, skipping."
return x return x
else return $ RawInline (Format "rtf") raw else return $ RawInline (Format "rtf") raw
| otherwise -> do | otherwise -> do
addWarning $ "Image " ++ src ++ " is not a jpeg or png, skipping." warning $ "Image " ++ src ++ " is not a jpeg or png, skipping."
return x return x
Right (_, Nothing) -> do Right (_, Nothing) -> do
addWarning $ "Could not determine image type for " ++ src ++ ", skipping." warning $ "Could not determine image type for " ++ src ++ ", skipping."
return x return x
Left e -> do Left e -> do
addWarning $ "Could not fetch image " ++ src ++ "\n" ++ show e warning $ "Could not fetch image " ++ src ++ "\n" ++ show e
return x return x
rtfEmbedImage _ x = return x rtfEmbedImage _ x = return x