@@ -30,7 +30,7 @@ Conversion of 'Pandoc' documents to EPUB.
3030module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
3131import Data.IORef
3232import Data.Maybe ( fromMaybe, isNothing )
33−import Data.List ( findIndices, isPrefixOf )
33+import Data.List ( isPrefixOf, intercalate )
3434import System.Environment ( getEnv )
3535import Text.Printf (printf)
3636import System.FilePath ( (</>), (<.>), takeBaseName, takeExtension, takeFileName )
@@ -39,9 +39,11 @@ import Text.Pandoc.UTF8 ( fromStringLazy )
3939import Codec.Archive.Zip
4040import Data.Time.Clock.POSIX
4141import Text.Pandoc.Shared hiding ( Element )
42+import qualified Text.Pandoc.Shared as Shared
4243import Text.Pandoc.Options
4344import Text.Pandoc.Definition
4445import Text.Pandoc.Generic
46+import Text.Pandoc.Templates
4547import Control.Monad.State
4648import Text.XML.Light hiding (ppTopElement)
4749import Text.Pandoc.UUID
@@ -52,6 +54,7 @@ import Network.URI ( unEscapeString )
5254import Text.Pandoc.MIME (getMimeType)
5355import Prelude hiding (catch)
5456import Control.Exception (catch, SomeException)
57+import Text.HTML.TagSoup
5558
5659-- | Produce an EPUB file from a Pandoc document.
5760writeEPUB :: WriterOptions -- ^ Writer options
@@ -110,23 +113,26 @@ writeEPUB opts doc@(Pandoc meta _) = do
110113 fontEntries <- mapM mkFontEntry $ writerEpubFonts opts
111114
112115 -- body pages
113− let isH1 (Header 1 _) = True
114− isH1 _ = False
116+ -- add level 1 header to beginning if none there
117+ let blocks' = case blocks of
118+ (Header 1 _ : _) -> blocks
119+ _ -> Header 1 (docTitle meta) : blocks
115120 -- internal reference IDs change when we chunk the file,
116121 -- so the next two lines fix that:
117− let reftable = correlateRefs blocks
118− let blocks' = replaceRefs reftable blocks
119− let h1Indices = dropWhile (== 0) $ findIndices isH1 blocks'
120− let chunks = splitByIndices h1Indices blocks'
121− let titleize (Header 1 xs : ys) = Pandoc meta{docTitle = xs} ys
122− titleize xs = Pandoc meta xs
123− let chapters = map titleize chunks
124− let chapToHtml = writeHtmlString opts'{ writerTemplate = pageTemplate }
125− let chapterToEntry :: Int -> Pandoc -> Entry
126− chapterToEntry num chap = mkEntry
127− (showChapter num) $
128− fromStringLazy $ chapToHtml chap
129− let chapterEntries = zipWith chapterToEntry [1..] chapters
122+ let reftable = correlateRefs blocks'
123+ let blocks'' = replaceRefs reftable blocks'
124+ let tags = parseTags $ writeHtmlString opts'{writerStandalone = False}
125+ $ Pandoc (Meta [] [] []) blocks''
126+
127+ let chunks = partitions (~== TagOpen "h1" []) tags
128+
129+ let chapToEntry :: Int -> [Tag String] -> Entry
130+ chapToEntry num ts = mkEntry (showChapter num)
131+ $ fromStringLazy
132+ $ renderTemplate [("body",renderTags ts)]
133+ $ pageTemplate
134+
135+ let chapterEntries = zipWith chapToEntry [1..] chunks
130136
131137 -- contents.opf
132138 localeLang <- catch (liftM (map (\c -> if c == '_' then '-' else c) .
@@ -182,13 +188,37 @@ writeEPUB opts doc@(Pandoc meta _) = do
182188 let contentsEntry = mkEntry "content.opf" contentsData
183189
184190 -- toc.ncx
185− let navPointNode ent n tit = unode "navPoint" !
186− [("id", "navPoint-" ++ show n)
187− ,("playOrder", show n)] $
188− [ unode "navLabel" $ unode "text" tit
189− , unode "content" ! [("src",
190− eRelativePath ent)] $ ()
191− ]
191+ let secs = hierarchicalize blocks''
192+
193+ let navPointNode :: Shared.Element -> State Int Element
194+ navPointNode (Sec _ nums ident ils children) = do
195+ n <- get
196+ modify (+1)
197+ let showNums :: [Int] -> String
198+ showNums = intercalate "." . map show
199+ let tit' = plainify ils
200+ let tit = if writerNumberSections opts
201+ then showNums nums ++ " " ++ tit'
202+ else tit'
203+ let src = case lookup ident reftable of
204+ Just x -> x
205+ Nothing -> error (ident ++ " not found in reftable")
206+ let isSec (Sec lev _ _ _ _) = lev <= 3 -- only includes levels 1-3
207+ isSec _ = False
208+ let subsecs = filter isSec children
209+ subs <- mapM navPointNode subsecs
210+ return $ unode "navPoint" !
211+ [("id", "navPoint-" ++ show n)
212+ ,("playOrder", show n)] $
213+ [ unode "navLabel" $ unode "text" tit
214+ , unode "content" ! [("src", src)] $ ()
215+ ] ++ subs
216+ navPointNode (Blk _) = error "navPointNode encountered Blk"
217+
218+ let tpNode = unode "navPoint" ! [("id", "navPoint-0")] $
219+ [ unode "navLabel" $ unode "text" (plainify $ docTitle meta)
220+ , unode "content" ! [("src","title_page.xhtml")] $ () ]
221+
192222 let tocData = fromStringLazy $ ppTopElement $
193223 unode "ncx" ! [("version","2005-1")
194224 ,("xmlns","http://www.daisy.org/z3986/2005/ncx/")] $
@@ -206,10 +236,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
206236 Just _ -> [unode "meta" ! [("name","cover"),
207237 ("content","cover-image")] $ ()]
208238 , unode "docTitle" $ unode "text" $ plainTitle
209− , unode "navMap" $ zipWith3 navPointNode (tpEntry : chapterEntries)
210− [1..(length chapterEntries + 1)]
211− (plainTitle : map (\(Pandoc m _) ->
212− plainify $ docTitle m) chapters)
239+ , unode "navMap" $ tpNode : evalState (mapM navPointNode secs) 1
213240 ]
214241 let tocEntry = mkEntry "toc.ncx" tocData
215242