aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Class.hs23
-rw-r--r--src/Text/Pandoc/Logging.hs6
-rw-r--r--src/Text/Pandoc/MediaBag.hs31
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
-
-