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:
parent
8a000e3ecc
commit
23f3c2d7b4
3 changed files with 25 additions and 35 deletions
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue