af7215a · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Moved fillMedia, extractMedia from App to Class.

af7215aJohn MacFarlane10 years ago

src/Text/Pandoc/App.hs+3−49

compare with master

unifiedsplit

@@ -39,14 +39,13 @@ module Text.Pandoc.App (

39 ) where

40import Control.Applicative ((<|>))

41import qualified Control.Exception as E

42−import Control.Monad.Except (catchError, throwError)

42+import Control.Monad.Except (throwError)

43import Control.Monad

44import Control.Monad.Trans

45import Data.Aeson (eitherDecode', encode)

46import qualified Data.ByteString as BS

47import qualified Data.ByteString.Lazy as B

48import Data.Char (toLower, toUpper)

49−import Data.Digest.Pure.SHA (sha1, showDigest)

50import qualified Data.Set as Set

49import qualified Data.Set as Set

51import Data.Foldable (foldrM)

50import Data.Foldable (foldrM)

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

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

@@ -70,19 +69,16 @@ import System.IO (stdout)

70import System.IO.Error (isDoesNotExistError)

69import System.IO.Error (isDoesNotExistError)

71import Text.Pandoc

70import Text.Pandoc

72import Text.Pandoc.Builder (setMeta)

71import Text.Pandoc.Builder (setMeta)

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

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

74− fetchItem, insertMedia, report)

73+ extractMedia, fillMedia)

75import Text.Pandoc.Highlighting (highlightingStyles)

74import Text.Pandoc.Highlighting (highlightingStyles)

76import Text.Pandoc.Lua ( runLuaFilter )

75import Text.Pandoc.Lua ( runLuaFilter )

77−import Text.Pandoc.MediaBag (extractMediaBag, mediaDirectory)

78−import Text.Pandoc.MIME (extensionFromMimeType)

79import Text.Pandoc.PDF (makePDF)

76import Text.Pandoc.PDF (makePDF)

80import Text.Pandoc.Process (pipeProcess)

77import Text.Pandoc.Process (pipeProcess)

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

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

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

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

83 readDataFileUTF8, safeRead, tabFilter)

80 readDataFileUTF8, safeRead, tabFilter)

84import qualified Text.Pandoc.UTF8 as UTF8

81import qualified Text.Pandoc.UTF8 as UTF8

85−import Text.Pandoc.Walk (walkM, walk)

86import Text.Pandoc.XML (toEntities)

82import Text.Pandoc.XML (toEntities)

87import Text.Printf

83import Text.Printf

88#ifndef _WINDOWS

84#ifndef _WINDOWS

@@ -731,48 +727,6 @@ defaultWriterName x =

731

727

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

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

733

729

734−-- | Traverse tree, filling media bag.

735−fillMedia :: Maybe String -> Pandoc -> PandocIO Pandoc

736−fillMedia sourceURL d = walkM handleImage d

737− where handleImage :: Inline -> PandocIO Inline

738− handleImage (Image attr lab (src, tit)) = catchError

739− (do (bs, mt) <- fetchItem sourceURL src

740− let ext = fromMaybe (takeExtension src)

741− (mt >>= extensionFromMimeType)

742− let bs' = B.fromChunks [bs]

743− let basename = showDigest $ sha1 bs'

744− let fname = basename <.> ext

745− insertMedia fname mt bs'

746− return $ Image attr lab (fname, tit))

747− (\e -> do

748− case e of

749− PandocResourceNotFound _ -> do

750− report $ CouldNotFetchResource src

751− "replacing image with description"

752− -- emit alt text

753− return $ Span ("",["image"],[]) lab

754− PandocHttpError u er -> do

755− report $ CouldNotFetchResource u

756− (show er ++ "\rReplacing image with description.")

757− -- emit alt text

758− return $ Span ("",["image"],[]) lab

759− _ -> throwError e)

760− handleImage x = return x

761−

762−extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc

763−extractMedia dir d = do

764− media <- getMediaBag

765− case [fp | (fp, _, _) <- mediaDirectory media] of

766− [] -> return d

767− fps -> do

768− liftIO $ extractMediaBag True dir media

769− return $ walk (adjustImagePath dir fps) d

770−

771−adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline

772−adjustImagePath dir paths (Image attr lab (src, tit))

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

774−adjustImagePath _ _ x = x

775−

776applyTransforms :: Monad m => [Transform] -> Pandoc -> m Pandoc

730applyTransforms :: Monad m => [Transform] -> Pandoc -> m Pandoc

777applyTransforms transforms d = return $ foldr ($) d transforms

731applyTransforms transforms d = return $ foldr ($) d transforms

778

732

src/Text/Pandoc/Class.hs+53−3

