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.

3 files changed, 25 insertions, 35 deletions

diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 91731d396..14a0b8044 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -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)
diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs
index 7afce9f5f..da8c775f6 100644
--- a/src/Text/Pandoc/Logging.hs
+++ b/src/Text/Pandoc/Logging.hs
@@ -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
diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs
index 980511acc..d8d6da345 100644
--- a/src/Text/Pandoc/MediaBag.hs
+++ b/src/Text/Pandoc/MediaBag.hs
@@ -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
-
-