00662fa · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

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

00662faJohn MacFarlane12 years ago

pandoc.hs+10−16

compare with master

unifiedsplit

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

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

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

39 safeRead, headerShift, normalize, err, warn,

40− openURL )

40+ openURL, mediaDirectory, extractMediaBag,

41+ emptyMediaBag )

41import Text.Pandoc.XML ( toEntities )

42import Text.Pandoc.XML ( toEntities )

42import Text.Pandoc.SelfContained ( makeSelfContained )

43import Text.Pandoc.SelfContained ( makeSelfContained )

43import Text.Pandoc.Process (pipeProcess)

44import Text.Pandoc.Process (pipeProcess)

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

50import Data.Char ( toLower )

51import Data.Char ( toLower )

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

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

52import System.Directory ( getAppUserDataDirectory, findExecutable,

53import System.Directory ( getAppUserDataDirectory, findExecutable,

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

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

54− createDirectoryIfMissing )

55import System.IO ( stdout, stderr )

56import System.IO.Error ( isDoesNotExistError )

57import qualified Control.Exception as E

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

1206 then handleIncludes

1207 else return

1208

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−

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

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

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

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

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

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

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

1226 inp <- readSources sources >>=

1217 inp <- readSources sources >>=

1227 handleIncludes' . convertTabs . intercalate "\n"

1218 handleIncludes' . convertTabs . intercalate "\n"

1228 d <- r readerOpts inp

1219 d <- r readerOpts inp

1229− return (d, M.empty)

1220+ return (d, emptyMediaBag)

1230 ByteStringReader r -> do

1221 ByteStringReader r -> do

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

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

1232 d' <- case mbExtractMedia of

1223 d' <- case mbExtractMedia of

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

1224+ Just dir -> do

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

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

1226+ [] -> return d

1227+ fps -> do

1228+ extractMediaBag True dir media

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

1229+ return $ walk (adjustImagePath dir fps) d

1236 _ -> return d

1230 _ -> return d

1237 return (d', media)

1231 return (d', media)

1238

1232

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

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

49import qualified Data.Set as Set

50import Data.Default

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

52−import Text.Pandoc.Shared (MediaBag)

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

53−import qualified Data.Map as M

55-- | Individually selectable syntax extensions.

54-- | Individually selectable syntax extensions.

56data Extension =

55data Extension =

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

359 , writerTOCDepth = 3

358 , writerTOCDepth = 3

360 , writerReferenceODT = Nothing

359 , writerReferenceODT = Nothing

361 , writerReferenceDocx = Nothing

360 , writerReferenceDocx = Nothing

362− , writerMediaBag = M.empty

361+ , writerMediaBag = emptyMediaBag

363 }

362 }

364

363

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

364-- | 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

108

109defaultDState :: DState

110defaultDState = DState { docxAnchorMap = M.empty

111− , docxMediaBag = M.empty

111+ , docxMediaBag = emptyMediaBag

112 , docxInHeaderBlock = False

113 , docxInTexSubscript = False}

114

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

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

370parPartToInlines (Drawing fp bs) = do

371 mediaBag <- gets docxMediaBag

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

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

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

374parPartToInlines (InternalHyperLink anchor runs) = do

375 ils <- concatMapM runToInlines runs

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

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

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

42import Codec.Compression.GZip as Gzip

43import 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)

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

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

46import Text.Pandoc.MIME (getMimeType)

47import Text.Pandoc.MIME (getMimeType)

47import System.Directory (doesFileExist)

48import System.Directory (doesFileExist)

48−import qualified Data.Map as M

50isOk :: Char -> Bool

51isOk c = isAscii c && isAlphaNum c

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

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

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

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

113− let mime = case takeExtension f' of

113+ let mbMime = case takeExtension f' of

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

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

115− x -> getMimeType x

115+ x -> getMimeType x

116 exists <- doesFileExist f'

117− cont <- if exists

117+ if exists

118+ then do

118− then B.readFile f'

119+ cont <- B.readFile f'