@@ -61,6 +61,8 @@ module Text.Pandoc.Class ( PandocMonad(..)

61 , runIOorExplode

62 , runPure

63 , withMediaBag

64+ , fillMedia

65+ , extractMedia

64 ) where

66 ) where

66import Prelude hiding (readFile)

68import Prelude hiding (readFile)

@@ -76,8 +78,11 @@ import Text.Pandoc.Compat.Time (UTCTime)

76import Text.Pandoc.Logging

78import Text.Pandoc.Logging

77import Text.Parsec (ParsecT)

79import Text.Parsec (ParsecT)

78import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)

80import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)

79−import Text.Pandoc.MIME (MimeType, getMimeType)

81+import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)

82+import Text.Pandoc.Definition

80import Data.Char (toLower)

83import Data.Char (toLower)

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

85+import Data.Maybe (fromMaybe)

81import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds

86import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds

82 , posixSecondsToUTCTime

87 , posixSecondsToUTCTime

83 , POSIXTime )

88 , POSIXTime )

@@ -86,13 +91,15 @@ import Network.URI ( escapeURIString, nonStrictRelativeTo,

86 unEscapeString, parseURIReference, isAllowedInURI,

91 unEscapeString, parseURIReference, isAllowedInURI,

87 parseURI, URI(..) )

92 parseURI, URI(..) )

88import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)

93import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)

89−import Text.Pandoc.MediaBag (MediaBag, lookupMedia)

94+import Text.Pandoc.MediaBag (MediaBag, lookupMedia, extractMediaBag,

95+ mediaDirectory)

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

90import qualified Text.Pandoc.MediaBag as MB

97import qualified Text.Pandoc.MediaBag as MB

91import qualified Data.ByteString as B

98import qualified Data.ByteString as B

92import qualified Data.ByteString.Lazy as BL

99import qualified Data.ByteString.Lazy as BL

93import qualified System.Environment as IO (lookupEnv)

100import qualified System.Environment as IO (lookupEnv)

94import System.FilePath.Glob (match, compile)

101import System.FilePath.Glob (match, compile)

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

102+import System.FilePath ((</>), (<.>), takeExtension, dropExtension, isRelative)

96import qualified System.FilePath.Glob as IO (glob)

103import qualified System.FilePath.Glob as IO (glob)

97import qualified System.Directory as IO (getModificationTime)

104import qualified System.Directory as IO (getModificationTime)

98import Control.Monad as M (fail)

105import Control.Monad as M (fail)

@@ -338,6 +345,49 @@ withPaths (p:ps) action fp =

338 catchError (action (p </> fp))

345 catchError (action (p </> fp))

339 (\_ -> withPaths ps action fp)

346 (\_ -> withPaths ps action fp)

340

347

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

349+fillMedia :: PandocMonad m => Maybe String -> Pandoc -> m Pandoc

350+fillMedia sourceURL d = walkM handleImage d

351+ where handleImage :: PandocMonad m => Inline -> m Inline

352+ handleImage (Image attr lab (src, tit)) = catchError

353+ (do (bs, mt) <- fetchItem sourceURL src

354+ let ext = fromMaybe (takeExtension src)

355+ (mt >>= extensionFromMimeType)

356+ let bs' = BL.fromChunks [bs]

357+ let basename = showDigest $ sha1 bs'

358+ let fname = basename <.> ext

359+ insertMedia fname mt bs'

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

361+ (\e -> do

362+ case e of

363+ PandocResourceNotFound _ -> do

364+ report $ CouldNotFetchResource src

365+ "replacing image with description"

366+ -- emit alt text

367+ return $ Span ("",["image"],[]) lab

368+ PandocHttpError u er -> do

369+ report $ CouldNotFetchResource u

370+ (show er ++ "\rReplacing image with description.")

371+ -- emit alt text

372+ return $ Span ("",["image"],[]) lab

373+ _ -> throwError e)

374+ handleImage x = return x

375+

376+-- | Extract media from the mediabag into a directory.

377+extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc

378+extractMedia dir d = do

379+ media <- getMediaBag

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

381+ [] -> return d

382+ fps -> do

383+ liftIO $ extractMediaBag True dir media

384+ return $ walk (adjustImagePath dir fps) d

385+

386+adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline

387+adjustImagePath dir paths (Image attr lab (src, tit))

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

389+adjustImagePath _ _ x = x

390+

341data PureState = PureState { stStdGen :: StdGen

391data PureState = PureState { stStdGen :: StdGen

342 , stWord8Store :: [Word8] -- should be

392 , stWord8Store :: [Word8] -- should be

343 -- inifinite,

393 -- inifinite,