@@ -1,6 +1,7 @@
11{-# LANGUAGE
22 ViewPatterns
33 , StandaloneDeriving
4+ , TupleSections
45 , FlexibleContexts #-}
56
67module Text.Pandoc.Readers.EPUB
@@ -9,32 +10,36 @@ module Text.Pandoc.Readers.EPUB
910
1011import Text.XML.Light
1112import Text.Pandoc.Definition hiding (Attr)
12−import Text.Pandoc.Walk (walk)
13+import Text.Pandoc.Walk (walk, query)
1314import Text.Pandoc.Generic(bottomUp)
1415import Text.Pandoc.Readers.HTML (readHtml)
15−import Text.Pandoc.Options (ReaderOptions(..), readerExtensions, Extension(..) )
16+import Text.Pandoc.Options ( ReaderOptions(..), readerExtensions, Extension(..)
17+ , readerTrace)
1618import Text.Pandoc.Shared (escapeURI)
19+import Text.Pandoc.MediaBag (MediaBag, insertMedia)
1720import Text.Pandoc.Compat.Except (MonadError, throwError, runExcept, Except)
1821import qualified Text.Pandoc.Builder as B
1922import Codec.Archive.Zip ( Archive (..), toArchive, fromEntry
2023 , findEntryByPath, Entry)
2124import qualified Data.ByteString.Lazy as BL (ByteString)
22−import System.FilePath (takeFileName, (</>), dropFileName)
25+import System.FilePath (takeFileName, (</>), dropFileName, normalise)
2326import qualified Text.Pandoc.UTF8 as UTF8 (toStringLazy)
2427import Control.Applicative ((<$>))
25−import Control.Monad (guard, liftM)
28+import Control.Monad (guard, liftM, when)
2629import Data.Monoid (mempty, (<>))
2730import Data.List (isPrefixOf, isInfixOf)
2831import Data.Maybe (mapMaybe, fromMaybe)
29−import qualified Data.Map as M (Map, lookup, fromList)
32+import qualified Data.Map as M (Map, lookup, fromList, elems)
3033import qualified Data.Set as S (insert)
3134import Control.DeepSeq.Generics (deepseq, NFData)
3235
36+import Debug.Trace (trace)
37+
3338type MIME = String
3439
3540type Items = M.Map String (FilePath, MIME)
3641
37−readEPUB :: ReaderOptions -> BL.ByteString -> Pandoc
42+readEPUB :: ReaderOptions -> BL.ByteString -> (Pandoc, MediaBag)
3843readEPUB opts bytes = runEPUB (archiveToEPUB opts $ toArchive bytes)
3944
4045runEPUB :: Except String a -> a
@@ -44,27 +49,28 @@ runEPUB = either error id . runExcept
4449-- are of the form "filename#id"
4550--
4651-- For now all paths are stripped from images
47−archiveToEPUB :: (MonadError String m) => ReaderOptions -> Archive -> m Pandoc
52+archiveToEPUB :: (MonadError String m) => ReaderOptions -> Archive -> m (Pandoc, MediaBag)
4853archiveToEPUB os archive = do
4954 (root, content) <- getManifest archive
5055 meta <- parseMeta content
5156 (cover, items) <- parseManifest content
52− let coverDoc = fromMaybe mempty (imageToPandoc . takeFileName<$> cover)
57+ let coverDoc = fromMaybe mempty (imageToPandoc . takeFileName <$> cover)
5358 spine <- parseSpine items content
5459 let escapedSpine = map (escapeURI . takeFileName . fst) spine
55− --traceShow escapedSpine (return ())
5660 Pandoc _ bs <-
5761 foldM' (\a b -> ((a <>) . bottomUp (prependHash escapedSpine))
5862 `liftM` parseSpineElem root b) mempty spine
59− return $ coverDoc <> (Pandoc meta bs)
63+ let ast = coverDoc <> (Pandoc meta bs)
64+ let mediaBag = fetchImages (M.elems items) root archive ast
65+ return $ (ast, mediaBag)
6066 where
6167 rs = readerExtensions os
6268 os' = os {readerExtensions = foldr S.insert rs [Ext_epub_html_exts, Ext_raw_html]}
6369 os'' = os' {readerParseRaw = True}
6470 parseSpineElem :: MonadError String m => FilePath -> (FilePath, MIME) -> m Pandoc
6571 parseSpineElem r (path, mime) = do
66− --traceShow path (return ())
67− doc <- mimeToReader mime (if r /= "./" then r </> path else path)
72+ when (readerTrace os) (traceM path)
73+ doc <- mimeToReader mime (normalise (r </> path))
6874 let docSpan = B.doc $ B.para $ B.spanWith (takeFileName path, [], []) mempty
6975 return $ docSpan <> fixInternalReferences (takeFileName path) doc
7076 mimeToReader :: MonadError String m => MIME -> FilePath -> m Pandoc
@@ -75,6 +81,23 @@ archiveToEPUB os archive = do
7581 | s `elem` imageMimes = return $ imageToPandoc path
7682 | otherwise = return $ mempty
7783
84+fetchImages :: [(FilePath, MIME)]
85+ -> FilePath
86+ -> Archive
87+ -> Pandoc
88+ -> MediaBag
89+fetchImages mimes root a (query iq -> links) =
90+ foldr (uncurry3 insertMedia) mempty
91+ (mapMaybe getEntry links)
92+ where
93+ getEntry l = let mediaPos = normalise (root </> l) in
94+ (l , lookup mediaPos mimes, ) . fromEntry
95+ <$> findEntryByPath mediaPos a
96+
97+iq :: Inline -> [FilePath]
98+iq (Image _ (url, _)) = [url]
99+iq _ = []
100+
78101
79102imageToPandoc :: FilePath -> Pandoc
80103imageToPandoc s = B.doc . B.para $ B.image s "" mempty
@@ -147,7 +170,7 @@ getManifest archive = do
147170
148171fixInternalReferences :: String -> Pandoc -> Pandoc
149172fixInternalReferences s =
150− (walk normalisePath) . (walk stripImage) . (walk $ fixBlockIRs s') . (walk $ fixInlineIRs s')
173+ (walk normalisePath) . (walk $ fixBlockIRs s') . (walk $ fixInlineIRs s')
151174 where
152175 s' = escapeURI s
153176
@@ -195,13 +218,7 @@ removeEPUBAttrs kvs = filter (not . isEPUBAttr) kvs
195218isEPUBAttr :: (String, String) -> Bool
196219isEPUBAttr (k, _) = "epub:" `isPrefixOf` k
197220
198−-- Remove relative paths
199−stripImage :: Inline -> Inline
200−stripImage (Image alt (url, tit)) = Image alt (takeFileName url, tit)
201−stripImage i = i
202−
203−
204−-- Utility
221+-- Library
205222
206223-- Strict version of foldM
207224foldM' :: (Monad m, NFData a) => (a -> b -> m a) -> a -> [b] -> m a
@@ -210,6 +227,14 @@ foldM' f z (x:xs) = do
210227 z' <- f z x
211228 z' `deepseq` foldM' f z' xs
212229
230+traceM :: Monad m => String -> m ()
231+traceM = flip trace (return ())
232+
233+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
234+uncurry3 f (a, b, c) = f a b c
235+
236+-- Utility
237+
213238stripNamespace :: QName -> String
214239stripNamespace (QName v _ _) = v
215240