Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

EPUB: Fixed another mediabag related regression..

Browse source
This commit is contained in:
Matthew Pickering 2014-08-10 00:12:09 +01:00
parent d0fbe5b751
commit 4ae61bdf8f
1 changed files with 5 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/Text/Pandoc/Readers/EPUB.hs
View file

@ -62,7 +62,7 @@ archiveToEPUB os archive = do
foldM' (\a b -> ((a <>) . bottomUp (prependHash escapedSpine)) foldM' (\a b -> ((a <>) . bottomUp (prependHash escapedSpine))
`liftM` parseSpineElem root b) mempty spine `liftM` parseSpineElem root b) mempty spine
let ast = coverDoc <> (Pandoc meta bs) let ast = coverDoc <> (Pandoc meta bs)
let mediaBag = fetchImages (M.elems items) archive ast let mediaBag = fetchImages (M.elems items) root archive ast
return $ (ast, mediaBag) return $ (ast, mediaBag)
where where
os' = os {readerParseRaw = True} os' = os {readerParseRaw = True}
@ -86,16 +86,18 @@ archiveToEPUB os archive = do
-- paths should be absolute when this function is called -- paths should be absolute when this function is called
-- renameImages should do this -- renameImages should do this
fetchImages :: [(FilePath, MIME)] fetchImages :: [(FilePath, MIME)]
-> FilePath -- ^ Root
-> Archive -> Archive
-> Pandoc -> Pandoc
-> MediaBag -> MediaBag
fetchImages mimes arc (query iq -> links) = fetchImages mimes root arc (query iq -> links) =
foldr (uncurry3 insertMedia) mempty foldr (uncurry3 insertMedia) mempty
(mapMaybe getEntry links) (mapMaybe getEntry links)
where where
getEntry link = getEntry link =
let abslink = root </> link in
(link , lookup link mimes, ) . fromEntry (link , lookup link mimes, ) . fromEntry
<$> findEntryByPath link arc <$> findEntryByPath abslink arc
iq :: Inline -> [FilePath] iq :: Inline -> [FilePath]
iq (Image _ (url, _)) = [url] iq (Image _ (url, _)) = [url]