00662fa · typeable/pandoc

git.iko.soy/typeable/pandoc

Made MediaBag a newtype, and added mime type information to media.

Shared now exports functions for interacting with a MediaBag: - `emptyMediaBag` - `lookuMedia` - `insertMedia` - `mediaDirectory` - `extractMediaBag`

commit00662faefbca0b9889d3d79dbb2985350356d18a authorJohn MacFarlane <fiddlosopher@gmail.com> dateThu 31 Jul 2014, 11:04 (12 years ago) parent6e96f8b

7 files changed+98−50

compare with master

unifiedsplit

pandoc.hs+10−16 src/Text/Pandoc/Options.hs+2−3 src/Text/Pandoc/Readers/Docx.hs+2−2 src/Text/Pandoc/SelfContained.hs+15−11 src/Text/Pandoc/Shared.hs+65−15 src/Text/Pandoc/Writers/EPUB.hs+1−1 tests/Tests/Readers/Docx.hs+3−2

pandoc.hs+10−16

@@ -37,7 +37,8 @@ import Text.Pandoc.Walk (walk)

3737import Text.Pandoc.Readers.LaTeX (handleIncludes)

3838import Text.Pandoc.Shared ( tabFilter, readDataFileUTF8, readDataFile,

3939 safeRead, headerShift, normalize, err, warn,

40− openURL )

40+ openURL, mediaDirectory, extractMediaBag,

41+ emptyMediaBag )

4142import Text.Pandoc.XML ( toEntities )

4243import Text.Pandoc.SelfContained ( makeSelfContained )

4344import Text.Pandoc.Process (pipeProcess)

@@ -50,8 +51,7 @@ import System.Console.GetOpt

5051import Data.Char ( toLower )

5152import Data.List ( intercalate, isPrefixOf, isSuffixOf, sort )

5253import System.Directory ( getAppUserDataDirectory, findExecutable,

53− doesFileExist, Permissions(..), getPermissions,

54− createDirectoryIfMissing )

54+ doesFileExist, Permissions(..), getPermissions )

5555import System.IO ( stdout, stderr )

5656import System.IO.Error ( isDoesNotExistError )

5757import qualified Control.Exception as E

@@ -1206,15 +1206,6 @@ main = do

12061206 then handleIncludes

12071207 else return

12081208

1209− let writeMedia :: FilePath -> (FilePath, B.ByteString) -> IO ()

1210− writeMedia dir (subpath, bs) = do

1211− -- we join and split to convert a/b/c to a\b\c on Windows;

1212− -- in zip containers all paths use /

1213− let fullpath = dir </> joinPath (splitPath subpath)

1214− createDirectoryIfMissing True $ takeDirectory fullpath

1215− warn $ "extracting " ++ fullpath

1216− B.writeFile fullpath bs

1217−

12181209 let adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline

12191210 adjustImagePath dir paths (Image lab (src, tit))

12201211 | src `elem` paths = Image lab (dir ++ "/" ++ src, tit)

@@ -1226,13 +1217,16 @@ main = do

12261217 inp <- readSources sources >>=

12271218 handleIncludes' . convertTabs . intercalate "\n"

12281219 d <- r readerOpts inp

1229− return (d, M.empty)

1220+ return (d, emptyMediaBag)

12301221 ByteStringReader r -> do

12311222 (d, media) <- readFiles sources >>= r readerOpts

12321223 d' <- case mbExtractMedia of

1233− Just dir | not (M.null media) -> do

1234− mapM_ (writeMedia dir) $ M.toList media

1235− return $ walk (adjustImagePath dir (M.keys media)) d

1224+ Just dir -> do

1225+ case [fp | (fp, _, _) <- mediaDirectory media] of

1226+ [] -> return d

1227+ fps -> do

1228+ extractMediaBag True dir media

1229+ return $ walk (adjustImagePath dir fps) d

12361230 _ -> return d

