@@ -17,6 +17,7 @@ module Text.Pandoc.Readers.HTML.Table (pTable) where
1717
1818import Control.Applicative ((<|>))
1919import Data.Maybe (fromMaybe)
20+import Data.Either (lefts, rights)
2021import Data.List.NonEmpty (nonEmpty)
2122import Data.Text (Text)
2223import Text.HTML.TagSoup
@@ -33,34 +34,51 @@ import Text.Pandoc.Shared (onlySimpleTableCells, safeRead)
3334import qualified Data.Text as T
3435import qualified Text.Pandoc.Builder as B
3536
36−-- | Parses a @<col>@ element, returning the column's width. Defaults to
37−-- @'ColWidthDefault'@ if the width is not set or cannot be determined.
38−pCol :: PandocMonad m => TagParser m ColWidth
37+-- | Parses a @<col>@ element, returning the column's width.
38+-- An Either value is used: Left i means a "relative length" with
39+-- integral value i (see https://www.w3.org/TR/html4/types.html#h-6.6);
40+-- Right w means a regular width. Defaults to @'Right ColWidthDefault'@
41+-- if the width is not set or cannot be determined.
42+pCol :: PandocMonad m => TagParser m (Either Int ColWidth)
3943pCol = try $ do
4044 TagOpen _ attribs' <- pSatisfy (matchTagOpen "col" [])
4145 let attribs = toStringAttr attribs'
4246 skipMany pBlank
4347 optional $ pSatisfy (matchTagClose "col")
4448 skipMany pBlank
45− let width = case lookup "width" attribs of
49+ return $ case lookup "width" attribs of
4650 Nothing -> case lookup "style" attribs of
4751 Just (T.stripPrefix "width:" -> Just xs) | T.any (== '%') xs ->
48− fromMaybe 0.0 $ safeRead (T.filter
49− (`notElem` (" \t\r\n%'\";" :: [Char])) xs)
50− _ -> 0.0
52+ maybe (Right ColWidthDefault) (Right . ColWidth)
53+ $ safeRead (T.filter
54+ (`notElem` (" \t\r\n%'\";" :: [Char])) xs)
55+ _ -> Right ColWidthDefault
56+ Just (T.unsnoc -> Just (xs, '*')) ->
57+ maybe (Left 1) Left $ safeRead xs
5158 Just (T.unsnoc -> Just (xs, '%')) ->
52− fromMaybe 0.0 $ safeRead xs
53− _ -> 0.0
54− if width > 0.0
55− then return $ ColWidth $ width / 100.0
56− else return ColWidthDefault
59+ maybe (Right ColWidthDefault)
60+ (Right . ColWidth . (/ 100.0)) $ safeRead xs
61+ _ -> Right ColWidthDefault
5762
58−pColgroup :: PandocMonad m => TagParser m [ColWidth]
63+pColgroup :: PandocMonad m => TagParser m [Either Int ColWidth]
5964pColgroup = try $ do
6065 pSatisfy (matchTagOpen "colgroup" [])
6166 skipMany pBlank
6267 manyTill pCol (pCloses "colgroup" <|> eof) <* skipMany pBlank
6368
69+resolveRelativeLengths :: [Either Int ColWidth] -> [ColWidth]
70+resolveRelativeLengths ws =
71+ let remaining = 1 - sum (map getColWidth $ rights ws)
72+ relatives = sum $ lefts ws
73+ relUnit = remaining / fromIntegral relatives
74+ toColWidth (Right x) = x
75+ toColWidth (Left i) = ColWidth (fromIntegral i * relUnit)
76+ in map toColWidth ws
77+
78+getColWidth :: ColWidth -> Double
79+getColWidth ColWidthDefault = 0
80+getColWidth (ColWidth w) = w
81+
6482data CellType
6583 = HeaderCell
6684 | BodyCell
@@ -182,7 +200,8 @@ pTable :: PandocMonad m
182200pTable block = try $ do
183201 TagOpen _ attribs <- pSatisfy (matchTagOpen "table" []) <* skipMany pBlank
184202 caption <- option mempty $ pInTags "caption" block <* skipMany pBlank
185− widths <- ((mconcat <$> many1 pColgroup) <|> many pCol) <* skipMany pBlank
203+ widths <- resolveRelativeLengths <$>
204+ ((mconcat <$> many1 pColgroup) <|> many pCol) <* skipMany pBlank
186205 thead <- pTableHead block <* skipMany pBlank
187206 topfoot <- optionMaybe (pTableFoot block) <* skipMany pBlank
188207 tbodies <- many (pTableBody block) <* skipMany pBlank