git.iko.soy/typeable/pandoc
on master help sign in
HTML reader: allow finer grained options for tag omission
3e01ae4Albert Krewinkel
src/Text/Pandoc/Readers/HTML.hs+1−1
compare with master
unifiedsplit
@@ -514,7 +514,7 @@ pFigure = try $ do
514 TagOpen _ _ <- pSatisfy (matchTagOpen "figure" [])
514 TagOpen _ _ <- pSatisfy (matchTagOpen "figure" [])
515 skipMany pBlank
515 skipMany pBlank
516 let pImg = (\x -> (Just x, Nothing)) <$>
516 let pImg = (\x -> (Just x, Nothing)) <$>
517− (pInTag True "p" pImage <* skipMany pBlank)
517+ (pInTag TagsOmittable "p" pImage <* skipMany pBlank)
518 pCapt = (\x -> (Nothing, Just x)) <$> do
518 pCapt = (\x -> (Nothing, Just x)) <$> do
519 bs <- pInTags "figcaption" block
519 bs <- pInTags "figcaption" block
520 return $ blocksToInlines' $ B.toList bs
520 return $ blocksToInlines' $ B.toList bs
src/Text/Pandoc/Readers/HTML/Parsing.hs+17−5
@@ -11,7 +11,8 @@
11Parsing functions and utilities.
11Parsing functions and utilities.
12-}
12-}
13module Text.Pandoc.Readers.HTML.Parsing
13module Text.Pandoc.Readers.HTML.Parsing
14+ ( TagOmission (..)
14− ( pInTags
15+ , pInTags
15 , pInTags'
16 , pInTags'
16 , pInTag
17 , pInTag
17 , pAny
18 , pAny
@@ -43,6 +44,13 @@ import Text.Pandoc.XML (html5Attributes, html4Attributes, rdfaAttributes)
43import qualified Data.Set as Set
44import qualified Data.Set as Set
44import qualified Data.Text as T
45import qualified Data.Text as T
45
46
47+-- | Whether no tag, the closing tag, or both tags can be omitted.
48+data TagOmission
49+ = TagsRequired -- ^ Opening and closing tags are both required
50+ | ClosingTagOptional -- ^ The closing tag can be omitted
51+ | TagsOmittable -- ^ Both tags, opening and closing, can be omitted.
52+ deriving (Eq)
53+
46pInTags :: (PandocMonad m, Monoid a) => Text -> TagParser m a -> TagParser m a
54pInTags :: (PandocMonad m, Monoid a) => Text -> TagParser m a -> TagParser m a
47pInTags tagtype parser = pInTags' tagtype (const True) parser
55pInTags tagtype parser = pInTags' tagtype (const True) parser
48
56
@@ -57,14 +65,18 @@ pInTags' tagtype tagtest parser = try $ do
57
65
58-- parses p, preceded by an opening tag (optional if tagsOptional)
66-- parses p, preceded by an opening tag (optional if tagsOptional)
59-- and followed by a closing tag (optional if tagsOptional)
67-- and followed by a closing tag (optional if tagsOptional)
60−pInTag :: PandocMonad m => Bool -> Text -> TagParser m a -> TagParser m a
68+pInTag :: PandocMonad m => TagOmission -> Text -> TagParser m a -> TagParser m a
61−pInTag tagsOptional tagtype p = try $ do
69+pInTag tagOmission tagtype p = try $ do
62 skipMany pBlank
70 skipMany pBlank
71+ let openingOptional = tagOmission == TagsOmittable
72+ let closingOptional = tagOmission /= TagsRequired
73+ (if openingOptional then optional else void) $
63− (if tagsOptional then optional else void) $ pSatisfy (matchTagOpen tagtype [])
74+ pSatisfy (matchTagOpen tagtype [])
64 skipMany pBlank
75 skipMany pBlank
65 x <- p
76 x <- p
66 skipMany pBlank
77 skipMany pBlank
78+ (if closingOptional then optional else void) $
67− (if tagsOptional then optional else void) $ pSatisfy (matchTagClose tagtype)
79+ pSatisfy (matchTagClose tagtype)
68 skipMany pBlank
80 skipMany pBlank
69 return x
81 return x
70
82
src/Text/Pandoc/Readers/HTML/Table.hs+8−7
@@ -69,15 +69,16 @@ pTable' block pCell = try $ do
69 caption <- option mempty $ pInTags "caption" block <* skipMany pBlank
69 caption <- option mempty $ pInTags "caption" block <* skipMany pBlank
70 widths' <- (mconcat <$> many1 pColgroup) <|> many pCol
70 widths' <- (mconcat <$> many1 pColgroup) <|> many pCol
71 let pTh = option [] $ pInTags "tr" (pCell "th")
71 let pTh = option [] $ pInTags "tr" (pCell "th")
72− pTr = try $ skipMany pBlank >>
72+ pTr = try $ skipMany pBlank
73− pInTags "tr" (pCell "td" <|> pCell "th")
73+ *> pInTags "tr" (pCell "td" <|> pCell "th")
74− pTBody = pInTag True "tbody" $ many1 pTr
74+ pTBody = pInTag TagsOmittable "tbody" $ many1 pTr
75− head'' <- pInTag False "thead" (option [] pTr) <|> pInTag True "thead" pTh
75+ head'' <- pInTag ClosingTagOptional "thead" (option [] pTr)
76+ <|> pInTag TagsOmittable "thead" pTh
76− head' <- pInTag True "tbody"
77+ head' <- pInTag TagsOmittable "tbody"
77 (if null head'' then pTh else return head'')
78 (if null head'' then pTh else return head'')
78− topfoot <- option [] $ pInTag False "tfoot" $ many pTr
79+ topfoot <- option [] $ pInTag TagsRequired "tfoot" $ many pTr
79 rowsLs <- many pTBody
80 rowsLs <- many pTBody
80− bottomfoot <- option [] $ pInTag False "tfoot" $ many pTr
81+ bottomfoot <- option [] $ pInTag ClosingTagOptional "tfoot" $ many pTr
81 TagClose _ <- pSatisfy (matchTagClose "table")
82 TagClose _ <- pSatisfy (matchTagClose "table")
82 let rows = concat rowsLs <> topfoot <> bottomfoot
83 let rows = concat rowsLs <> topfoot <> bottomfoot
83 rows''' = map (map cellContents) rows
84 rows''' = map (map cellContents) rows