@@ -435,17 +435,20 @@ pTable = try $ do
435435 rowsLs <- many pTBody
436436 rows' <- pOptInTag "tfoot" $ many pTr
437437 TagClose _ <- pSatisfy (~== TagClose "table")
438− let rows = (concat rowsLs) ++ rows'
438+ let rows'' = (concat rowsLs) ++ rows'
439439 -- fail on empty table
440− guard $ not $ null head' && null rows
440+ guard $ not $ null head' && null rows''
441441 let isSinglePlain x = case B.toList x of
442442 [] -> True
443443 [Plain _] -> True
444444 _ -> False
445− let isSimple = all isSinglePlain $ concat (head':rows)
446− let cols = length $ if null head' then head rows else head'
447− -- fail if there are colspans or rowspans
448− guard $ all (\r -> length r == cols) rows
445+ let isSimple = all isSinglePlain $ concat (head':rows'')
446+ let cols = length $ if null head' then head rows'' else head'
447+ -- add empty cells to short rows
448+ let addEmpties r = case length r - cols of
449+ n | n > 1 -> r ++ replicate n []
450+ | otherwise -> r
451+ let rows = addEmpties rows''
449452 let aligns = replicate cols AlignDefault
450453 let widths = if null widths'
451454 then if isSimple
@@ -471,10 +474,17 @@ pColgroup = try $ do
471474 skipMany pBlank
472475 manyTill pCol (pCloses "colgroup" <|> eof) <* skipMany pBlank
473476
477+noColOrRowSpans :: Tag String -> Bool
478+noColOrRowSpans t = isNullOrOne "colspan" && isNullOrOne "rowspan"
479+ where isNullOrOne x = case fromAttrib x t of
480+ "" -> True
481+ "1" -> True
482+ _ -> False
483+
474484pCell :: String -> TagParser [Blocks]
475485pCell celltype = try $ do
476486 skipMany pBlank
477− res <- pInTags celltype block
487+ res <- pInTags' celltype noColOrRowSpans block
478488 skipMany pBlank
479489 return [res]
480490
@@ -695,10 +705,13 @@ pInlinesInTags :: String -> (Inlines -> Inlines)
695705 -> TagParser Inlines
696706pInlinesInTags tagtype f = extractSpaces f <$> pInTags tagtype inline
697707
698−pInTags :: (Monoid a) => String -> TagParser a
699− -> TagParser a
700−pInTags tagtype parser = try $ do
701− pSatisfy (~== TagOpen tagtype [])
708+pInTags :: (Monoid a) => String -> TagParser a -> TagParser a
709+pInTags tagtype parser = pInTags' tagtype (const True) parser
710+
711+pInTags' :: (Monoid a) => String -> (Tag String -> Bool) -> TagParser a
712+ -> TagParser a
713+pInTags' tagtype tagtest parser = try $ do
714+ pSatisfy (\t -> t ~== TagOpen tagtype [] && tagtest t)
702715 mconcat <$> manyTill parser (pCloses tagtype <|> eof)
703716
704717-- parses p, preceeded by an optional opening tag