@@ -47,7 +47,7 @@ import Data.Maybe ( fromMaybe, isJust )
4747import Data.List ( intercalate )
4848import Data.Char ( isDigit )
4949import Control.Monad ( liftM, guard, when, mzero )
50−import Control.Applicative ( (<$>), (<$) )
50+import Control.Applicative ( (<$>), (<$), (<*) )
5151
5252isSpace :: Char -> Bool
5353isSpace ' ' = True
@@ -218,8 +218,7 @@ pTable = try $ do
218218 skipMany pBlank
219219 caption <- option [] $ pInTags "caption" inline >>~ skipMany pBlank
220220 -- TODO actually read these and take width information from them
221− skipMany $ (pInTags "col" block >> skipMany pBlank) <|>
222− (pInTags "colgroup" block >> skipMany pBlank)
221+ widths' <- pColgroup <|> many pCol
223222 head' <- option [] $ pOptInTag "thead" $ pInTags "tr" (pCell "th")
224223 skipMany pBlank
225224 rows <- pOptInTag "tbody"
@@ -236,11 +235,29 @@ pTable = try $ do
236235 -- fail if there are colspans or rowspans
237236 guard $ all (\r -> length r == cols) rows
238237 let aligns = replicate cols AlignLeft
239− let widths = if isSimple
240− then replicate cols 0
241− else replicate cols (1.0 / fromIntegral cols)
238+ let widths = if null widths'
239+ then if isSimple
240+ then replicate cols 0
241+ else replicate cols (1.0 / fromIntegral cols)
242+ else widths'
242243 return [Table caption aligns widths head' rows]
243244
245+pCol :: TagParser Double
246+pCol = try $ do
247+ TagOpen _ attribs <- pSatisfy (~== TagOpen "col" [])
248+ optional $ pSatisfy (~== TagClose "col")
249+ skipMany pBlank
250+ return $ case lookup "width" attribs of
251+ Just x | not (null x) && last x == '%' ->
252+ maybe 0.0 id $ safeRead ('0':'.':init x)
253+ _ -> 0.0
254+
255+pColgroup :: TagParser [Double]
256+pColgroup = try $ do
257+ pSatisfy (~== TagOpen "colgroup" [])
258+ skipMany pBlank
259+ manyTill pCol (pCloses "colgroup" <|> eof) <* skipMany pBlank
260+
244261pCell :: String -> TagParser [TableCell]
245262pCell celltype = try $ do
246263 skipMany pBlank