12371231 return (d', media)

12381232

src/Text/Pandoc/Options.hs+2−3

@@ -49,8 +49,7 @@ import Data.Set (Set)

4949import qualified Data.Set as Set

5050import Data.Default

5151import Text.Pandoc.Highlighting (Style, pygments)

52−import Text.Pandoc.Shared (MediaBag)

53−import qualified Data.Map as M

52+import Text.Pandoc.Shared (MediaBag, emptyMediaBag)

5453

5554-- | Individually selectable syntax extensions.

5655data Extension =

@@ -359,7 +358,7 @@ instance Default WriterOptions where

359358 , writerTOCDepth = 3

360359 , writerReferenceODT = Nothing

361360 , writerReferenceDocx = Nothing

362− , writerMediaBag = M.empty

361+ , writerMediaBag = emptyMediaBag

363362 }

364363

365364-- | Returns True if the given extension is enabled.

src/Text/Pandoc/Readers/Docx.hs+2−2

@@ -108,7 +108,7 @@ data DState = DState { docxAnchorMap :: M.Map String String

108108

109109defaultDState :: DState

110110defaultDState = DState { docxAnchorMap = M.empty

111− , docxMediaBag = M.empty

111+ , docxMediaBag = emptyMediaBag

112112 , docxInHeaderBlock = False

113113 , docxInTexSubscript = False}

114114

@@ -369,7 +369,7 @@ parPartToInlines (BookMark _ anchor) =

369369 return [Span (newAnchor, ["anchor"], []) []]

370370parPartToInlines (Drawing fp bs) = do

371371 mediaBag <- gets docxMediaBag

372− modify $ \s -> s { docxMediaBag = M.insert fp bs mediaBag}

372+ modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag }

373373 return [Image [] (fp, "")]

374374parPartToInlines (InternalHyperLink anchor runs) = do

375375 ils <- concatMapM runToInlines runs

src/Text/Pandoc/SelfContained.hs+15−11

@@ -41,11 +41,11 @@ import System.FilePath (takeExtension, dropExtension, takeDirectory, (</>))

4141import Data.Char (toLower, isAscii, isAlphaNum)

4242import Codec.Compression.GZip as Gzip

4343import qualified Data.ByteString.Lazy as L

