@@ -14,7 +14,7 @@ import Text.Pandoc.Walk (walk, query)
1414import Text.Pandoc.Generic(bottomUp)
1515import Text.Pandoc.Readers.HTML (readHtml)
1616import Text.Pandoc.Options ( ReaderOptions(..), readerTrace)
17−import Text.Pandoc.Shared (escapeURI)
17+import Text.Pandoc.Shared (escapeURI, collapseFilePath)
1818import Text.Pandoc.MediaBag (MediaBag, insertMedia)
1919import Text.Pandoc.Compat.Except (MonadError, throwError, runExcept, Except)
2020import qualified Text.Pandoc.Builder as B
@@ -22,7 +22,7 @@ import Codec.Archive.Zip ( Archive (..), toArchive, fromEntry
2222 , findEntryByPath, Entry)
2323import qualified Data.ByteString.Lazy as BL (ByteString)
2424import System.FilePath ( takeFileName, (</>), dropFileName, normalise
25− , joinPath, dropFileName, splitDirectories
25+ , dropFileName
2626 , splitFileName )
2727import qualified Text.Pandoc.UTF8 as UTF8 (toStringLazy)
2828import Control.Applicative ((<$>))
@@ -50,50 +50,52 @@ runEPUB = either error id . runExcept
5050--
5151archiveToEPUB :: (MonadError String m) => ReaderOptions -> Archive -> m (Pandoc, MediaBag)
5252archiveToEPUB os archive = do
53+ -- root is path to folder with manifest file in
5354 (root, content) <- getManifest archive
5455 meta <- parseMeta content
5556 (cover, items) <- parseManifest content
56− let coverDoc = fromMaybe mempty (imageToPandoc <$> cover)
57+ -- No need to collapse here as the image path is from the manifest file
58+ let coverDoc = fromMaybe mempty (imageToPandoc . (root </>) <$> cover)
5759 spine <- parseSpine items content
5860 let escapedSpine = map (escapeURI . takeFileName . fst) spine
5961 Pandoc _ bs <-
6062 foldM' (\a b -> ((a <>) . bottomUp (prependHash escapedSpine))
6163 `liftM` parseSpineElem root b) mempty spine
6264 let ast = coverDoc <> (Pandoc meta bs)
63− let mediaBag = fetchImages (M.elems items) root archive ast
65+ let mediaBag = fetchImages (M.elems items) archive ast
6466 return $ (ast, mediaBag)
6567 where
6668 os' = os {readerParseRaw = True}
6769 parseSpineElem :: MonadError String m => FilePath -> (FilePath, MIME) -> m Pandoc
6870 parseSpineElem (normalise -> r) (normalise -> path, mime) = do
6971 when (readerTrace os) (traceM path)
70− doc <- mimeToReader mime r path
72+ doc <- mimeToReader mime (r </> path)
7173 let docSpan = B.doc $ B.para $ B.spanWith (takeFileName path, [], []) mempty
7274 return $ docSpan <> doc
73− mimeToReader :: MonadError String m => MIME -> FilePath -> FilePath -> m Pandoc
74− mimeToReader "application/xhtml+xml" r path = do
75− fname <- findEntryByPathE (r </> path) archive
76− return $ fixInternalReferences (r </> path) .
75+ mimeToReader :: MonadError String m => MIME -> FilePath -> m Pandoc
76+ mimeToReader "application/xhtml+xml" (normalise -> path) = do
77+ fname <- findEntryByPathE path archive
78+ return $ fixInternalReferences path .
7779 readHtml os' .
7880 UTF8.toStringLazy $
7981 fromEntry fname
80− mimeToReader s _ path
82+ mimeToReader s path
8183 | s `elem` imageMimes = return $ imageToPandoc path
8284 | otherwise = return $ mempty
8385
86+-- paths should be absolute when this function is called
87+-- renameImages should do this
8488fetchImages :: [(FilePath, MIME)]
85− -> FilePath
8689 -> Archive
8790 -> Pandoc
8891 -> MediaBag
89−fetchImages mimes root arc (query iq -> links) =
92+fetchImages mimes arc (query iq -> links) =
9093 foldr (uncurry3 insertMedia) mempty
9194 (mapMaybe getEntry links)
9295 where
93− getEntry (normalise -> l) =
94− let mediaPos = normalise (root </> l) in
95− (l , lookup mediaPos mimes, ) . fromEntry
96− <$> findEntryByPath mediaPos arc
96+ getEntry link =
97+ (link , lookup link mimes, ) . fromEntry
98+ <$> findEntryByPath link arc
9799
98100iq :: Inline -> [FilePath]
99101iq (Image _ (url, _)) = [url]
@@ -101,20 +103,9 @@ iq _ = []
101103
102104-- Remove relative paths
103105renameImages :: FilePath -> Inline -> Inline
104−renameImages root (Image a (url, b)) = Image a (collapse (root </> url), b)
106+renameImages root (Image a (url, b)) = Image a (collapseFilePath (root </> url), b)
105107renameImages _ x = x
106108
107−collapse :: FilePath -> FilePath
108−collapse = joinPath . reverse . foldl go [] . splitDirectories
109− where
110− go rs "." = rs
111− go r@(p:rs) ".." = case p of
112− ".." -> ("..":r)
113− "/" -> ("..":r)
114− _ -> rs
115− go _ "/" = ["/"]
116− go rs x = x:rs
117−
118109imageToPandoc :: FilePath -> Pandoc
119110imageToPandoc s = B.doc . B.para $ B.image s "" mempty
120111