diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Readers/EPUB.hs | 23 |
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 |