New withWarningsToStderr exported from Text.Pandoc.Class.

And use this in pandoc.hs so that messages actually get printed.
This commit is contained in:
John MacFarlane 2016-12-03 16:57:23 +01:00
parent 29b3975cbe
commit 5ab8909661
2 changed files with 23 additions and 6 deletions

View file

@ -77,7 +77,7 @@ import System.Posix.Terminal (queryTerminal)
import System.Posix.IO (stdOutput)
#endif
import Control.Monad.Trans
import Text.Pandoc.Class (withMediaBag, PandocIO)
import Text.Pandoc.Class (withMediaBag, PandocIO, withWarningsToStderr)
type Transform = Pandoc -> Pandoc
@ -1414,10 +1414,14 @@ convertWithOpts opts args = do
srcs <- convertTabs . intercalate "\n" <$> readSources sources'
doc <- handleIncludes' srcs
case doc of
Right doc' -> runIOorExplode $ withMediaBag $ r readerOpts doc'
Right doc' -> runIOorExplode $ withMediaBag
$ withWarningsToStderr
$ r readerOpts doc'
Left e -> error $ show e
ByteStringReader r -> readFiles sources' >>=
(\bs -> runIOorExplode $ withMediaBag $ r readerOpts bs)
(\bs -> runIOorExplode $ withMediaBag
$ withWarningsToStderr
$ r readerOpts bs)
-- We parse first if (1) fileScope is set, (2), it's a binary
-- reader, or (3) we're reading JSON. This is easier to do of an AND
@ -1489,7 +1493,9 @@ convertWithOpts opts args = do
case writer of
-- StringWriter f -> f writerOptions doc' >>= writerFn outputFile
ByteStringWriter f -> (runIOorExplode $ f writerOptions doc') >>= writeFnBinary outputFile
ByteStringWriter f -> (runIOorExplode $ withWarningsToStderr
$ f writerOptions doc')
>>= writeFnBinary outputFile
StringWriter f
| pdfOutput -> do
-- make sure writer is latex or beamer or context or html5
@ -1523,5 +1529,6 @@ convertWithOpts opts args = do
handleEntities = if htmlFormat && ascii
then toEntities
else id
output <- runIOorExplode $ f writerOptions doc'
output <- runIOorExplode $ withWarningsToStderr
$ f writerOptions doc'
selfcontain (output ++ ['\n' | not standalone']) >>= writerFn outputFile . handleEntities

View file

@ -51,6 +51,7 @@ module Text.Pandoc.Class ( PandocMonad(..)
, runIOorExplode
, runPure
, withMediaBag
, withWarningsToStderr
) where
import Prelude hiding (readFile, fail)
@ -64,7 +65,8 @@ import qualified Text.Pandoc.Shared as IO ( fetchItem
, fetchItem'
, getDefaultReferenceDocx
, getDefaultReferenceODT
, readDataFile)
, readDataFile
, warn)
import Text.Pandoc.Compat.Time (UTCTime)
import Text.Pandoc.Parsing (ParserT, ParserState, SourcePos)
import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
@ -119,6 +121,8 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState C
-- Functions defined for all PandocMonad instances
-- TODO should we rename this to avoid conflict with the like-named
-- function from Shared? Perhaps "addWarning"?
warn :: PandocMonad m => String -> m ()
warn msg = modify $ \st -> st{stWarnings = msg : stWarnings st}
@ -183,6 +187,12 @@ runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
withMediaBag :: PandocMonad m => m a -> m (a, MediaBag)
withMediaBag ma = ((,)) <$> ma <*> getMediaBag
withWarningsToStderr :: PandocIO a -> PandocIO a
withWarningsToStderr f = do
x <- f
getWarnings >>= mapM_ IO.warn
return x
runIOorExplode :: PandocIO a -> IO a
runIOorExplode ma = handleError <$> runIO ma