From da7931f35f03acaa9f10b5014dbe7fe1aa807b4f Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 9 Jul 2010 10:58:24 -0700
Subject: [PATCH] Cleaned up EPUB writer.
---
src/Text/Pandoc/Writers/EPUB.hs | 76 +++++++++++++++++++--------------
1 file changed, 43 insertions(+), 33 deletions(-)
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index f8d9117f6..deaa2fe33 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -51,57 +51,49 @@ writeEPUB :: Maybe String -- ^ EPUB stylesheet specified at command line
-> WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert
-> IO B.ByteString
-writeEPUB mbStylesheet opts doc = do
- stylesheet <- case mbStylesheet of
- Just s -> return s
- Nothing -> readDataFile (writerUserDataDir opts) "epub.css"
+writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
(TOD epochtime _) <- getClockTime
+ let mkEntry path content = toEntry path epochtime content
let opts' = opts{ writerEmailObfuscation = NoObfuscation
, writerStandalone = True
, writerWrapText = False }
let sourceDir = writerSourceDirectory opts'
- -- mimetype
- let mimetypeEntry = toEntry "mimetype" epochtime $ fromString "application/epub+zip"
- -- container.xml
- let containerData = fromString $ ppTopElement $
- unode "container" ! [("version","1.0")
- ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
- unode "rootfiles" $
- unode "rootfile" ! [("full-path","content.opf")
- ,("media-type","application/oebps-package+xml")] $ ()
- let containerEntry = toEntry "META-INF/container.xml" epochtime containerData
- -- stylesheet
- let stylesheetEntry = toEntry "stylesheet.css" epochtime $
- fromString stylesheet
+
-- title page
let vars = writerVariables opts'
- let tpContent = fromString $
- writeHtmlString opts'{writerTemplate = pageTemplate
- ,writerVariables = ("titlepage","yes"):vars} doc
- let tpEntry = toEntry "title_page.xhtml" epochtime tpContent
+ let tpContent = fromString $ writeHtmlString
+ opts'{writerTemplate = pageTemplate
+ ,writerVariables = ("titlepage","yes"):vars}
+ (Pandoc meta [])
+ let tpEntry = mkEntry "title_page.xhtml" tpContent
+
-- handle pictures
picsRef <- newIORef []
- Pandoc meta blocks <- liftM (processWith transformBlock) $
- processWithM (transformInlines (writerHTMLMathMethod opts)
- sourceDir picsRef) doc
+ Pandoc _ blocks <- liftM (processWith transformBlock) $ processWithM
+ (transformInlines (writerHTMLMathMethod opts) sourceDir picsRef) doc
pics <- readIORef picsRef
let readPicEntry (oldsrc, newsrc) = readEntry [] oldsrc >>= \e ->
return e{ eRelativePath = newsrc }
picEntries <- mapM readPicEntry pics
+
-- body pages
let isH1 (Header 1 _) = True
isH1 _ = False
- let chunks = splitByIndices (dropWhile (==0) $ findIndices isH1 blocks) blocks
+ let h1Indices = dropWhile (== 0) $ findIndices isH1 blocks
+ let chunks = splitByIndices h1Indices blocks
let titleize (Header 1 xs : ys) = Pandoc meta{docTitle = xs} ys
titleize xs = Pandoc meta xs
let chapToHtml = writeHtmlString opts'{ writerTemplate = pageTemplate
- , writerHTMLMathMethod = PlainMath}
+ , writerHTMLMathMethod = PlainMath }
let chapters = map titleize chunks
let chapterToEntry :: Int -> Pandoc -> Entry
- chapterToEntry num chap = toEntry ("ch" ++ show num ++ ".xhtml")
- epochtime $ fromString $ chapToHtml chap
+ chapterToEntry num chap = mkEntry ("ch" ++ show num ++ ".xhtml") $
+ fromString $ chapToHtml chap
let chapterEntries = zipWith chapterToEntry [1..] chapters
+
-- contents.opf
+ lang <- catch (liftM (takeWhile (/='.')) $ getEnv "lang")
+ (\_ -> return "en-US")
uuid <- getRandomUUID
let chapterNode ent = unode "item" !
[("id", takeBaseName $ eRelativePath ent),
@@ -115,12 +107,10 @@ writeEPUB mbStylesheet opts doc = do
("media-type", fromMaybe "application/octet-stream"
$ imageTypeOf $ eRelativePath ent)] $ ()
let plainify t = removeTrailingSpace $
- writePlain opts'{ writerStandalone = False } $
+ writePlain opts'{ writerStandalone = False } $
Pandoc meta [Plain t]
let plainTitle = plainify $ docTitle meta
let plainAuthors = map plainify $ docAuthors meta
- lang <- catch (liftM (takeWhile (/='.')) $ getEnv "lang")
- (\_ -> return "en-US")
let contentsData = fromString $ ppTopElement $
unode "package" ! [("version","2.0")
,("xmlns","http://www.idpf.org/2007/opf")
@@ -138,7 +128,8 @@ writeEPUB mbStylesheet opts doc = do
, unode "spine" ! [("toc","ncx")] $
map chapterRefNode (tpEntry : chapterEntries)
]
- let contentsEntry = toEntry "content.opf" epochtime contentsData
+ let contentsEntry = mkEntry "content.opf" contentsData
+
-- toc.ncx
let navPointNode ent n tit = unode "navPoint" !
[("id", "navPoint-" ++ show n)
@@ -166,7 +157,26 @@ writeEPUB mbStylesheet opts doc = do
("Title Page" : map (\(Pandoc m _) ->
plainify $ docTitle m) chapters)
]
- let tocEntry = toEntry "toc.ncx" epochtime tocData
+ let tocEntry = mkEntry "toc.ncx" tocData
+
+ -- mimetype
+ let mimetypeEntry = mkEntry "mimetype" $ fromString "application/epub+zip"
+
+ -- container.xml
+ let containerData = fromString $ ppTopElement $
+ unode "container" ! [("version","1.0")
+ ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
+ unode "rootfiles" $
+ unode "rootfile" ! [("full-path","content.opf")
+ ,("media-type","application/oebps-package+xml")] $ ()
+ let containerEntry = mkEntry "META-INF/container.xml" containerData
+
+ -- stylesheet
+ stylesheet <- case mbStylesheet of
+ Just s -> return s
+ Nothing -> readDataFile (writerUserDataDir opts) "epub.css"
+ let stylesheetEntry = mkEntry "stylesheet.css" $ fromString stylesheet
+
-- construct archive
let archive = foldr addEntryToArchive emptyArchive
(mimetypeEntry : containerEntry : stylesheetEntry : tpEntry :