@@ -48,7 +48,7 @@ import qualified Data.Set as Set
4848import qualified Data.Text as TS
4949import qualified Data.Text.Lazy as TL
5050import Network.HTTP (urlEncode)
51−import System.FilePath (takeExtension, takeFileName)
51+import System.FilePath (takeExtension, takeFileName, makeRelative)
5252import Text.HTML.TagSoup (Tag (TagOpen), fromAttrib, parseTags)
5353import Text.Pandoc.Builder (fromList, setMeta)
5454import Text.Pandoc.Class (PandocMonad, report)
@@ -81,6 +81,7 @@ data Chapter = Chapter (Maybe [Int]) [Block]
8181
8282data EPUBState = EPUBState {
8383 stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
84+ , stEpubSubdir :: String
8485 }
8586
8687type E m = StateT EPUBState m
@@ -149,6 +150,20 @@ removeNote :: Inline -> Inline
149150removeNote (Note _) = Str ""
150151removeNote x = x
151152
153+mkEntry :: PandocMonad m => FilePath -> B.ByteString -> E m Entry
154+mkEntry path content = do
155+ epubSubdir <- gets stEpubSubdir
156+ let addEpubSubdir :: Entry -> Entry
157+ addEpubSubdir e = e{ eRelativePath =
158+ (if null epubSubdir
159+ then ""
160+ else epubSubdir ++ "/") ++ eRelativePath e }
161+ epochtime <- floor <$> lift P.getPOSIXTime
162+ return $
163+ (if path == "mimetype" || "META-INF" `isPrefixOf` path
164+ then id
165+ else addEpubSubdir) $ toEntry path epochtime content
166+
152167getEPUBMetadata :: PandocMonad m => WriterOptions -> Meta -> E m EPUBMetadata
153168getEPUBMetadata opts meta = do
154169 let md = metadataFromMeta opts meta
@@ -366,11 +381,13 @@ writeEPUB :: PandocMonad m
366381 -> WriterOptions -- ^ Writer options
367382 -> Pandoc -- ^ Document to convert
368383 -> m B.ByteString
369−writeEPUB epubVersion opts doc =
370− let initState = EPUBState { stMediaPaths = [] }
371− in
372− evalStateT (pandocToEPUB epubVersion opts doc)
373− initState
384+writeEPUB epubVersion opts doc = do
385+ let epubSubdir = writerEpubSubdirectory opts
386+ -- sanity check on epubSubdir
387+ unless (all (\c -> isAscii c && isAlphaNum c) epubSubdir) $
388+ throwError $ PandocEpubSubdirectoryError epubSubdir
389+ let initState = EPUBState { stMediaPaths = [], stEpubSubdir = epubSubdir }
390+ evalStateT (pandocToEPUB epubVersion opts doc) initState
374391
375392pandocToEPUB :: PandocMonad m
376393 => EPUBVersion
@@ -378,27 +395,18 @@ pandocToEPUB :: PandocMonad m
378395 -> Pandoc
379396 -> E m B.ByteString
380397pandocToEPUB version opts doc@(Pandoc meta _) = do
381− let epubSubdir = writerEpubSubdirectory opts
382− -- sanity check on epubSubdir
383− unless (all (\c -> isAscii c && isAlphaNum c) epubSubdir) $
384− throwError $ PandocEpubSubdirectoryError epubSubdir
385− let inSubdir f = if null epubSubdir
386− then f
387− else epubSubdir ++ "/" ++ f
388−
398+ epubSubdir <- gets stEpubSubdir
389399 let epub3 = version == EPUB3
390400 let writeHtml o = fmap (UTF8.fromTextLazy . TL.fromStrict) .
391401 writeHtmlStringForEPUB version o
392− epochtime <- floor <$> lift P.getPOSIXTime
393402 metadata <- getEPUBMetadata opts meta
394− let mkEntry path content = toEntry path epochtime content
395403
396404 -- stylesheet
397405 stylesheets <- case epubStylesheets metadata of
398406 [] -> (\x -> [B.fromChunks [x]]) <$>
399407 P.readDataFile "epub.css"
400408 fs -> mapM P.readFileLazy fs
401− let stylesheetEntries = zipWith
409+ stylesheetEntries <- zipWithM
402410 (\bs n -> mkEntry ("styles/stylesheet" ++ show n ++ ".css") bs)
403411 stylesheets [(1 :: Int)..]
404412
@@ -406,10 +414,10 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
406414 : [(x,y) | (x,y) <- writerVariables opts, x /= "css"]
407415
408416 let cssvars useprefix = map (\e -> ("css",
409− (if useprefix && not (null epubSubdir)
417+ (if useprefix
410418 then "../"
411419 else "")
412− ++ eRelativePath e))
420+ ++ makeRelative epubSubdir (eRelativePath e)))
413421 stylesheetEntries
414422
415423 let opts' = opts{ writerEmailObfuscation = NoObfuscation
@@ -430,18 +438,21 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
430438 cpContent <- lift $ writeHtml
431439 opts'{ writerVariables =
432440 ("coverpage","true"):
433− cssvars False ++ vars }
434− (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
441+ cssvars True ++ vars }
442+ (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"../media/" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
435443 imgContent <- lift $ P.readFileLazy img
436− return ( [mkEntry "cover.xhtml" cpContent]
437− , [mkEntry coverImage imgContent] )
444+ coverEntry <- mkEntry "text/cover.xhtml" cpContent
445+ coverImageEntry <- mkEntry ("media/" ++ coverImage)
446+ imgContent
447+ return ( [ coverEntry ]
448+ , [ coverImageEntry ] )
438449
439450 -- title page
440451 tpContent <- lift $ writeHtml opts'{
441452 writerVariables = ("titlepage","true"):
442453 cssvars True ++ vars }
443454 (Pandoc meta [])
444− let tpEntry = mkEntry (inSubdir "title_page.xhtml") tpContent
455+ tpEntry <- mkEntry "text/title_page.xhtml" tpContent
445456
446457 -- handle pictures
447458 -- mediaRef <- P.newIORef []
@@ -454,7 +465,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
454465 when (null xs) $
455466 report $ CouldNotFetchResource f "glob did not match any font files"
456467 return xs
457− let mkFontEntry f = mkEntry ("fonts/" ++ takeFileName f) <$>
468+ let mkFontEntry f = mkEntry ("fonts/" ++ takeFileName f) =<<
458469 lift (P.readFileLazy f)
459470 fontFiles <- concat <$> mapM matchingGlob (writerEpubFonts opts')
460471 fontEntries <- mapM mkFontEntry fontFiles
@@ -540,7 +551,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
540551 chapters'
541552
542553 let chapToEntry num (Chapter mbnum bs) =
543− mkEntry (inSubdir (showChapter num)) <$>
554+ mkEntry ("text/" ++ showChapter num) =<<
544555 writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum
545556 , writerVariables = cssvars True ++ vars }
546557 (case bs of
@@ -550,7 +561,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
550561 nullMeta) bs
551562 _ -> Pandoc nullMeta bs)
552563
553− chapterEntries <- lift $ zipWithM chapToEntry [1..] chapters
564+ chapterEntries <- zipWithM chapToEntry [1..] chapters
554565
555566 -- incredibly inefficient (TODO):
556567 let containsMathML ent = epub3 &&
@@ -563,24 +574,34 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
563574
564575 -- contents.opf
565576 let chapterNode ent = unode "item" !
566− ([("id", toId $ eRelativePath ent),
567− ("href", eRelativePath ent),
577+ ([("id", toId $ makeRelative epubSubdir
578+ $ eRelativePath ent),
579+ ("href", makeRelative epubSubdir
580+ $ eRelativePath ent),
568581 ("media-type", "application/xhtml+xml")]
569582 ++ case props ent of
570583 [] -> []
571584 xs -> [("properties", unwords xs)])
572585 $ ()
586+
573587 let chapterRefNode ent = unode "itemref" !
574− [("idref", toId $ eRelativePath ent)] $ ()
588+ [("idref", toId $ makeRelative epubSubdir
589+ $ eRelativePath ent)] $ ()
575590 let pictureNode ent = unode "item" !
576− [("id", toId $ eRelativePath ent),
577− ("href", eRelativePath ent),
578− ("media-type", fromMaybe "application/octet-stream"
591+ [("id", toId $ makeRelative epubSubdir
592+ $ eRelativePath ent),
593+ ("href", makeRelative epubSubdir
594+ $ eRelativePath ent),
595+ ("media-type",
596+ fromMaybe "application/octet-stream"
579597 $ mediaTypeOf $ eRelativePath ent)] $ ()
580598 let fontNode ent = unode "item" !
581− [("id", toId $ eRelativePath ent),
582− ("href", eRelativePath ent),
583− ("media-type", fromMaybe "" $ getMimeType $ eRelativePath ent)] $ ()
599+ [("id", toId $ makeRelative epubSubdir
600+ $ eRelativePath ent),
601+ ("href", makeRelative epubSubdir
602+ $ eRelativePath ent),
603+ ("media-type", fromMaybe "" $
604+ getMimeType $ eRelativePath ent)] $ ()
584605 let plainTitle = case docTitle' meta of
585606 [] -> case epubTitle metadata of
586607 [] -> "UNTITLED"
@@ -613,7 +634,9 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
613634 ] ++
614635 [ unode "item" ! [("id","style"), ("href",fp)
615636 ,("media-type","text/css")] $ () |
616− fp <- map eRelativePath stylesheetEntries ] ++
637+ fp <- map
638+ (makeRelative epubSubdir . eRelativePath)
639+ stylesheetEntries ] ++
617640 map chapterNode (cpgEntry ++ (tpEntry : chapterEntries)) ++
618641 (case cpicEntry of
619642 [] -> []
@@ -648,7 +671,7 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
648671 | isJust (epubCoverImage metadata)
649672 ]
650673 ]
651− let contentsEntry = mkEntry "content.opf" contentsData
674+ contentsEntry <- mkEntry "content.opf" contentsData
652675
653676 -- toc.ncx
654677 let secs = hierarchicalize blocks'
@@ -681,12 +704,12 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
681704 navMapFormatter n tit src subs = unode "navPoint" !
682705 [("id", "navPoint-" ++ show n)] $
683706 [ unode "navLabel" $ unode "text" $ stringify tit
684− , unode "content" ! [("src", inSubdir src)] $ ()
707+ , unode "content" ! [("src", "text/" ++ src)] $ ()
685708 ] ++ subs
686709
687710 let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $
688711 [ unode "navLabel" $ unode "text" (stringify $ docTitle' meta)
689− , unode "content" ! [("src", inSubdir "title_page.xhtml")]
712+ , unode "content" ! [("src", "text/title_page.xhtml")]
690713 $ () ]
691714
692715 navMap <- lift $ evalStateT (mapM (navPointNode navMapFormatter) secs) 1
@@ -710,13 +733,13 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
710733 , unode "navMap" $
711734 tpNode : navMap
712735 ]
713− let tocEntry = mkEntry "toc.ncx" tocData
736+ tocEntry <- mkEntry "toc.ncx" tocData
714737
715738 let navXhtmlFormatter :: Int -> [Inline] -> String -> [Element] -> Element
716739 navXhtmlFormatter n tit src subs = unode "li" !
717740 [("id", "toc-li-" ++ show n)] $
718741 (unode "a" !
719− [("href", inSubdir src)]
742+ [("href", "text/" ++ src)]
720743 $ titElements)
721744 : case subs of
722745 [] -> []
@@ -766,36 +789,37 @@ pandocToEPUB version opts doc@(Pandoc meta _) = do
766789 (Pandoc (setMeta "title"
767790 (walk removeNote $ fromList $ docTitle' meta) nullMeta)
768791 (navBlocks ++ landmarks))
769− let navEntry = mkEntry "nav.xhtml" navData
792+ navEntry <- mkEntry "nav.xhtml" navData
770793
771794 -- mimetype
772− let mimetypeEntry = mkEntry "mimetype" $ UTF8.fromStringLazy "application/epub+zip"
795+ mimetypeEntry <- mkEntry "mimetype" $
796+ UTF8.fromStringLazy "application/epub+zip"
773797
774798 -- container.xml
775799 let containerData = UTF8.fromStringLazy $ ppTopElement $
776800 unode "container" ! [("version","1.0")
777801 ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
778802 unode "rootfiles" $
779− unode "rootfile" ! [("full-path", inSubdir "content.opf")
803+ unode "rootfile" ! [("full-path",
804+ (if null epubSubdir
805+ then ""
806+ else epubSubdir ++ "/") ++ "content.opf")
780807 ,("media-type","application/oebps-package+xml")] $ ()
781− let containerEntry = mkEntry "META-INF/container.xml" containerData
808+ containerEntry <- mkEntry "META-INF/container.xml" containerData
782809
783810 -- com.apple.ibooks.display-options.xml
784811 let apple = UTF8.fromStringLazy $ ppTopElement $
785812 unode "display_options" $
786813 unode "platform" ! [("name","*")] $
787814 unode "option" ! [("name","specified-fonts")] $ "true"
788− let appleEntry = mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
815+ appleEntry <- mkEntry "META-INF/com.apple.ibooks.display-options.xml" apple
789816
790− let addEpubSubdir :: Entry -> Entry
791− addEpubSubdir e = e{ eRelativePath = inSubdir (eRelativePath e) }
792817 -- construct archive
793818 let archive = foldr addEntryToArchive emptyArchive $
794− [mimetypeEntry, containerEntry, appleEntry] ++
795− map addEpubSubdir
796− (tpEntry : contentsEntry : tocEntry : navEntry :
797− (stylesheetEntries ++ picEntries ++ cpicEntry ++
798− cpgEntry ++ chapterEntries ++ fontEntries))
819+ [mimetypeEntry, containerEntry, appleEntry,
820+ contentsEntry, tocEntry, navEntry, tpEntry] ++
821+ stylesheetEntries ++ picEntries ++ cpicEntry ++
822+ cpgEntry ++ chapterEntries ++ fontEntries
799823 return $ fromArchive archive
800824
801825metadataElement :: EPUBVersion -> EPUBMetadata -> UTCTime -> Element
@@ -936,8 +960,7 @@ modifyMediaRef oldsrc = do
936960 let new = "media/file" ++ show (length media) ++
937961 fromMaybe (takeExtension (takeWhile (/='?') oldsrc))
938962 (('.':) <$> (mbMime >>= extensionFromMimeType))
939− epochtime <- floor `fmap` lift P.getPOSIXTime
940− let entry = toEntry new epochtime (B.fromChunks . (:[]) $ img)
963+ entry <- mkEntry new (B.fromChunks . (:[]) $ img)
941964 modify $ \st -> st{ stMediaPaths =
942965 (oldsrc, (new, Just entry)):media}
943966 return new)
@@ -959,21 +982,15 @@ transformInline :: PandocMonad m
959982 => WriterOptions
960983 -> Inline
961984 -> E m Inline
962−transformInline opts (Image attr lab (src,tit)) = do
985+transformInline _opts (Image attr lab (src,tit)) = do
963986 newsrc <- modifyMediaRef src
964− let pref = if null (writerEpubSubdirectory opts)
965− then ""
966− else "../"
967− return $ Image attr lab (pref ++ newsrc, tit)
987+ return $ Image attr lab ("../" ++ newsrc, tit)
968988transformInline opts (x@(Math t m))
969989 | WebTeX url <- writerHTMLMathMethod opts = do
970990 newsrc <- modifyMediaRef (url ++ urlEncode m)
971991 let mathclass = if t == DisplayMath then "display" else "inline"
972− let pref = if null (writerEpubSubdirectory opts)
973− then ""
974− else "../"
975992 return $ Span ("",["math",mathclass],[])
976− [Image nullAttr [x] (pref ++ newsrc, "")]
993+ [Image nullAttr [x] ("../" ++ newsrc, "")]
977994transformInline _opts (RawInline fmt raw)
978995 | fmt == Format "html" = do
979996 let tags = parseTags raw