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

Add support for EPUB2 covers (fix #3992)

Browse source
This commit is contained in:
blmage 2019-06-16 09:25:48 +02:00
parent e67f4c58f2
commit efe318b3f6
1 changed files with 14 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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