Bug fixes to EPUB chapter splitting.

This commit is contained in:
John MacFarlane 2019-09-20 17:20:36 -07:00
parent a69d52c031
commit 6d4b35dfaf

View file

@ -61,6 +61,7 @@ import Text.Pandoc.XML (escapeStringForXML)
-- A Chapter includes a list of blocks. -- A Chapter includes a list of blocks.
data Chapter = Chapter [Block] data Chapter = Chapter [Block]
deriving (Show)
data EPUBState = EPUBState { data EPUBState = EPUBState {
stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))] stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
@ -501,13 +502,6 @@ pandocToEPUB version opts doc = do
-- body pages -- body pages
-- add level 1 header to beginning if none there
let blocks' = addIdentifiers opts
$ case blocks of
(Header 1 _ _ : _) -> blocks
_ -> Header 1 ("",["unnumbered"],[])
(docTitle' meta) : blocks
let chapterHeaderLevel = writerEpubChapterLevel opts let chapterHeaderLevel = writerEpubChapterLevel opts
let isChapterHeader (Div _ (Header n _ _:_)) = n <= chapterHeaderLevel let isChapterHeader (Div _ (Header n _ _:_)) = n <= chapterHeaderLevel
@ -515,8 +509,7 @@ pandocToEPUB version opts doc = do
let secsToChapters :: [Block] -> [Chapter] let secsToChapters :: [Block] -> [Chapter]
secsToChapters [] = [] secsToChapters [] = []
secsToChapters (d@(Div attr@(_,"section":_,_) secsToChapters (d@(Div attr (h@(Header lvl _ _) : bs)) : rest)
(h@(Header lvl _ _) : bs)) : rest)
| chapterHeaderLevel == lvl = | chapterHeaderLevel == lvl =
Chapter [d] : secsToChapters rest Chapter [d] : secsToChapters rest
| chapterHeaderLevel > lvl = | chapterHeaderLevel > lvl =
@ -524,10 +517,20 @@ pandocToEPUB version opts doc = do
secsToChapters ys ++ secsToChapters rest secsToChapters ys ++ secsToChapters rest
where (xs, ys) = break isChapterHeader bs where (xs, ys) = break isChapterHeader bs
secsToChapters bs = secsToChapters bs =
Chapter xs : secsToChapters ys (if null xs then id else (Chapter xs :)) $ secsToChapters ys
where (xs, ys) = break isChapterHeader bs where (xs, ys) = break isChapterHeader bs
let chapters' = secsToChapters $ makeSections True Nothing blocks' -- add level 1 header to beginning if none there
let secs = makeSections True Nothing
$ addIdentifiers opts
$ case blocks of
(Div _
(Header{}:_) : _) -> blocks
(Header 1 _ _ : _) -> blocks
_ -> Header 1 ("",["unnumbered"],[])
(docTitle' meta) : blocks
let chapters' = secsToChapters secs
let extractLinkURL' :: Int -> Inline -> [(String, String)] let extractLinkURL' :: Int -> Inline -> [(String, String)]
extractLinkURL' num (Span (ident, _, _) _) extractLinkURL' num (Span (ident, _, _) _)
@ -696,14 +699,12 @@ pandocToEPUB version opts doc = do
contentsEntry <- mkEntry "content.opf" contentsData contentsEntry <- mkEntry "content.opf" contentsData
-- toc.ncx -- toc.ncx
let secs = makeSections True (Just 1) blocks'
let tocLevel = writerTOCDepth opts let tocLevel = writerTOCDepth opts
let navPointNode :: PandocMonad m let navPointNode :: PandocMonad m
=> (Int -> [Inline] -> String -> [Element] -> Element) => (Int -> [Inline] -> String -> [Element] -> Element)
-> Block -> StateT Int m [Element] -> Block -> StateT Int m [Element]
navPointNode formatter (Div (ident,"section":_,_) navPointNode formatter (Div (ident,_,_)
(Header lvl (_,_,kvs) ils : children)) = do (Header lvl (_,_,kvs) ils : children)) = do
if lvl > tocLevel if lvl > tocLevel
then return [] then return []