@@ -191,7 +191,7 @@ instance Monoid DeferredMediaBag where
191191fetchDeferredMedia' :: PandocMonad m => m MediaBag
192192fetchDeferredMedia' = do
193193 (DeferredMediaBag mb defMedia) <- getsCommonState stDeferredMediaBag
194− fetchedMedia <- mapM (\dfp -> fetchItem Nothing (unDefer dfp)) defMedia
194+ fetchedMedia <- mapM (\dfp -> downloadOrRead Nothing (unDefer dfp)) defMedia
195195 return $ foldr
196196 (\(dfp, (bs, mbMime)) mb' ->
197197 MB.insertMedia (unDefer dfp) mbMime (BL.fromStrict bs) mb')
@@ -298,44 +298,50 @@ fetchItem :: PandocMonad m
298298 -> String
299299 -> m (B.ByteString, Maybe MimeType)
300300fetchItem sourceURL s = do
301− mediabag <- dropDeferredMedia <$> getsCommonState stDeferredMediaBag
301+ mediabag <- getMediaBag
302302 case lookupMedia s mediabag of
303− Just (mime, bs) -> return $ (BL.toStrict bs, Just mime)
304− Nothing ->
305− case (sourceURL >>= parseURIReference' .
306− ensureEscaped, ensureEscaped s) of
307− (Just u, s') -> -- try fetching from relative path at source
308− case parseURIReference' s' of
309− Just u' -> openURL $ show $ u' `nonStrictRelativeTo` u
310− Nothing -> openURL s' -- will throw error
311− (Nothing, s'@('/':'/':_)) -> -- protocol-relative URI
312− case parseURIReference' s' of
313− Just u' -> openURL $ show $ u' `nonStrictRelativeTo` httpcolon
314− Nothing -> openURL s' -- will throw error
315− (Nothing, s') ->
316− case parseURI s' of -- requires absolute URI
317− -- We don't want to treat C:/ as a scheme:
318− Just u' | length (uriScheme u') > 2 -> openURL (show u')
319− Just u' | uriScheme u' == "file:" ->
320− readLocalFile $ dropWhile (=='/') (uriPath u')
321− _ -> readLocalFile fp -- get from local file system
322− where readLocalFile f = do
323− cont <- readFileStrict f
324− return (cont, mime)
325− httpcolon = URI{ uriScheme = "http:",
326− uriAuthority = Nothing,
327− uriPath = "",
328− uriQuery = "",
329− uriFragment = "" }
330− dropFragmentAndQuery = takeWhile (\c -> c /= '?' && c /= '#')
331− fp = unEscapeString $ dropFragmentAndQuery s
332− mime = case takeExtension fp of
333− ".gz" -> getMimeType $ dropExtension fp
334− ".svgz" -> getMimeType $ dropExtension fp ++ ".svg"
335− x -> getMimeType x
336− ensureEscaped = escapeURIString isAllowedInURI . map convertSlash
337− convertSlash '\\' = '/'
338− convertSlash x = x
303+ Just (mime, bs) -> return $ (BL.toStrict bs, Just mime)
304+ Nothing -> downloadOrRead sourceURL s
305+
306+downloadOrRead :: PandocMonad m
307+ => Maybe String
308+ -> String
309+ -> m (B.ByteString, Maybe MimeType)
310+downloadOrRead sourceURL s = do
311+ case (sourceURL >>= parseURIReference' .
312+ ensureEscaped, ensureEscaped s) of
313+ (Just u, s') -> -- try fetching from relative path at source
314+ case parseURIReference' s' of
315+ Just u' -> openURL $ show $ u' `nonStrictRelativeTo` u
316+ Nothing -> openURL s' -- will throw error
317+ (Nothing, s'@('/':'/':_)) -> -- protocol-relative URI
318+ case parseURIReference' s' of
319+ Just u' -> openURL $ show $ u' `nonStrictRelativeTo` httpcolon
320+ Nothing -> openURL s' -- will throw error
321+ (Nothing, s') ->
322+ case parseURI s' of -- requires absolute URI
323+ -- We don't want to treat C:/ as a scheme:
324+ Just u' | length (uriScheme u') > 2 -> openURL (show u')
325+ Just u' | uriScheme u' == "file:" ->
326+ readLocalFile $ dropWhile (=='/') (uriPath u')
327+ _ -> readLocalFile fp -- get from local file system
328+ where readLocalFile f = do
329+ cont <- readFileStrict f
330+ return (cont, mime)
331+ httpcolon = URI{ uriScheme = "http:",
332+ uriAuthority = Nothing,
333+ uriPath = "",
334+ uriQuery = "",
335+ uriFragment = "" }
336+ dropFragmentAndQuery = takeWhile (\c -> c /= '?' && c /= '#')
337+ fp = unEscapeString $ dropFragmentAndQuery s
338+ mime = case takeExtension fp of
339+ ".gz" -> getMimeType $ dropExtension fp
340+ ".svgz" -> getMimeType $ dropExtension fp ++ ".svg"
341+ x -> getMimeType x
342+ ensureEscaped = escapeURIString isAllowedInURI . map convertSlash
343+ convertSlash '\\' = '/'
344+ convertSlash x = x
339345
340346data PureState = PureState { stStdGen :: StdGen
341347 , stWord8Store :: [Word8] -- should be