diff options
Diffstat (limited to 'src/Text/Pandoc/MediaBag.hs')
| -rw-r--r-- | src/Text/Pandoc/MediaBag.hs | 52 |
1 files changed, 13 insertions, 39 deletions
diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs index eea25fadf..0d060fe1a 100644 --- a/src/Text/Pandoc/MediaBag.hs +++ b/src/Text/Pandoc/MediaBag.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- -Copyright (C) 2014 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2014-2015, 2017–2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.MediaBag - Copyright : Copyright (C) 2014 John MacFarlane + Copyright : Copyright (C) 2014-2015, 2017–2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -34,20 +35,15 @@ module Text.Pandoc.MediaBag ( lookupMedia, insertMedia, mediaDirectory, - extractMediaBag ) where -import System.FilePath -import qualified System.FilePath.Posix as Posix -import System.Directory (createDirectoryIfMissing) -import qualified Data.Map as M import qualified Data.ByteString.Lazy as BL -import Control.Monad (when) -import Text.Pandoc.MIME (MimeType, getMimeTypeDef) -import qualified Text.Pandoc.UTF8 as UTF8 -import Data.Maybe (fromMaybe) -import System.IO (stderr) import Data.Data (Data) +import qualified Data.Map as M +import Data.Maybe (fromMaybe) import Data.Typeable (Typeable) +import System.FilePath +import qualified System.FilePath.Posix as Posix +import Text.Pandoc.MIME (MimeType, getMimeTypeDef) -- | A container for a collection of binary resources, with names and -- mime types. Note that a 'MediaBag' is a Monoid, so 'mempty' @@ -70,8 +66,8 @@ insertMedia fp mbMime contents (MediaBag mediamap) = MediaBag (M.insert (splitDirectories fp) (mime, contents) mediamap) where mime = fromMaybe fallback mbMime fallback = case takeExtension fp of - ".gz" -> getMimeTypeDef $ dropExtension fp - _ -> getMimeTypeDef fp + ".gz" -> getMimeTypeDef $ dropExtension fp + _ -> getMimeTypeDef fp -- | Lookup a media item in a 'MediaBag', returning mime type and contents. lookupMedia :: FilePath @@ -83,27 +79,5 @@ lookupMedia fp (MediaBag mediamap) = M.lookup (splitDirectories fp) mediamap -- their corresponding mime types and the lengths in bytes of the contents. 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. -extractMediaBag :: Bool - -> FilePath - -> MediaBag - -> IO () -extractMediaBag verbose dir (MediaBag mediamap) = 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 - - + M.foldrWithKey (\fp (mime,contents) -> + ((Posix.joinPath fp, mime, fromIntegral $ BL.length contents):)) [] mediamap |