44−import Text.Pandoc.Shared (renderTags', openURL, readDataFile, err, MediaBag)

44+import Text.Pandoc.Shared (renderTags', openURL, readDataFile, err,

45+ MediaBag, lookupMedia)

4546import Text.Pandoc.UTF8 (toString, fromString)

4647import Text.Pandoc.MIME (getMimeType)

4748import System.Directory (doesFileExist)

48−import qualified Data.Map as M

4949

5050isOk :: Char -> Bool

5151isOk c = isAscii c && isAlphaNum c

@@ -110,16 +110,20 @@ getItem media userdata f =

110110 -- this is needed for things like cmunrm.eot?#iefix,

111111 -- which is used to get old versions of IE to work with web fonts.

112112 let f' = takeWhile (\c -> c /= '?' && c /= '#') f

113− let mime = case takeExtension f' of

114− ".gz" -> getMimeType $ dropExtension f'

115− x -> getMimeType x

113+ let mbMime = case takeExtension f' of

114+ ".gz" -> getMimeType $ dropExtension f'

115+ x -> getMimeType x

116116 exists <- doesFileExist f'

117− cont <- if exists

118− then B.readFile f'

119− else case M.lookup f media of

120− Just bs -> return $ BS.concat $ L.toChunks bs

121− Nothing -> readDataFile userdata f'

122− return (cont, mime)

117+ if exists

118+ then do

119+ cont <- B.readFile f'

120+ return (cont, mbMime)

121+ else case lookupMedia f media of

122+ Just (mime,bs) -> return (BS.concat $ L.toChunks bs,

123+ Just mime)

124+ Nothing -> do

125+ cont <- readDataFile userdata f'

126+ return (cont, mbMime)

123127 where handleErr e = err 61 $ "Failed to retrieve " ++ f ++ "\n" ++ show e

124128

125129getRaw :: MediaBag -> Maybe FilePath -> String -> String

src/Text/Pandoc/Shared.hs+65−15

@@ -1,5 +1,5 @@

11{-# LANGUAGE DeriveDataTypeable, CPP, MultiParamTypeClasses,

2− FlexibleContexts, ScopedTypeVariables #-}

2+ FlexibleContexts, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}

33{-

@@ -50,7 +50,11 @@ module Text.Pandoc.Shared (

5050 tabFilter,

5151 -- * Media Handling

5252 MediaBag,

53+ emptyMediaBag,

54+ lookupMedia,

5355 insertMedia,

56+ mediaDirectory,

57+ extractMediaBag,

5458 -- * Date/time

5559 normalizeDate,

5660 -- * Pandoc block and inline list processing

@@ -102,16 +106,18 @@ import Data.Char ( toLower, isLower, isUpper, isAlpha,

102106 isLetter, isDigit, isSpace )

103107import Data.List ( find, isPrefixOf, intercalate )

104108import qualified Data.Map as M

109+import Data.Maybe ( fromMaybe )

105110import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo,

106111 unEscapeString, parseURIReference )

107112import qualified Data.Set as Set

108113import System.Directory

109114import Text.Pandoc.MIME (getMimeType)

110−import System.FilePath ( (</>), takeExtension, dropExtension )

115+import System.FilePath ( (</>), takeExtension, dropExtension, takeDirectory,

116+ splitPath, joinPath )

111117import Data.Generics (Typeable, Data)

112118import qualified Control.Monad.State as S

113119import qualified Control.Exception as E

114−import Control.Monad (msum, unless)

120+import Control.Monad (msum, unless, MonadPlus(..), when)

115121import Text.Pandoc.Pretty (charWidth)

116122import System.Locale (defaultTimeLocale)

117123import Data.Time

@@ -292,15 +298,63 @@ tabFilter tabStop =

292298--- Media handling

293299---

294300

295−-- | A map of media paths to their binary representations.

296−type MediaBag = M.Map String BL.ByteString

301+-- | A container for a collection of binary resources, with names and

302+-- mime types.

303+newtype MediaBag = MediaBag (M.Map String (String, BL.ByteString))

304+ deriving (Monoid)

297305

298−-- | Insert a media item into a `MediaBag`

299−insertMedia :: FilePath

300− -> BL.ByteString

306+instance Show MediaBag where

307+ show bag = "MediaBag " ++ show (mediaDirectory bag)

308+

309+emptyMediaBag :: MediaBag

310+emptyMediaBag = MediaBag M.empty

311+

312+-- | Insert a media item into a 'MediaBag', replacing any existing

313+-- value with the same name.

314+insertMedia :: FilePath -- ^ relative path and canonical name of resource

315+ -> Maybe String -- ^ mime type (Nothing = determine from extension)

316+ -> BL.ByteString -- ^ contents of resource

317+ -> MediaBag

301318 -> MediaBag

319+insertMedia fp mbMime contents (MediaBag mediamap) =

320+ MediaBag (M.insert fp (mime, contents) mediamap)

321+ where mime = fromMaybe "application/octet-stream" (mbMime `mplus` fallback)

322+ fallback = case takeExtension fp of

323+ ".gz" -> getMimeType $ dropExtension fp

324+ _ -> getMimeType fp

325+

326+-- | Lookup a media item in a 'MediaBag', returning mime type and contents.

327+lookupMedia :: FilePath

302328 -> MediaBag

303−insertMedia = M.insert

329+ -> Maybe (String, BL.ByteString)

330+lookupMedia fp (MediaBag mediamap) = M.lookup fp mediamap

331+

332+-- | Get a list of the file paths stored in a 'MediaBag', with

333+-- their corresponding mime types and the lengths in bytes of the contents.

334+mediaDirectory :: MediaBag -> [(String, String, Int)]

335+mediaDirectory (MediaBag mediamap) =

336+ M.foldWithKey (\fp (mime,contents) ->

337+ ((fp, mime, fromIntegral $ BL.length contents):)) [] mediamap

338+

339+-- | Extract contents of MediaBag to a given directory. Print informational

340+-- messages if 'verbose' is true.

341+extractMediaBag :: Bool

342+ -> FilePath

343+ -> MediaBag

344+ -> IO ()

345+extractMediaBag verbose dir (MediaBag mediamap) = do

346+ sequence_ $ M.foldWithKey

347+ (\fp (_ ,contents) ->

348+ ((writeMedia verbose dir (fp, contents)):)) [] mediamap

349+

350+writeMedia :: Bool -> FilePath -> (FilePath, BL.ByteString) -> IO ()

351+writeMedia verbose dir (subpath, bs) = do

352+ -- we join and split to convert a/b/c to a\b\c on Windows;

353+ -- in zip containers all paths use /

354+ let fullpath = dir </> joinPath (splitPath subpath)

355+ createDirectoryIfMissing True $ takeDirectory fullpath

356+ when verbose $ warn $ "extracting " ++ fullpath

357+ BL.writeFile fullpath bs

304358

305359--

306360-- Date/time

@@ -803,13 +857,9 @@ fetchItem sourceURL s

803857fetchItem' :: MediaBag -> Maybe String -> String

804858 -> IO (Either E.SomeException (BS.ByteString, Maybe String))

805859fetchItem' media sourceURL s = do

806− case M.lookup s media of

860+ case lookupMedia s media of

807861 Nothing -> fetchItem sourceURL s

808− Just bs -> do

809− let mime = case takeExtension s of

810− ".gz" -> getMimeType $ dropExtension s

811− x -> getMimeType x

812− return $ Right (BS.concat $ toChunks bs, mime)

862+ Just (mime, bs) -> return $ Right (BS.concat $ toChunks bs, Just mime)

813863

814864-- | Read from a URL and return raw data and maybe mime type.

815865openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe String))