120+ return (cont, mbMime)

119− else case M.lookup f media of

121+ else case lookupMedia f media of

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

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

123+ Just mime)

124+ Nothing -> do

121− Nothing -> readDataFile userdata f'

125+ cont <- readDataFile userdata f'

122− return (cont, mime)

126+ return (cont, mbMime)

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

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

124

128

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

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

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

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

1{-# LANGUAGE DeriveDataTypeable, CPP, MultiParamTypeClasses,

2− FlexibleContexts, ScopedTypeVariables #-}

2+ FlexibleContexts, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}

3{-

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

50 tabFilter,

51 -- * Media Handling

52 MediaBag,

53+ emptyMediaBag,

54+ lookupMedia,

53 insertMedia,

55 insertMedia,

56+ mediaDirectory,

57+ extractMediaBag,

54 -- * Date/time

58 -- * Date/time

55 normalizeDate,

59 normalizeDate,

56 -- * Pandoc block and inline list processing

60 -- * Pandoc block and inline list processing

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

102 isLetter, isDigit, isSpace )

106 isLetter, isDigit, isSpace )

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

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

104import qualified Data.Map as M

108import qualified Data.Map as M

109+import Data.Maybe ( fromMaybe )

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

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

106 unEscapeString, parseURIReference )

111 unEscapeString, parseURIReference )

107import qualified Data.Set as Set

112import qualified Data.Set as Set

108import System.Directory

113import System.Directory

109import Text.Pandoc.MIME (getMimeType)

114import Text.Pandoc.MIME (getMimeType)

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

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

116+ splitPath, joinPath )

111import Data.Generics (Typeable, Data)

117import Data.Generics (Typeable, Data)

112import qualified Control.Monad.State as S

118import qualified Control.Monad.State as S

113import qualified Control.Exception as E

119import qualified Control.Exception as E

114−import Control.Monad (msum, unless)

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

115import Text.Pandoc.Pretty (charWidth)

121import Text.Pandoc.Pretty (charWidth)

116import System.Locale (defaultTimeLocale)

122import System.Locale (defaultTimeLocale)

117import Data.Time

123import Data.Time

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

292--- Media handling

298--- Media handling

293---

299---

294

300

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

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

302+-- mime types.

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

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

304+ deriving (Monoid)

297

305

306+instance Show MediaBag where

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

308+

309+emptyMediaBag :: MediaBag

310+emptyMediaBag = MediaBag M.empty

311+

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

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

313+-- value with the same name.

299−insertMedia :: FilePath

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

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

300− -> BL.ByteString

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

317+ -> MediaBag

301 -> MediaBag

318 -> 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

302 -> MediaBag

328 -> 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

304

358

305--

359--

306-- Date/time

360-- Date/time

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

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

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

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

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

805fetchItem' media sourceURL s = do

859fetchItem' media sourceURL s = do

806− case M.lookup s media of

860+ case lookupMedia s media of

807 Nothing -> fetchItem sourceURL s

861 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)

813

863

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

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

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

865openURL :: 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

793 return $ Image lab (newsrc, tit)

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

795 | WebTeX _ <- writerHTMLMathMethod opts = do

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

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

797 return $ RawInline (Format "html") raw

798transformInline opts mediaRef (RawInline fmt raw)

799 | fmt == Format "html" = do

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

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

12import Text.Pandoc.Readers.Docx

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

14import qualified Data.Map as M

15+import Text.Pandoc.Shared (lookupMedia)

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

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

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

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

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

60 df <- B.readFile docxFile

61 df <- B.readFile docxFile

61 mf <- B.readFile mediaFile

62 mf <- B.readFile mediaFile

62 let (_, mb) = readDocx def df

63 let (_, mb) = readDocx def df

63− dBytes = case M.lookup mediaPath mb of

64+ dBytes = case lookupMedia mediaPath mb of

64− Just bs -> bs

65+ Just (_,bs) -> bs

65 Nothing -> error "Media file not found"

66 Nothing -> error "Media file not found"

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

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

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

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