aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs33
1 files changed, 22 insertions, 11 deletions
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 2a23f2a62..02ff07e73 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -374,12 +374,20 @@ pTable = try $ do
caption <- option mempty $ pInTags "caption" inline <* skipMany pBlank
-- TODO actually read these and take width information from them
widths' <- pColgroup <|> many pCol
- head' <- option [] $ pOptInTag "thead" $ pInTags "tr" (pCell "th")
- skipMany pBlank
- rows <- pOptInTag "tbody"
- $ many1 $ try $ skipMany pBlank >> pInTags "tr" (pCell "td")
- skipMany pBlank
+ let pTh = option [] $ pInTags "tr" (pCell "th")
+ pTr = try $ skipMany pBlank >> pInTags "tr" (pCell "td" <|> pCell "th")
+ pTBody = do pOptInTag "tbody" $ many1 pTr
+ head'' <- pOptInTag "thead" pTh
+ head' <- pOptInTag "tbody" $ do
+ if null head''
+ then pTh
+ else return head''
+ rowsLs <- many pTBody
+ rows' <- pOptInTag "tfoot" $ many pTr
TagClose _ <- pSatisfy (~== TagClose "table")
+ let rows = (concat rowsLs) ++ rows'
+ -- fail on empty table
+ guard $ not $ null head' && null rows
let isSinglePlain x = case B.toList x of
[Plain _] -> True
_ -> False
@@ -624,14 +632,17 @@ pInTags tagtype parser = try $ do
pSatisfy (~== TagOpen tagtype [])
mconcat <$> manyTill parser (pCloses tagtype <|> eof)
-pOptInTag :: String -> TagParser a
- -> TagParser a
-pOptInTag tagtype parser = try $ do
- open <- option False (pSatisfy (~== TagOpen tagtype []) >> return True)
+-- parses p, preceeded by an optional opening tag
+-- and followed by an optional closing tags
+pOptInTag :: String -> TagParser a -> TagParser a
+pOptInTag tagtype p = try $ do
+ skipMany pBlank
+ optional $ pSatisfy (~== TagOpen tagtype [])
+ skipMany pBlank
+ x <- p
skipMany pBlank
- x <- parser
+ optional $ pSatisfy (~== TagClose tagtype)
skipMany pBlank
- when open $ pCloses tagtype
return x
pCloses :: String -> TagParser ()