400fe31 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Allow `--extract-media` to work with non-binary input formats.

400fe31John MacFarlane9 years ago

src/Text/Pandoc/App.hs+26−4

compare with master

unifiedsplit

@@ -45,6 +45,7 @@ import Data.Aeson (eitherDecode', encode)

45import qualified Data.ByteString as BS

46import qualified Data.ByteString.Lazy as B

47import Data.Char (toLower, toUpper)

48+import Data.Digest.Pure.SHA (sha1, showDigest)

48import qualified Data.Set as Set

49import qualified Data.Set as Set

49import Data.Foldable (foldrM)

50import Data.Foldable (foldrM)

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

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

@@ -68,17 +69,19 @@ import System.IO (stdout)

68import System.IO.Error (isDoesNotExistError)

69import System.IO.Error (isDoesNotExistError)

69import Text.Pandoc

70import Text.Pandoc

70import Text.Pandoc.Builder (setMeta)

71import Text.Pandoc.Builder (setMeta)

71−import Text.Pandoc.Class (PandocIO, getLog, withMediaBag, getMediaBag)

72+import Text.Pandoc.Class (PandocIO, getLog, withMediaBag, getMediaBag,

73+ fetchItem, insertMedia)

72import Text.Pandoc.Highlighting (highlightingStyles)

74import Text.Pandoc.Highlighting (highlightingStyles)

73import Text.Pandoc.Lua ( runLuaFilter )

75import Text.Pandoc.Lua ( runLuaFilter )

74import Text.Pandoc.MediaBag (extractMediaBag, mediaDirectory)

76import Text.Pandoc.MediaBag (extractMediaBag, mediaDirectory)

77+import Text.Pandoc.MIME (extensionFromMimeType)

75import Text.Pandoc.PDF (makePDF)

78import Text.Pandoc.PDF (makePDF)

76import Text.Pandoc.Process (pipeProcess)

79import Text.Pandoc.Process (pipeProcess)

77import Text.Pandoc.SelfContained (makeSelfContained, makeDataURI)

80import Text.Pandoc.SelfContained (makeSelfContained, makeDataURI)

78import Text.Pandoc.Shared (headerShift, openURL, readDataFile,

81import Text.Pandoc.Shared (headerShift, openURL, readDataFile,

79 readDataFileUTF8, safeRead, tabFilter)

82 readDataFileUTF8, safeRead, tabFilter)

80import qualified Text.Pandoc.UTF8 as UTF8

83import qualified Text.Pandoc.UTF8 as UTF8

81−import Text.Pandoc.Walk (walk)

84+import Text.Pandoc.Walk (walkM, walk)

82import Text.Pandoc.XML (toEntities)

85import Text.Pandoc.XML (toEntities)

83import Text.Printf

86import Text.Printf

84#ifndef _WINDOWS

87#ifndef _WINDOWS

@@ -413,11 +416,15 @@ convertWithOpts opts = do

413

416

414 runIO' $ do

417 runIO' $ do

415 (doc, media) <- withMediaBag $ sourceToDoc sources >>=

418 (doc, media) <- withMediaBag $ sourceToDoc sources >>=

419+ ( (if isJust (optExtractMedia opts)

420+ then fillMedia (writerSourceURL writerOptions)

421+ else return)

416− (maybe return extractMedia (optExtractMedia opts)

422+ >=> maybe return extractMedia (optExtractMedia opts)

417 >=> return . flip (foldr addMetadata) metadata

423 >=> return . flip (foldr addMetadata) metadata

418 >=> applyTransforms transforms

424 >=> applyTransforms transforms

419 >=> applyLuaFilters datadir (optLuaFilters opts) [format]

425 >=> applyLuaFilters datadir (optLuaFilters opts) [format]

420− >=> applyFilters datadir filters' [format])

426+ >=> applyFilters datadir filters' [format]

427+ )

421

428

422 case writer of

429 case writer of

423 ByteStringWriter f -> f writerOptions doc >>= writeFnBinary outputFile

430 ByteStringWriter f -> f writerOptions doc >>= writeFnBinary outputFile

@@ -723,6 +730,21 @@ defaultWriterName x =

723

730

724-- Transformations of a Pandoc document post-parsing:

731-- Transformations of a Pandoc document post-parsing:

725

732

733+-- | Traverse tree, filling media bag.

734+fillMedia :: Maybe String -> Pandoc -> PandocIO Pandoc

735+fillMedia sourceURL d = walkM handleImage d

736+ where handleImage :: Inline -> PandocIO Inline

737+ handleImage (Image attr lab (src, tit)) = do

738+ (bs, mt) <- fetchItem sourceURL src

739+ let ext = fromMaybe (takeExtension src)

740+ (mt >>= extensionFromMimeType)

741+ let bs' = B.fromChunks [bs]

742+ let basename = showDigest $ sha1 bs'

743+ let fname = basename <.> ext

744+ insertMedia fname mt bs'

745+ return $ Image attr lab (fname, tit)

746+ handleImage x = return x

747+

726extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc

748extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc

727extractMedia dir d = do

749extractMedia dir d = do

728 media <- getMediaBag

750 media <- getMediaBag