git.iko.soy/typeable/pandoc
on master help sign in
HTML reader: support row or column-spanning table cells
commitc9f98e2bf5635564bbd83f97c32567dea121d317 authorAlbert Krewinkel <albert@zeitkraut.de> dateTue 24 Nov 2020, 13:48 (6 years ago) parent446ef27
3 files changed+36−38
compare with master
unifiedsplit
src/Text/Pandoc/Readers/HTML.hs+8−12 src/Text/Pandoc/Readers/HTML/Table.hs+18−16 test/command/1881.md+10−10
src/Text/Pandoc/Readers/HTML.hs+8−12
@@ -476,18 +476,10 @@ pHrule = do
476476pTable :: PandocMonad m => TagParser m Blocks
477477pTable = pTable' block pCell
478478
479−noColOrRowSpans :: Tag Text -> Bool
480−noColOrRowSpans t = isNullOrOne "colspan" && isNullOrOne "rowspan"
481− where isNullOrOne x = case fromAttrib x t of
482− "" -> True
483− "1" -> True
484− _ -> False
485−
486−pCell :: PandocMonad m => Text -> TagParser m [(Alignment, Blocks)]
479+pCell :: PandocMonad m => Text -> TagParser m [Cell]
487480pCell celltype = try $ do
488481 skipMany pBlank
489− tag <- lookAhead $
490− pSatisfy (\t -> t ~== TagOpen celltype [] && noColOrRowSpans t)
482+ tag <- lookAhead $ pSatisfy (\t -> t ~== TagOpen celltype [])
491483 let extractAlign' [] = ""
492484 extractAlign' ("text-align":x:_) = x
493485 extractAlign' (_:xs) = extractAlign' xs
@@ -498,9 +490,13 @@ pCell celltype = try $ do
498490 Just "right" -> AlignRight
499491 Just "center" -> AlignCenter
500492 _ -> AlignDefault
501− res <- pInTags' celltype noColOrRowSpans block
493+ let rowspan = RowSpan . fromMaybe 1 $
494+ safeRead =<< maybeFromAttrib "rowspan" tag
495+ let colspan = ColSpan . fromMaybe 1 $
496+ safeRead =<< maybeFromAttrib "colspan" tag
497+ res <- pInTags celltype block
502498 skipMany pBlank
503− return [(align, res)]
499+ return [B.cell align rowspan colspan res]
504500
505501pBlockQuote :: PandocMonad m => TagParser m Blocks
506502pBlockQuote = do
src/Text/Pandoc/Readers/HTML/Table.hs+18−16
@@ -59,8 +59,8 @@ pColgroup = try $ do
5959
6060-- | Parses a simple HTML table
6161pTable' :: PandocMonad m
62− => TagParser m Blocks -- ^ Caption parser
63− -> (Text -> TagParser m [(Alignment, Blocks)]) -- ^ Table cell parser
62+ => TagParser m Blocks -- ^ Caption parser
63+ -> (Text -> TagParser m [Cell]) -- ^ Table cell parser
6464 -> TagParser m Blocks
6565pTable' block pCell = try $ do
6666 TagOpen _ attribs' <- pSatisfy (matchTagOpen "table" [])
@@ -73,35 +73,31 @@ pTable' block pCell = try $ do
7373 pInTags "tr" (pCell "td" <|> pCell "th")
7474 pTBody = pInTag True "tbody" $ many1 pTr
7575 head'' <- pInTag False "thead" (option [] pTr) <|> pInTag True "thead" pTh
76− head' <- map snd <$>
77− pInTag True "tbody"
76+ head' <- pInTag True "tbody"
7877 (if null head'' then pTh else return head'')
7978 topfoot <- option [] $ pInTag False "tfoot" $ many pTr
8079 rowsLs <- many pTBody
8180 bottomfoot <- option [] $ pInTag False "tfoot" $ many pTr
8281 TagClose _ <- pSatisfy (matchTagClose "table")
83− let rows'' = concat rowsLs <> topfoot <> bottomfoot
84− let rows''' = map (map snd) rows''
82+ let rows = concat rowsLs <> topfoot <> bottomfoot
83+ rows''' = map (map cellContents) rows
8584 -- fail on empty table
8685 guard $ not $ null head' && null rows'''
87− let isSimple = onlySimpleTableCells $ fmap B.toList <$> head':rows'''
86+ let isSimple = onlySimpleTableCells $
87+ map cellContents head' : rows'''
8888 let cols = if null head'
8989 then maximum (map length rows''')
9090 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
94− | otherwise -> r
95− let rows = map addEmpties rows'''
96− let aligns = case rows'' of
97− (cs:_) -> take cols $ map fst cs ++ repeat AlignDefault
98− _ -> replicate cols AlignDefault
91+ let aligns = case rows of
92+ (cs:_) -> take cols $
93+ concatMap cellAligns cs ++ repeat AlignDefault
94+ _ -> replicate cols AlignDefault
9995 let widths = if null widths'
10096 then if isSimple
10197 then replicate cols ColWidthDefault
10298 else replicate cols (ColWidth (1.0 / fromIntegral cols))
10399 else widths'
104− let toRow = Row nullAttr . map B.simpleCell
100+ let toRow = Row nullAttr
105101 toHeaderRow l = [toRow l | not (null l)]
106102 return $ B.tableWith attribs
107103 (B.simpleCaption caption)
@@ -109,3 +105,9 @@ pTable' block pCell = try $ do
109105 (TableHead nullAttr $ toHeaderRow head')
110106 [TableBody nullAttr 0 [] $ map toRow rows]
111107 (TableFoot nullAttr [])
108+
109+cellContents :: Cell -> [Block]
110+cellContents (Cell _ _ _ _ bs) = bs
111+
112+cellAligns :: Cell -> [Alignment]
113+cellAligns (Cell _ align _ (ColSpan cs) _) = replicate cs align
test/command/1881.md+10−10
@@ -28,22 +28,22 @@
2828 ,(AlignDefault,ColWidthDefault)]
2929 (TableHead ("",[],[])
3030 [Row ("",[],[])
31− [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
31+ [Cell ("",[],[]) AlignRight (RowSpan 1) (ColSpan 1)
3232 [Plain [Str "Right"]]
33− ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
33+ ,Cell ("",[],[]) AlignLeft (RowSpan 1) (ColSpan 1)
3434 [Plain [Str "Left"]]
35− ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
35+ ,Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1)
3636 [Plain [Str "Center"]]
3737 ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
3838 [Plain [Str "Default"]]]])
3939 [(TableBody ("",[],[]) (RowHeadColumns 0)
4040 []
4141 [Row ("",[],[])
42− [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
42+ [Cell ("",[],[]) AlignRight (RowSpan 1) (ColSpan 1)
4343 [Plain [Str "12"]]
44− ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
44+ ,Cell ("",[],[]) AlignLeft (RowSpan 1) (ColSpan 1)
4545 [Plain [Str "12"]]
46− ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
46+ ,Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1)
4747 [Plain [Str "12"]]
4848 ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
4949 [Plain [Str "12"]]]])]
@@ -73,13 +73,13 @@
7373 [(TableBody ("",[],[]) (RowHeadColumns 0)
7474 []
7575 [Row ("",[],[])
76− [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
76+ [Cell ("",[],[]) AlignRight (RowSpan 1) (ColSpan 1)
7777 [Plain [Str "12"]]
78− ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
78+ ,Cell ("",[],[]) AlignLeft (RowSpan 1) (ColSpan 1)
7979 [Plain [Str "12"]]
80− ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
80+ ,Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1)
8181 [Plain [Str "12"]]
82− ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
82+ ,Cell ("",[],[]) AlignRight (RowSpan 1) (ColSpan 1)
8383 [Plain [Str "12"]]]])]
8484 (TableFoot ("",[],[])
8585 [])]