Reverted deferred media bag code.

This was not actually being used. Since it adds considerable
complexity, it's best not to include it unless we are
actually going to use it.

The original thought was that we could do all loading in the
readers, always deferred and thus costless.  This was supposed
to eliminate the need to traverse trees loading resources in
the docx, epub, odt writers and in PDF and SelfContained.
(It would also have the side effect that --extract-media could
be used with all input formats.  This wasn't an intended side
effect, and it could be debated whether it's desirable, since
--extract-media was originally designed to extract the media
contained in a docx or odt or epub container.)

However, we never actually took the step of moving all of this
work to the readers, for a couple of reasons. The main reason
is that we'd still need to fetch resources in the docx,
epub, odt, pdf and self-contained writers, since the Pandoc AST might
have been built programatically and hence not generated by a reader.
So it's not clear that doing lazy loading in the readers would have
any real advantage.

I'm still not completely sure about this --- if we change our
minds it would be easy to undo this commit.

@jkr comments welcome.
This commit is contained in:
John MacFarlane 2017-02-09 21:26:24 +01:00
parent 6949d74e01
commit 0a4ba91994

View file

@ -49,7 +49,6 @@ module Text.Pandoc.Class ( PandocMonad(..)
, getMediaBag , getMediaBag
, setMediaBag , setMediaBag
, insertMedia , insertMedia
, insertDeferredMedia
, fetchItem , fetchItem
, getInputFiles , getInputFiles
, getOutputFile , getOutputFile
@ -106,8 +105,6 @@ import System.IO.Error
import System.IO (stderr) import System.IO (stderr)
import qualified Data.Map as M import qualified Data.Map as M
import Text.Pandoc.Error import Text.Pandoc.Error
import Data.Monoid
import Data.Maybe (catMaybes)
import Text.Printf (printf) import Text.Printf (printf)
class (Functor m, Applicative m, Monad m, MonadError PandocError m) class (Functor m, Applicative m, Monad m, MonadError PandocError m)
@ -163,34 +160,16 @@ report level msg = do
modifyCommonState $ \st -> st{ stLog = (level, msg) : stLog st } modifyCommonState $ \st -> st{ stLog = (level, msg) : stLog st }
setMediaBag :: PandocMonad m => MediaBag -> m () setMediaBag :: PandocMonad m => MediaBag -> m ()
setMediaBag mb = modifyCommonState $ setMediaBag mb = modifyCommonState $ \st -> st{stMediaBag = mb}
\st -> st{stDeferredMediaBag = DeferredMediaBag mb mempty}
getMediaBag :: PandocMonad m => m MediaBag getMediaBag :: PandocMonad m => m MediaBag
getMediaBag = do getMediaBag = getsCommonState stMediaBag
fetchDeferredMedia
DeferredMediaBag mb' _ <- getsCommonState stDeferredMediaBag
return mb'
fetchDeferredMedia :: PandocMonad m => m ()
fetchDeferredMedia = do
(DeferredMediaBag mb defMedia) <- getsCommonState stDeferredMediaBag
fetchedMedia <- catMaybes <$> mapM fetchMediaItem defMedia
setMediaBag $ foldr
(\(fp, bs, mbMime) mb' -> MB.insertMedia fp mbMime (BL.fromStrict bs) mb')
mb fetchedMedia
insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m () insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()
insertMedia fp mime bs = do insertMedia fp mime bs = do
(DeferredMediaBag mb dm) <- getsCommonState stDeferredMediaBag mb <- getsCommonState stMediaBag
let mb' = MB.insertMedia fp mime bs mb let mb' = MB.insertMedia fp mime bs mb
modifyCommonState $ \st -> st{stDeferredMediaBag =DeferredMediaBag mb' dm } modifyCommonState $ \st -> st{stMediaBag = mb' }
insertDeferredMedia :: PandocMonad m => FilePath -> m ()
insertDeferredMedia fp = do
(DeferredMediaBag mb dm) <- getsCommonState stDeferredMediaBag
modifyCommonState $
\st -> st{stDeferredMediaBag = DeferredMediaBag mb ((DeferredMediaPath fp) : dm)}
getInputFiles :: PandocMonad m => m (Maybe [FilePath]) getInputFiles :: PandocMonad m => m (Maybe [FilePath])
getInputFiles = getsCommonState stInputFiles getInputFiles = getsCommonState stInputFiles
@ -218,32 +197,8 @@ readFileFromDirs (d:ds) f = catchError
-- --
newtype DeferredMediaPath = DeferredMediaPath {unDefer :: String}
deriving (Show, Eq)
data DeferredMediaBag = DeferredMediaBag MediaBag [DeferredMediaPath]
deriving (Show)
instance Monoid DeferredMediaBag where
mempty = DeferredMediaBag mempty mempty
mappend (DeferredMediaBag mb lst) (DeferredMediaBag mb' lst') =
DeferredMediaBag (mb <> mb') (lst <> lst')
-- the internal function for downloading individual items. We want to
-- catch errors and return a Nothing with a warning, so we can
-- continue without erroring out.
fetchMediaItem :: PandocMonad m
=> DeferredMediaPath
-> m (Maybe (FilePath, B.ByteString, Maybe MimeType))
fetchMediaItem dfp =
(do (bs, mbmime) <- downloadOrRead Nothing (unDefer dfp)
return $ Just $ (unDefer dfp, bs, mbmime))
`catchError`
(const $ do warning ("Couldn't access media at " ++ unDefer dfp)
return Nothing)
data CommonState = CommonState { stLog :: [(Verbosity, String)] data CommonState = CommonState { stLog :: [(Verbosity, String)]
, stDeferredMediaBag :: DeferredMediaBag , stMediaBag :: MediaBag
, stInputFiles :: Maybe [FilePath] , stInputFiles :: Maybe [FilePath]
, stOutputFile :: Maybe FilePath , stOutputFile :: Maybe FilePath
, stVerbosity :: Verbosity , stVerbosity :: Verbosity
@ -251,7 +206,7 @@ data CommonState = CommonState { stLog :: [(Verbosity, String)]
instance Default CommonState where instance Default CommonState where
def = CommonState { stLog = [] def = CommonState { stLog = []
, stDeferredMediaBag = mempty , stMediaBag = mempty
, stInputFiles = Nothing , stInputFiles = Nothing
, stOutputFile = Nothing , stOutputFile = Nothing
, stVerbosity = WARNING , stVerbosity = WARNING