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:
parent
63dc6bd025
commit
a4bd650277
11 changed files with 40 additions and 42 deletions
|
@ -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
|
|
||||||
|
|
||||||
--
|
--
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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) ++
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue