diff options
author | Jesse Rosenthal <jrosenthal@jhu.edu> | 2016-12-14 06:34:28 -0500 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2017-01-25 17:07:42 +0100 |
commit | 5b3bfa28f4a093a1096f628b84180165bc4cff29 (patch) | |
tree | 426a30fcd0071be911be8f27289d2ac684c9d72d | |
parent | 613588a0dcc21c9ebdcea246a6113f0122785eeb (diff) | |
download | pandoc-5b3bfa28f4a093a1096f628b84180165bc4cff29.tar.gz |
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.
-rw-r--r-- | src/Text/Pandoc/Class.hs | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 11b827aba..da9b837f7 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -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 |