Merge pull request #5589 from blmage/fix-3992

Add support for EPUB2 covers (fix #3992)

1 files changed, 15 insertions, 8 deletions

diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs
index 4e125ea45..8e9746090 100644
--- a/src/Text/Pandoc/Readers/EPUB.hs
+++ b/src/Text/Pandoc/Readers/EPUB.hs
@@ -21,7 +21,7 @@ import Prelude
 import Codec.Archive.Zip (Archive (..), Entry, findEntryByPath, fromEntry,
                           toArchiveOrFail)
 import Control.DeepSeq (NFData, deepseq)
-import Control.Monad (guard, liftM)
+import Control.Monad (guard, liftM, liftM2, mplus)
 import Control.Monad.Except (throwError)
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import Data.List (isInfixOf, isPrefixOf)
@@ -62,8 +62,8 @@ archiveToEPUB :: (PandocMonad m) => ReaderOptions -> Archive -> m Pandoc
 archiveToEPUB os archive = do
   -- root is path to folder with manifest file in
   (root, content) <- getManifest archive
-  meta  <- parseMeta content
-  (cover, items) <- parseManifest content
+  (coverId, meta) <- parseMeta content
+  (cover, items)  <- parseManifest content coverId
   -- No need to collapse here as the image path is from the manifest file
   let coverDoc = fromMaybe mempty (imageToPandoc <$> cover)
   spine <- parseSpine items content
@@ -124,18 +124,22 @@ imageToPandoc s = B.doc . B.para $ B.image s "" mempty
 imageMimes :: [MimeType]
 imageMimes = ["image/gif", "image/jpeg", "image/png"]
 
+type CoverId = String
+
 type CoverImage = FilePath
 
-parseManifest :: (PandocMonad m) => Element -> m (Maybe CoverImage, Items)
-parseManifest content = do
+parseManifest :: (PandocMonad m) => Element -> Maybe CoverId -> m (Maybe CoverImage, Items)
+parseManifest content coverId = do
   manifest <- findElementE (dfName "manifest") content
   let items = findChildren (dfName "item") manifest
   r <- mapM parseItem items
   let cover = findAttr (emptyName "href") =<< filterChild findCover manifest
-  return (cover, M.fromList r)
+  return (cover `mplus` coverId, M.fromList r)
   where
     findCover e = maybe False (isInfixOf "cover-image")
                   (findAttr (emptyName "properties") e)
+               || fromMaybe False
+                  (liftM2 (==) coverId (findAttr (emptyName "id") e))
     parseItem e = do
       uid <- findAttrE (emptyName "id") e
       href <- findAttrE (emptyName "href") e
@@ -153,14 +157,17 @@ parseSpine is e = do
       guard linear
       findAttr (emptyName "idref") ref
 
-parseMeta :: PandocMonad m => Element -> m Meta
+parseMeta :: PandocMonad m => Element -> m (Maybe CoverId, Meta)
 parseMeta content = do
   meta <- findElementE (dfName "metadata") content
   let dcspace (QName _ (Just "http://purl.org/dc/elements/1.1/") (Just "dc")) = True
       dcspace _ = False
   let dcs = filterChildrenName dcspace meta
   let r = foldr parseMetaItem nullMeta dcs
-  return r
+  let coverId = findAttr (emptyName "content") =<< filterChild findCover meta
+  return (coverId, r)
+  where
+    findCover e = maybe False (== "cover") (findAttr (emptyName "name") e)
 
 -- http://www.idpf.org/epub/30/spec/epub30-publications.html#sec-metadata-elem
 parseMetaItem :: Element -> Meta -> Meta