docbook reader: Implement column span support for tables (#6492)

Implement column span support for tables in the DocBook reader.

Co-authored-by: Nils Carlson <nils.carlson@ludd.ltu.se>
This commit is contained in:
Nils Carlson 2020-09-10 16:11:52 +00:00 committed by GitHub
parent 9cad5499c4
commit 96a0f3c7af
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 161 additions and 18 deletions

View file

@ -17,8 +17,8 @@ import Data.Default
import Data.Either (rights)
import Data.Foldable (asum)
import Data.Generics
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.List (intersperse,elemIndex)
import Data.Maybe (fromMaybe,catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup.Entity (lookupEntity)
@ -888,16 +888,6 @@ parseBlock (Elem e) =
lift $ report $ IgnoredElement $ T.pack $ qName (elName e)
return mempty
parseMixed container conts = do
let (ils,rest) = break isBlockElement conts
ils' <- (trimInlines . mconcat) <$> mapM parseInline ils
let p = if ils' == mempty then mempty else container ils'
case rest of
[] -> return p
(r:rs) -> do
b <- parseBlock r
x <- parseMixed container rs
return $ p <> b <> x
codeBlockWithLang = do
let classes' = case attrValue "language" e of
"" -> []
@ -939,16 +929,19 @@ parseBlock (Elem e) =
let colspecs = case filterChild (named "colgroup") e' of
Just c -> filterChildren isColspec c
_ -> filterChildren isColspec e'
let colnames = case colspecs of
[] -> []
cs -> catMaybes $ map (findAttr (unqual "colname" )) cs
let isRow x = named "row" x || named "tr" x
headrows <- case filterChild (named "thead") e' of
Just h -> case filterChild isRow h of
Just x -> parseRow x
Just x -> parseRow colnames x
Nothing -> return []
Nothing -> return []
bodyrows <- case filterChild (named "tbody") e' of
Just b -> mapM parseRow
Just b -> mapM (parseRow colnames)
$ filterChildren isRow b
Nothing -> mapM parseRow
Nothing -> mapM (parseRow colnames)
$ filterChildren isRow e'
let toAlignment c = case findAttr (unqual "align") c of
Just "left" -> AlignLeft
@ -974,15 +967,13 @@ parseBlock (Elem e) =
Just ws' -> let tot = sum ws'
in ColWidth . (/ tot) <$> ws'
Nothing -> replicate numrows ColWidthDefault
let toRow = Row nullAttr . map simpleCell
let toRow = Row nullAttr
toHeaderRow l = if null l then [] else [toRow l]
return $ table (simpleCaption $ plain capt)
(zip aligns widths)
(TableHead nullAttr $ toHeaderRow headrows)
[TableBody nullAttr 0 [] $ map toRow bodyrows]
(TableFoot nullAttr [])
isEntry x = named "entry" x || named "td" x || named "th" x
parseRow = mapM (parseMixed plain . elContent) . filterChildren isEntry
sect n = sectWith (attrValue "id" e,[],[]) n
sectWith attr n = do
isbook <- gets dbBook
@ -1014,6 +1005,39 @@ parseBlock (Elem e) =
-- we also attach the label as a class, so it can be styled properly
return $ divWith (attrValue "id" e,[label],[]) (title <> b)
parseMixed :: PandocMonad m => (Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed container conts = do
let (ils,rest) = break isBlockElement conts
ils' <- (trimInlines . mconcat) <$> mapM parseInline ils
let p = if ils' == mempty then mempty else container ils'
case rest of
[] -> return p
(r:rs) -> do
b <- parseBlock r
x <- parseMixed container rs
return $ p <> b <> x
parseRow :: PandocMonad m => [String] -> Element -> DB m [Cell]
parseRow cn = do
let isEntry x = named "entry" x || named "td" x || named "th" x
mapM (parseEntry cn) . filterChildren isEntry
parseEntry :: PandocMonad m => [String] -> Element -> DB m Cell
parseEntry cn el = do
let colDistance sa ea = do
let iStrt = elemIndex sa cn
let iEnd = elemIndex ea cn
case (iStrt, iEnd) of
(Just start, Just end) -> ColSpan $ end - start + 1
_ -> 1
let toColSpan en = do
let mStrt = findAttr (unqual "namest") en
let mEnd = findAttr (unqual "nameend") en
case (mStrt, mEnd) of
(Just start, Just end) -> colDistance start end
_ -> 1
(fmap (cell AlignDefault 1 (toColSpan el)) . (parseMixed plain) . elContent) el
getInlines :: PandocMonad m => Element -> DB m Inlines
getInlines e' = (trimInlines . mconcat) <$>
mapM parseInline (elContent e')

View file

@ -0,0 +1,119 @@
```
% pandoc -f docbook -t native --quiet
<informaltable frame="all" rowsep="1" colsep="1">
<tgroup cols="16">
<colspec colname="col_1" colwidth="6.25*"/>
<colspec colname="col_2" colwidth="6.25*"/>
<colspec colname="col_3" colwidth="6.25*"/>
<colspec colname="col_4" colwidth="6.25*"/>
<colspec colname="col_5" colwidth="6.25*"/>
<colspec colname="col_6" colwidth="6.25*"/>
<colspec colname="col_7" colwidth="6.25*"/>
<colspec colname="col_8" colwidth="6.25*"/>
<colspec colname="col_9" colwidth="6.25*"/>
<colspec colname="col_10" colwidth="6.25*"/>
<colspec colname="col_11" colwidth="6.25*"/>
<colspec colname="col_12" colwidth="6.25*"/>
<colspec colname="col_13" colwidth="6.25*"/>
<colspec colname="col_14" colwidth="6.25*"/>
<colspec colname="col_15" colwidth="6.25*"/>
<colspec colname="col_16" colwidth="6.25*"/>
<tbody>
<row>
<entry align="center" valign="top" namest="col_1" nameend="col_8"><simpara><emphasis role="strong">Octet no. 1</emphasis></simpara></entry>
<entry align="center" valign="top" namest="col_2" nameend="col_9"><simpara><emphasis role="strong">Octet no. 2</emphasis></simpara></entry>
</row>
<row>
<entry align="center" valign="top"><simpara>16</simpara></entry>
<entry align="center" valign="top"><simpara>15</simpara></entry>
<entry align="center" valign="top"><simpara>14</simpara></entry>
<entry align="center" valign="top"><simpara>13</simpara></entry>
<entry align="center" valign="top"><simpara>12</simpara></entry>
<entry align="center" valign="top"><simpara>11</simpara></entry>
<entry align="center" valign="top"><simpara>10</simpara></entry>
<entry align="center" valign="top"><simpara>9</simpara></entry>
<entry align="center" valign="top"><simpara>8</simpara></entry>
<entry align="center" valign="top"><simpara>7</simpara></entry>
<entry align="center" valign="top"><simpara>6</simpara></entry>
<entry align="center" valign="top"><simpara>5</simpara></entry>
<entry align="center" valign="top"><simpara>4</simpara></entry>
<entry align="center" valign="top"><simpara>3</simpara></entry>
<entry align="center" valign="top"><simpara>2</simpara></entry>
<entry align="center" valign="top"><simpara>1</simpara></entry>
</row>
<row>
<entry align="center" valign="top" namest="col_1" nameend="col_8"><simpara>Code A</simpara></entry>
<entry align="center" valign="top" namest="col_2" nameend="col_9"><simpara>Code B</simpara></entry>
</row>
</tbody>
</tgroup>
</informaltable>
^D
[Table ("",[],[]) (Caption Nothing
[])
[(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)
,(AlignDefault,ColWidth 6.25e-2)]
(TableHead ("",[],[])
[])
[(TableBody ("",[],[]) (RowHeadColumns 0)
[]
[Row ("",[],[])
[Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 8)
[Para [Strong [Str "Octet",Space,Str "no.",Space,Str "1"]]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 8)
[Para [Strong [Str "Octet",Space,Str "no.",Space,Str "2"]]]]
,Row ("",[],[])
[Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "16"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "15"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "14"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "13"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "12"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "11"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "10"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "9"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "8"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "7"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "6"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "5"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "4"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "3"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "2"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
[Para [Str "1"]]]
,Row ("",[],[])
[Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 8)
[Para [Str "Code",Space,Str "A"]]
,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 8)
[Para [Str "Code",Space,Str "B"]]]])]
(TableFoot ("",[],[])
[])]
```