Class: Warn instead or erroring if we can't fetch media

If deferred media can't be fetched, we catch the error and warn
instead. We add an internal function for fetching which returns a Maybe
value, and then run catMaybes to only keep the Just's.
This commit is contained in:
Jesse Rosenthal 2016-12-14 06:34:28 -05:00 committed by John MacFarlane
parent 613588a0dc
commit 5b3bfa28f4

View file

@ -102,6 +102,7 @@ import System.IO.Error
import qualified Data.Map as M
import Text.Pandoc.Error
import Data.Monoid
import Data.Maybe (catMaybes)
class (Functor m, Applicative m, Monad m, MonadError PandocError m)
=> PandocMonad m where
@ -188,15 +189,27 @@ instance Monoid DeferredMediaBag where
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)
fetchDeferredMedia' :: PandocMonad m => m MediaBag
fetchDeferredMedia' = do
(DeferredMediaBag mb defMedia) <- getsCommonState stDeferredMediaBag
fetchedMedia <- mapM (\dfp -> downloadOrRead Nothing (unDefer dfp)) defMedia
fetchedMedia <- catMaybes <$> mapM fetchMediaItem defMedia
return $ foldr
(\(dfp, (bs, mbMime)) mb' ->
MB.insertMedia (unDefer dfp) mbMime (BL.fromStrict bs) mb')
mb
(zip defMedia fetchedMedia)
(\(fp, bs, mbMime) mb' -> MB.insertMedia fp mbMime (BL.fromStrict bs) mb')
mb fetchedMedia
fetchDeferredMedia :: PandocMonad m => m ()
fetchDeferredMedia = fetchDeferredMedia' >>= setMediaBag