af7215a · typeable/pandoc

git.iko.soy/typeable/pandoc

Moved fillMedia, extractMedia from App to Class.

Also generalized type of fillMedia to any instance of PandocMonad.

commitaf7215a048a490a7c69eb6ea906bf4ca5d09c1b1 authorJohn MacFarlane <jgm@berkeley.edu> dateSun 7 May 2017, 20:42 (10 years ago) parent99be906

2 files changed+56−52

compare with master

unifiedsplit

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

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

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

3939 ) where

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

4141import qualified Control.Exception as E

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

42+import Control.Monad.Except (throwError)

4343import Control.Monad

4444import Control.Monad.Trans

4545import Data.Aeson (eitherDecode', encode)

4646import qualified Data.ByteString as BS

4747import qualified Data.ByteString.Lazy as B

4848import Data.Char (toLower, toUpper)

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

5049import qualified Data.Set as Set

5150import Data.Foldable (foldrM)

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

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

7069import System.IO.Error (isDoesNotExistError)

7170import Text.Pandoc

7271import Text.Pandoc.Builder (setMeta)

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

74− fetchItem, insertMedia, report)

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

73+ extractMedia, fillMedia)

7574import Text.Pandoc.Highlighting (highlightingStyles)

7675import Text.Pandoc.Lua ( runLuaFilter )

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

78−import Text.Pandoc.MIME (extensionFromMimeType)

7976import Text.Pandoc.PDF (makePDF)

8077import Text.Pandoc.Process (pipeProcess)

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

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

8380 readDataFileUTF8, safeRead, tabFilter)

8481import qualified Text.Pandoc.UTF8 as UTF8

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

8682import Text.Pandoc.XML (toEntities)

8783import Text.Printf

8884#ifndef _WINDOWS

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

731727

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

733729

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−

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

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

778732

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

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

6161 , runIOorExplode

6262 , runPure

6363 , withMediaBag

64+ , fillMedia

65+ , extractMedia

6466 ) where

6567

6668import Prelude hiding (readFile)

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

7678import Text.Pandoc.Logging

7779import Text.Parsec (ParsecT)

7880import 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

8083import Data.Char (toLower)

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

85+import Data.Maybe (fromMaybe)

8186import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds

8287 , posixSecondsToUTCTime

8388 , POSIXTime )

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

8691 unEscapeString, parseURIReference, isAllowedInURI,

8792 parseURI, URI(..) )

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

9097import qualified Text.Pandoc.MediaBag as MB

9198import qualified Data.ByteString as B

9299import qualified Data.ByteString.Lazy as BL

93100import qualified System.Environment as IO (lookupEnv)

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

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

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

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

97104import qualified System.Directory as IO (getModificationTime)

98105import Control.Monad as M (fail)

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

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

339346 (\_ -> withPaths ps action fp)

340347

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+

341391data PureState = PureState { stStdGen :: StdGen

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

343393 -- inifinite,