@@ -159,29 +159,65 @@ pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAny)
159159
160160block :: PandocMonad m => TagParser m Blocks
161161block = do
162− res <- choice
163− [ eSection
164− , eSwitch B.para block
165− , mempty <$ eFootnote
166− , mempty <$ eTOC
167− , mempty <$ eTitlePage
168− , pPara
169− , pHeader
170− , pBlockQuote
171− , pCodeBlock
172− , pList
173− , pHrule
174− , pTable block
175− , pHtml
176− , pHead
177− , pBody
178− , pLineBlock
179− , pDiv
180− , pPlain
181− , pFigure
182− , pIframe
183− , pRawHtmlBlock
184− ]
162+ exts <- getOption readerExtensions
163+ tag <- lookAhead pAny
164+ res <-
165+ (case tag of
166+ TagOpen name attr ->
167+ let type' = fromMaybe "" $
168+ lookup "type" attr <|> lookup "epub:type" attr
169+ epubExts = extensionEnabled Ext_epub_html_exts exts
170+ in
171+ case name of
172+ _ | name `elem` sectioningContent
173+ , epubExts
174+ , "chapter" `T.isInfixOf` type'
175+ -> eSection
176+ _ | epubExts
177+ , type' `elem` ["footnote", "rearnote"]
178+ -> mempty <$ eFootnote
179+ _ | epubExts
180+ , type' == "toc"
181+ -> mempty <$ eTOC
182+ _ | "titlepage" `T.isInfixOf` type'
183+ , name `elem` ("section" : groupingContent)
184+ -> mempty <$ eTitlePage
185+ "p" -> pPara
186+ "h1" -> pHeader
187+ "h2" -> pHeader
188+ "h3" -> pHeader
189+ "h4" -> pHeader
190+ "h5" -> pHeader
191+ "h6" -> pHeader
192+ "blockquote" -> pBlockQuote
193+ "pre" -> pCodeBlock
194+ "ul" -> pBulletList
195+ "ol" -> pOrderedList
196+ "dl" -> pDefinitionList
197+ "table" -> pTable block
198+ "hr" -> pHrule
199+ "html" -> pHtml
200+ "head" -> pHead
201+ "body" -> pBody
202+ "div"
203+ | extensionEnabled Ext_line_blocks exts
204+ , Just "line-block" <- lookup "class" attr
205+ -> pLineBlock
206+ | otherwise
207+ -> pDiv
208+ "section" -> pDiv
209+ "main" -> pDiv
210+ "figure" -> pFigure
211+ "iframe" -> pIframe
212+ "style" -> pRawHtmlBlock
213+ "textarea" -> pRawHtmlBlock
214+ "switch"
215+ | epubExts
216+ -> eSwitch B.para block
217+ _ -> mzero
218+ _ -> mzero)
219+ <|> pPlain
220+ <|> pRawHtmlBlock
185221 trace (T.take 60 $ tshow $ B.toList res)
186222 return res
187223
@@ -256,9 +292,6 @@ eTOC = try $ do
256292 guard $ (lookup "type" attr <|> lookup "epub:type" attr) == Just "toc"
257293 void (pInTags tag block)
258294
259−pList :: PandocMonad m => TagParser m Blocks
260−pList = pBulletList <|> pOrderedList <|> pDefinitionList
261−
262295pBulletList :: PandocMonad m => TagParser m Blocks
263296pBulletList = try $ do
264297 pSatisfy (matchTagOpen "ul" [])
@@ -369,13 +402,15 @@ pLineBlock = try $ do
369402 B.toList ils
370403 return $ B.lineBlock lns
371404
405+isDivLike :: Text -> Bool
406+isDivLike "div" = True
407+isDivLike "section" = True
408+isDivLike "main" = True
409+isDivLike _ = False
410+
372411pDiv :: PandocMonad m => TagParser m Blocks
373412pDiv = try $ do
374413 guardEnabled Ext_native_divs
375− let isDivLike "div" = True
376− isDivLike "section" = True
377− isDivLike "main" = True
378− isDivLike _ = False
379414 TagOpen tag attr' <- lookAhead $ pSatisfy $ tagOpen isDivLike (const True)
380415 let (ident, classes, kvs) = toAttr attr'
381416 contents <- pInTags tag block
@@ -544,31 +579,47 @@ tagToText (TagOpen "br" _) = "\n"
544579tagToText _ = ""
545580
546581inline :: PandocMonad m => TagParser m Inlines
547−inline = choice
548− [ eNoteref
549− , eSwitch id inline
550− , pTagText
551− , pQ
552− , pEmph
553− , pStrong
554− , pSuperscript
555− , pSubscript
556− , pSpanLike
557− , pSmall
558− , pStrikeout
559− , pUnderline
560− , pLineBreak
561− , pLink
562− , pImage
563− , pSvg
564− , pBdo
565− , pCode
566− , pCodeWithClass [("samp","sample"),("var","variable")]
567− , pSpan
568− , pMath False
569− , pScriptMath
570− , pRawHtmlInline
571− ]
582+inline = do
583+ exts <- getOption readerExtensions
584+ tag <- lookAhead pAny
585+ case tag of
586+ TagOpen name attr ->
587+ case name of
588+ "a" | extensionEnabled Ext_epub_html_exts exts
589+ , Just "noteref" <- lookup "type" attr <|> lookup "epub:type" attr
590+ , Just ('#',_) <- lookup "href" attr >>= T.uncons
591+ -> eNoteref
592+ | otherwise -> pLink
593+ "switch" -> eSwitch id inline
594+ "q" -> pQ
595+ "em" -> pEmph
596+ "i" -> pEmph
597+ "strong" -> pStrong
598+ "b" -> pStrong
599+ "sup" -> pSuperscript
600+ "sub" -> pSubscript
601+ "small" -> pSmall
602+ "s" -> pStrikeout
603+ "strike" -> pStrikeout
604+ "del" -> pStrikeout
605+ "u" -> pUnderline
606+ "ins" -> pUnderline
607+ "br" -> pLineBreak
608+ "img" -> pImage
609+ "svg" -> pSvg
610+ "bdo" -> pBdo
611+ "code" -> pCode
612+ "samp" -> pCodeWithClass "samp" "sample"
613+ "var" -> pCodeWithClass "var" "variable"
614+ "span" -> pSpan
615+ "math" -> pMath False
616+ "script"
617+ | Just x <- lookup "type" attr
618+ , "math/tex" `T.isPrefixOf` x -> pScriptMath
619+ _ | name `elem` htmlSpanLikeElements -> pSpanLike
620+ _ -> pRawHtmlInline
621+ TagText _ -> pTagText
622+ _ -> pRawHtmlInline
572623
573624pSelfClosing :: PandocMonad m
574625 => (Text -> Bool) -> ([Attribute Text] -> Bool)
@@ -579,27 +630,25 @@ pSelfClosing f g = do
579630 return open
580631
581632pQ :: PandocMonad m => TagParser m Inlines
582−pQ = choice $ map try [citedQuote, normalQuote]
583− where citedQuote = do
584− tag <- pSatisfy $ tagOpenLit "q" (any ((=="cite") . fst))
585−
586− url <- canonicalizeUrl $ fromAttrib "cite" tag
587− let uid = fromMaybe (fromAttrib "name" tag) $
588− maybeFromAttrib "id" tag
589− let cls = T.words $ fromAttrib "class" tag
590−
591− makeQuote $ B.spanWith (uid, cls, [("cite", escapeURI url)])
592− normalQuote = do
593− pSatisfy $ tagOpenLit "q" (const True)
594− makeQuote id
595− makeQuote wrapper = do
596− ctx <- asks quoteContext
597− let (constructor, innerContext) = case ctx of
598− InDoubleQuote -> (B.singleQuoted, InSingleQuote)
599− _ -> (B.doubleQuoted, InDoubleQuote)
600−
601− content <- withQuoteContext innerContext (mconcat <$> manyTill inline (pCloses "q"))
602− return $ extractSpaces (constructor . wrapper) content
633+pQ = do
634+ TagOpen _ attrs <- pSatisfy $ tagOpenLit "q" (const True)
635+ case lookup "cite" attrs of
636+ Just url -> do
637+ let uid = fromMaybe mempty $
638+ lookup "name" attrs <> lookup "id" attrs
639+ let cls = maybe [] T.words $ lookup "class" attrs
640+ url' <- canonicalizeUrl url
641+ makeQuote $ B.spanWith (uid, cls, [("cite", escapeURI url')])
642+ Nothing -> makeQuote id
643+ where
644+ makeQuote wrapper = do
645+ ctx <- asks quoteContext
646+ let (constructor, innerContext) = case ctx of
647+ InDoubleQuote -> (B.singleQuoted, InSingleQuote)
648+ _ -> (B.doubleQuoted, InDoubleQuote)
649+ content <- withQuoteContext innerContext
650+ (mconcat <$> manyTill inline (pCloses "q"))
651+ return $ extractSpaces (constructor . wrapper) content
603652
604653pEmph :: PandocMonad m => TagParser m Inlines
605654pEmph = pInlinesInTags "em" B.emph <|> pInlinesInTags "i" B.emph
@@ -690,13 +739,12 @@ pSvg = do
690739 UTF8.toText (encode $ UTF8.fromText rawText)
691740 return $ B.imageWith (ident,cls,[]) svgData mempty mempty
692741
693−pCodeWithClass :: PandocMonad m => [(T.Text,Text)] -> TagParser m Inlines
694−pCodeWithClass elemToClass = try $ do
695− let tagTest = flip elem . fmap fst $ elemToClass
696− TagOpen open attr' <- pSatisfy $ tagOpen tagTest (const True)
742+pCodeWithClass :: PandocMonad m => Text -> Text -> TagParser m Inlines
743+pCodeWithClass name class' = try $ do
744+ TagOpen open attr' <- pSatisfy $ tagOpen (== name) (const True)
697745 result <- manyTill pAny (pCloses open)
698746 let (ids,cs,kvs) = toAttr attr'
699− cs' = maybe cs (:cs) . lookup open $ elemToClass
747+ cs' = class' : cs
700748 return . B.codeWith (ids,cs',kvs) .
701749 T.unwords . T.lines . innerText $ result
702750