src/Text/Pandoc/Writers/EPUB.hs+1−1

@@ -793,7 +793,7 @@ transformInline opts mediaRef (Image lab (src,tit)) = do

793793 return $ Image lab (newsrc, tit)

794794transformInline opts _ (x@(Math _ _))

795795 | WebTeX _ <- writerHTMLMathMethod opts = do

796− raw <- makeSelfContained M.empty Nothing $ writeHtmlInline opts x

796+ raw <- makeSelfContained emptyMediaBag Nothing $ writeHtmlInline opts x

797797 return $ RawInline (Format "html") raw

798798transformInline opts mediaRef (RawInline fmt raw)

799799 | fmt == Format "html" = do

tests/Tests/Readers/Docx.hs+3−2

@@ -12,6 +12,7 @@ import qualified Data.ByteString.Base64 as B64

1212import Text.Pandoc.Readers.Docx

1313import Text.Pandoc.Writers.Native (writeNative)

1414import qualified Data.Map as M

15+import Text.Pandoc.Shared (lookupMedia)

1516

1617-- We define a wrapper around pandoc that doesn't normalize in the

1718-- tests. Since we do our own normalization, we want to make sure

@@ -60,8 +61,8 @@ testCompareMediaIO name docxFile mediaPath mediaFile = do

6061 df <- B.readFile docxFile

6162 mf <- B.readFile mediaFile

6263 let (_, mb) = readDocx def df

63− dBytes = case M.lookup mediaPath mb of

64− Just bs -> bs

64+ dBytes = case lookupMedia mediaPath mb of

65+ Just (_,bs) -> bs

6566 Nothing -> error "Media file not found"

6667 d64 = B8.unpack $ B64.encode $ BS.concat $ B.toChunks dBytes

6768 m64 = B8.unpack $ B64.encode $ BS.concat $ B.toChunks mf