git.iko.soy/typeable/pandoc
on master help sign in
Cleaned up EPUB writer.
commitda7931f35f03acaa9f10b5014dbe7fe1aa807b4f authorJohn MacFarlane <jgm@berkeley.edu> dateFri 9 Jul 2010, 10:58 (16 years ago) parentba819c1
1 file changed+43−33
src/Text/Pandoc/Writers/EPUB.hs+43−33
src/Text/Pandoc/Writers/EPUB.hs+43−33
@@ -51,57 +51,49 @@ writeEPUB :: Maybe String -- ^ EPUB stylesheet specified at command line
5151 -> WriterOptions -- ^ Writer options
5252 -> Pandoc -- ^ Document to convert
5353 -> IO B.ByteString
54−writeEPUB mbStylesheet opts doc = do
55− stylesheet <- case mbStylesheet of
56− Just s -> return s
57− Nothing -> readDataFile (writerUserDataDir opts) "epub.css"
54+writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do
5855 (TOD epochtime _) <- getClockTime
56+ let mkEntry path content = toEntry path epochtime content
5957 let opts' = opts{ writerEmailObfuscation = NoObfuscation
6058 , writerStandalone = True
6159 , writerWrapText = False }
6260 let sourceDir = writerSourceDirectory opts'
63− -- mimetype
64− let mimetypeEntry = toEntry "mimetype" epochtime $ fromString "application/epub+zip"
65− -- container.xml
66− let containerData = fromString $ ppTopElement $
67− unode "container" ! [("version","1.0")
68− ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
69− unode "rootfiles" $
70− unode "rootfile" ! [("full-path","content.opf")
71− ,("media-type","application/oebps-package+xml")] $ ()
72− let containerEntry = toEntry "META-INF/container.xml" epochtime containerData
73− -- stylesheet
74− let stylesheetEntry = toEntry "stylesheet.css" epochtime $
75− fromString stylesheet
61+
7662 -- title page
7763 let vars = writerVariables opts'
78− let tpContent = fromString $
79− writeHtmlString opts'{writerTemplate = pageTemplate
80− ,writerVariables = ("titlepage","yes"):vars} doc
81− let tpEntry = toEntry "title_page.xhtml" epochtime tpContent
64+ let tpContent = fromString $ writeHtmlString
65+ opts'{writerTemplate = pageTemplate
66+ ,writerVariables = ("titlepage","yes"):vars}
67+ (Pandoc meta [])
68+ let tpEntry = mkEntry "title_page.xhtml" tpContent
69+
8270 -- handle pictures
8371 picsRef <- newIORef []
84− Pandoc meta blocks <- liftM (processWith transformBlock) $
85− processWithM (transformInlines (writerHTMLMathMethod opts)
86− sourceDir picsRef) doc
72+ Pandoc _ blocks <- liftM (processWith transformBlock) $ processWithM
73+ (transformInlines (writerHTMLMathMethod opts) sourceDir picsRef) doc
8774 pics <- readIORef picsRef
8875 let readPicEntry (oldsrc, newsrc) = readEntry [] oldsrc >>= \e ->
8976 return e{ eRelativePath = newsrc }
9077 picEntries <- mapM readPicEntry pics
78+
9179 -- body pages
9280 let isH1 (Header 1 _) = True
9381 isH1 _ = False
94− let chunks = splitByIndices (dropWhile (==0) $ findIndices isH1 blocks) blocks
82+ let h1Indices = dropWhile (== 0) $ findIndices isH1 blocks
83+ let chunks = splitByIndices h1Indices blocks
9584 let titleize (Header 1 xs : ys) = Pandoc meta{docTitle = xs} ys
9685 titleize xs = Pandoc meta xs
9786 let chapToHtml = writeHtmlString opts'{ writerTemplate = pageTemplate
98− , writerHTMLMathMethod = PlainMath}
87+ , writerHTMLMathMethod = PlainMath }
9988 let chapters = map titleize chunks
10089 let chapterToEntry :: Int -> Pandoc -> Entry
101− chapterToEntry num chap = toEntry ("ch" ++ show num ++ ".xhtml")
102− epochtime $ fromString $ chapToHtml chap
90+ chapterToEntry num chap = mkEntry ("ch" ++ show num ++ ".xhtml") $
91+ fromString $ chapToHtml chap
10392 let chapterEntries = zipWith chapterToEntry [1..] chapters
93+
10494 -- contents.opf
95+ lang <- catch (liftM (takeWhile (/='.')) $ getEnv "lang")
96+ (\_ -> return "en-US")
10597 uuid <- getRandomUUID
10698 let chapterNode ent = unode "item" !
10799 [("id", takeBaseName $ eRelativePath ent),
@@ -115,12 +107,10 @@ writeEPUB mbStylesheet opts doc = do
115107 ("media-type", fromMaybe "application/octet-stream"
116108 $ imageTypeOf $ eRelativePath ent)] $ ()
117109 let plainify t = removeTrailingSpace $
118− writePlain opts'{ writerStandalone = False } $
110+ writePlain opts'{ writerStandalone = False } $
119111 Pandoc meta [Plain t]
120112 let plainTitle = plainify $ docTitle meta
121113 let plainAuthors = map plainify $ docAuthors meta
122− lang <- catch (liftM (takeWhile (/='.')) $ getEnv "lang")
123− (\_ -> return "en-US")
124114 let contentsData = fromString $ ppTopElement $
125115 unode "package" ! [("version","2.0")
126116 ,("xmlns","http://www.idpf.org/2007/opf")
@@ -138,7 +128,8 @@ writeEPUB mbStylesheet opts doc = do
138128 , unode "spine" ! [("toc","ncx")] $
139129 map chapterRefNode (tpEntry : chapterEntries)
140130 ]
141− let contentsEntry = toEntry "content.opf" epochtime contentsData
131+ let contentsEntry = mkEntry "content.opf" contentsData
132+
142133 -- toc.ncx
143134 let navPointNode ent n tit = unode "navPoint" !
144135 [("id", "navPoint-" ++ show n)
@@ -166,7 +157,26 @@ writeEPUB mbStylesheet opts doc = do
166157 ("Title Page" : map (\(Pandoc m _) ->
167158 plainify $ docTitle m) chapters)
168159 ]
169− let tocEntry = toEntry "toc.ncx" epochtime tocData
160+ let tocEntry = mkEntry "toc.ncx" tocData
161+
162+ -- mimetype
163+ let mimetypeEntry = mkEntry "mimetype" $ fromString "application/epub+zip"
164+
165+ -- container.xml
166+ let containerData = fromString $ ppTopElement $
167+ unode "container" ! [("version","1.0")
168+ ,("xmlns","urn:oasis:names:tc:opendocument:xmlns:container")] $
169+ unode "rootfiles" $
170+ unode "rootfile" ! [("full-path","content.opf")
171+ ,("media-type","application/oebps-package+xml")] $ ()
172+ let containerEntry = mkEntry "META-INF/container.xml" containerData
173+
174+ -- stylesheet
175+ stylesheet <- case mbStylesheet of
176+ Just s -> return s
177+ Nothing -> readDataFile (writerUserDataDir opts) "epub.css"
178+ let stylesheetEntry = mkEntry "stylesheet.css" $ fromString stylesheet
179+
170180 -- construct archive
171181 let archive = foldr addEntryToArchive emptyArchive
172182 (mimetypeEntry : containerEntry : stylesheetEntry : tpEntry :