Changed "extracting..." warning to a regular log message.

This makes it sensitive to proper verbosity settings.
(It is now treated as INFO rather than WARNING, so one
doesn't get these messages for creation of tmp images
while making a pdf.)

API changes:

* Removed extractMediaBag from Text.Pandoc.MediaBag.
* Added Extracting as constructor for LogMessage.
This commit is contained in:
John MacFarlane 2017-06-12 15:28:39 +02:00
parent 8a000e3ecc
commit 23f3c2d7b4
3 changed files with 25 additions and 35 deletions

View file

@ -93,15 +93,16 @@ import Network.URI ( escapeURIString, nonStrictRelativeTo,
unEscapeString, parseURIReference, isAllowedInURI,
parseURI, URI(..) )
import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)
import Text.Pandoc.MediaBag (MediaBag, lookupMedia, extractMediaBag,
mediaDirectory)
import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)
import Text.Pandoc.Walk (walkM, walk)
import qualified Text.Pandoc.MediaBag as MB
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified System.Environment as IO (lookupEnv)
import System.FilePath.Glob (match, compile)
import System.FilePath ((</>), (<.>), takeExtension, dropExtension, isRelative)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>), (<.>), takeDirectory,
takeExtension, dropExtension, isRelative, normalise)
import qualified System.FilePath.Glob as IO (glob)
import qualified System.Directory as IO (getModificationTime)
import Control.Monad as M (fail)
@ -387,9 +388,23 @@ extractMedia dir d = do
case [fp | (fp, _, _) <- mediaDirectory media] of
[] -> return d
fps -> do
liftIO $ extractMediaBag True dir media
mapM_ (writeMedia dir media) fps
return $ walk (adjustImagePath dir fps) d
writeMedia :: FilePath -> MediaBag -> FilePath -> PandocIO ()
writeMedia dir mediabag subpath = do
-- we join and split to convert a/b/c to a\b\c on Windows;
-- in zip containers all paths use /
let fullpath = dir </> normalise subpath
let mbcontents = lookupMedia subpath mediabag
case mbcontents of
Nothing -> throwError $ PandocResourceNotFound subpath
Just (_, bs) -> do
report $ Extracting fullpath
liftIO $ do
createDirectoryIfMissing True $ takeDirectory fullpath
BL.writeFile fullpath bs
adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline
adjustImagePath dir paths (Image attr lab (src, tit))
| src `elem` paths = Image attr lab (dir ++ "/" ++ src, tit)

View file

@ -89,6 +89,7 @@ data LogMessage =
| CouldNotConvertTeXMath String String
| CouldNotParseCSS String
| Fetching String
| Extracting String
| NoTitleElement String
| NoLangSpecified
| CouldNotHighlight String
@ -178,6 +179,8 @@ instance ToJSON LogMessage where
["message" .= Text.pack msg]
Fetching fp ->
["path" .= Text.pack fp]
Extracting fp ->
["path" .= Text.pack fp]
NoTitleElement fallback ->
["fallback" .= Text.pack fallback]
NoLangSpecified -> []
@ -248,6 +251,8 @@ showLogMessage msg =
"Could not parse CSS" ++ if null m then "" else (':':'\n':m)
Fetching fp ->
"Fetching " ++ fp ++ "..."
Extracting fp ->
"Extracting " ++ fp ++ "..."
NoTitleElement fallback ->
"This document format requires a nonempty <title> element.\n" ++
"Please specify either 'title' or 'pagetitle' in the metadata.\n" ++
@ -282,6 +287,7 @@ messageVerbosity msg =
CouldNotConvertTeXMath{} -> WARNING
CouldNotParseCSS{} -> WARNING
Fetching{} -> INFO
Extracting{} -> INFO
NoTitleElement{} -> WARNING
NoLangSpecified -> INFO
CouldNotHighlight{} -> WARNING

View file

@ -35,21 +35,15 @@ module Text.Pandoc.MediaBag (
lookupMedia,
insertMedia,
mediaDirectory,
extractMediaBag
) where
import Control.Monad (when)
import Control.Monad.Trans (MonadIO (..))
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Typeable (Typeable)
import System.Directory (createDirectoryIfMissing)
import System.FilePath
import qualified System.FilePath.Posix as Posix
import System.IO (stderr)
import Text.Pandoc.MIME (MimeType, getMimeTypeDef)
import qualified Text.Pandoc.UTF8 as UTF8
-- | A container for a collection of binary resources, with names and
-- mime types. Note that a 'MediaBag' is a Monoid, so 'mempty'
@ -87,28 +81,3 @@ mediaDirectory :: MediaBag -> [(String, MimeType, Int)]
mediaDirectory (MediaBag mediamap) =
M.foldWithKey (\fp (mime,contents) ->
(((Posix.joinPath fp), mime, fromIntegral $ BL.length contents):)) [] mediamap
-- | Extract contents of MediaBag to a given directory. Print informational
-- messages if 'verbose' is true.
-- TODO: eventually we may want to put this into PandocMonad
-- In PandocPure, it could write to the fake file system...
extractMediaBag :: MonadIO m
=> Bool
-> FilePath
-> MediaBag
-> m ()
extractMediaBag verbose dir (MediaBag mediamap) = liftIO $ do
sequence_ $ M.foldWithKey
(\fp (_ ,contents) ->
((writeMedia verbose dir (Posix.joinPath fp, contents)):)) [] mediamap
writeMedia :: Bool -> FilePath -> (FilePath, BL.ByteString) -> IO ()
writeMedia verbose dir (subpath, bs) = do
-- we join and split to convert a/b/c to a\b\c on Windows;
-- in zip containers all paths use /
let fullpath = dir </> normalise subpath
createDirectoryIfMissing True $ takeDirectory fullpath
when verbose $ UTF8.hPutStrLn stderr $ "pandoc: extracting " ++ fullpath
BL.writeFile fullpath bs