summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--pandoc.cabal1
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs43
-rw-r--r--test/command/1881.md52
3 files changed, 83 insertions, 13 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index 7e7ed97b7..4d93ea2b9 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -301,6 +301,7 @@ Library
HTTP >= 4000.0.5 && < 4000.4,
texmath >= 0.9.4.1 && < 0.10,
xml >= 1.3.12 && < 1.4,
+ split >= 0.2 && < 0.3,
random >= 1 && < 1.2,
pandoc-types >= 1.17 && < 1.18,
aeson >= 0.7 && < 1.3,
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 7b9ab38fd..d85488478 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -55,9 +55,10 @@ import Text.Pandoc.Walk
import qualified Data.Map as M
import Data.Foldable ( for_ )
import Data.Maybe ( fromMaybe, isJust, isNothing )
+import Data.List.Split ( wordsBy )
import Data.List ( intercalate, isPrefixOf )
import Data.Char ( isDigit, isLetter, isAlphaNum )
-import Control.Monad ( guard, mzero, void, unless )
+import Control.Monad ( guard, mzero, void, unless, mplus )
import Control.Arrow ((***))
import Control.Applicative ( (<|>) )
import Data.Monoid (First (..))
@@ -472,31 +473,35 @@ pTable = try $ do
caption <- option mempty $ pInTags "caption" inline <* skipMany pBlank
widths' <- (mconcat <$> many1 pColgroup) <|> many pCol
let pTh = option [] $ pInTags "tr" (pCell "th")
- pTr = try $ skipMany pBlank >> pInTags "tr" (pCell "td" <|> pCell "th")
+ pTr = try $ skipMany pBlank >>
+ pInTags "tr" (pCell "td" <|> pCell "th")
pTBody = do pOptInTag "tbody" $ many1 pTr
head'' <- pOptInTag "thead" pTh
- head' <- pOptInTag "tbody" $ do
- if null head''
- then pTh
- else return head''
+ head' <- map snd <$>
+ (pOptInTag "tbody" $
+ if null head'' then pTh else return head'')
rowsLs <- many pTBody
rows' <- pOptInTag "tfoot" $ many pTr
TagClose _ <- pSatisfy (matchTagClose "table")
let rows'' = (concat rowsLs) <> rows'
+ let rows''' = map (map snd) rows''
+ -- let rows''' = map (map snd) rows''
-- fail on empty table
- guard $ not $ null head' && null rows''
+ guard $ not $ null head' && null rows'''
let isSinglePlain x = case B.toList x of
[] -> True
[Plain _] -> True
_ -> False
- let isSimple = all isSinglePlain $ concat (head':rows'')
- let cols = length $ if null head' then head rows'' else head'
+ let isSimple = all isSinglePlain $ concat (head':rows''')
+ let cols = length $ if null head' then head rows''' else head'
-- add empty cells to short rows
let addEmpties r = case cols - length r of
n | n > 0 -> r <> replicate n mempty
| otherwise -> r
- let rows = map addEmpties rows''
- let aligns = replicate cols AlignDefault
+ let rows = map addEmpties rows'''
+ let aligns = case rows'' of
+ (cs:_) -> map fst cs
+ _ -> replicate cols AlignDefault
let widths = if null widths'
then if isSimple
then replicate cols 0
@@ -534,12 +539,24 @@ noColOrRowSpans t = isNullOrOne "colspan" && isNullOrOne "rowspan"
"1" -> True
_ -> False
-pCell :: PandocMonad m => Text -> TagParser m [Blocks]
+pCell :: PandocMonad m => Text -> TagParser m [(Alignment, Blocks)]
pCell celltype = try $ do
skipMany pBlank
+ tag <- lookAhead $
+ pSatisfy (\t -> t ~== TagOpen celltype [] && noColOrRowSpans t)
+ let extractAlign' [] = ""
+ extractAlign' ("text-align":x:_) = x
+ extractAlign' (_:xs) = extractAlign' xs
+ let extractAlign = extractAlign' . wordsBy (`elem` [' ','\t',';',':'])
+ let align = case maybeFromAttrib "align" tag `mplus`
+ (extractAlign <$> maybeFromAttrib "style" tag) of
+ Just "left" -> AlignLeft
+ Just "right" -> AlignRight
+ Just "center" -> AlignCenter
+ _ -> AlignDefault
res <- pInTags' celltype noColOrRowSpans block
skipMany pBlank
- return [res]
+ return [(align, res)]
pBlockQuote :: PandocMonad m => TagParser m Blocks
pBlockQuote = do
diff --git a/test/command/1881.md b/test/command/1881.md
new file mode 100644
index 000000000..0d43997e2
--- /dev/null
+++ b/test/command/1881.md
@@ -0,0 +1,52 @@
+```
+% pandoc -f html -t native
+<table>
+<caption>Demonstration of simple table syntax.</caption>
+<thead>
+<tr class="header">
+<th align="right">Right</th>
+<th align="left">Left</th>
+<th align="center">Center</th>
+<th>Default</th>
+</tr>
+</thead>
+<tbody>
+<tr class="odd">
+<td align="right">12</td>
+<td align="left">12</td>
+<td align="center">12</td>
+<td>12</td>
+</tr>
+</tbody>
+</table>
+^D
+[Table [Str "Demonstration",Space,Str "of",Space,Str "simple",Space,Str "table",Space,Str "syntax."] [AlignRight,AlignLeft,AlignCenter,AlignDefault] [0.0,0.0,0.0,0.0]
+ [[Plain [Str "Right"]]
+ ,[Plain [Str "Left"]]
+ ,[Plain [Str "Center"]]
+ ,[Plain [Str "Default"]]]
+ [[[Plain [Str "12"]]
+ ,[Plain [Str "12"]]
+ ,[Plain [Str "12"]]
+ ,[Plain [Str "12"]]]]]
+```
+
+```
+% pandoc -f html -t native
+<table>
+<tr class="odd">
+<td style="text-align: right;">12</td>
+<td style="text-align:left;">12</td>
+<td style="text-align: center">12</td>
+<td style="text-align: right;">12</td>
+</tr>
+</table>
+^D
+[Table [] [AlignRight,AlignLeft,AlignCenter,AlignRight] [0.0,0.0,0.0,0.0]
+ []
+ [[[Plain [Str "12"]]
+ ,[Plain [Str "12"]]
+ ,[Plain [Str "12"]]
+ ,[Plain [Str "12"]]]]]
+```
+