@@ -59,8 +59,8 @@ pColgroup = try $ do
60-- | Parses a simple HTML table
60-- | Parses a simple HTML table
61pTable' :: PandocMonad m
61pTable' :: PandocMonad m
62− => TagParser m Blocks -- ^ Caption parser
62+ => TagParser m Blocks -- ^ Caption parser
63− -> (Text -> TagParser m [(Alignment, Blocks)]) -- ^ Table cell parser
63+ -> (Text -> TagParser m [Cell]) -- ^ Table cell parser
64 -> TagParser m Blocks
64 -> TagParser m Blocks
65pTable' block pCell = try $ do
65pTable' block pCell = try $ do
66 TagOpen _ attribs' <- pSatisfy (matchTagOpen "table" [])
66 TagOpen _ attribs' <- pSatisfy (matchTagOpen "table" [])
@@ -73,35 +73,31 @@ pTable' block pCell = try $ do
73 pInTags "tr" (pCell "td" <|> pCell "th")
73 pInTags "tr" (pCell "td" <|> pCell "th")
74 pTBody = pInTag True "tbody" $ many1 pTr
74 pTBody = pInTag True "tbody" $ many1 pTr
75 head'' <- pInTag False "thead" (option [] pTr) <|> pInTag True "thead" pTh
75 head'' <- pInTag False "thead" (option [] pTr) <|> pInTag True "thead" pTh
77− pInTag True "tbody"
76+ head' <- pInTag True "tbody"
78 (if null head'' then pTh else return head'')
77 (if null head'' then pTh else return head'')
79 topfoot <- option [] $ pInTag False "tfoot" $ many pTr
78 topfoot <- option [] $ pInTag False "tfoot" $ many pTr
80 rowsLs <- many pTBody
79 rowsLs <- many pTBody
81 bottomfoot <- option [] $ pInTag False "tfoot" $ many pTr
80 bottomfoot <- option [] $ pInTag False "tfoot" $ many pTr
82 TagClose _ <- pSatisfy (matchTagClose "table")
81 TagClose _ <- pSatisfy (matchTagClose "table")
83− let rows'' = concat rowsLs <> topfoot <> bottomfoot
82+ let rows = concat rowsLs <> topfoot <> bottomfoot
84− let rows''' = map (map snd) rows''
83+ rows''' = map (map cellContents) rows
85 -- fail on empty table
84 -- fail on empty table
86 guard $ not $ null head' && null rows'''
85 guard $ not $ null head' && null rows'''
87− let isSimple = onlySimpleTableCells $ fmap B.toList <$> head':rows'''
86+ let isSimple = onlySimpleTableCells $
87+ map cellContents head' : rows'''
88 let cols = if null head'
88 let cols = if null head'
89 then maximum (map length rows''')
89 then maximum (map length rows''')
90 else length head'
90 else length head'
91− -- add empty cells to short rows
92− let addEmpties r = case cols - length r of
93− n | n > 0 -> r <> replicate n mempty
95− let rows = map addEmpties rows'''
96− let aligns = case rows'' of
91+ let aligns = case rows of
92+ (cs:_) -> take cols $
97− (cs:_) -> take cols $ map fst cs ++ repeat AlignDefault
93+ concatMap cellAligns cs ++ repeat AlignDefault
98− _ -> replicate cols AlignDefault
94+ _ -> replicate cols AlignDefault
99 let widths = if null widths'
95 let widths = if null widths'
100 then if isSimple
96 then if isSimple
101 then replicate cols ColWidthDefault
97 then replicate cols ColWidthDefault
102 else replicate cols (ColWidth (1.0 / fromIntegral cols))
98 else replicate cols (ColWidth (1.0 / fromIntegral cols))
103 else widths'
99 else widths'
104− let toRow = Row nullAttr . map B.simpleCell
100+ let toRow = Row nullAttr
105 toHeaderRow l = [toRow l | not (null l)]
101 toHeaderRow l = [toRow l | not (null l)]
106 return $ B.tableWith attribs
102 return $ B.tableWith attribs
107 (B.simpleCaption caption)
103 (B.simpleCaption caption)
@@ -109,3 +105,9 @@ pTable' block pCell = try $ do
109 (TableHead nullAttr $ toHeaderRow head')
105 (TableHead nullAttr $ toHeaderRow head')
110 [TableBody nullAttr 0 [] $ map toRow rows]
106 [TableBody nullAttr 0 [] $ map toRow rows]
111 (TableFoot nullAttr [])
107 (TableFoot nullAttr [])
109+cellContents :: Cell -> [Block]
110+cellContents (Cell _ _ _ _ bs) = bs
112+cellAligns :: Cell -> [Alignment]
113+cellAligns (Cell _ align _ (ColSpan cs) _) = replicate cs align