diff options
Diffstat (limited to 'src/Text/Pandoc/Readers')
| -rw-r--r-- | src/Text/Pandoc/Readers/CSV.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/CommonMark.hs | 18 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/DocBook.hs | 36 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 20 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/DokuWiki.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/HTML.hs | 16 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Haddock.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Ipynb.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/JATS.hs | 49 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/LaTeX.hs | 25 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Man.hs | 7 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/MediaWiki.hs | 6 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/ContentReader.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/Blocks.hs | 14 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 50 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/TWiki.hs | 10 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Textile.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Txt2Tags.hs | 2 |
20 files changed, 150 insertions, 126 deletions
diff --git a/src/Text/Pandoc/Readers/CSV.hs b/src/Text/Pandoc/Readers/CSV.hs index fa358424f..8608a1a2c 100644 --- a/src/Text/Pandoc/Readers/CSV.hs +++ b/src/Text/Pandoc/Readers/CSV.hs @@ -37,6 +37,6 @@ readCSV _opts s = hdrs = map toplain r rows = map (map toplain) rs aligns = replicate numcols AlignDefault - widths = replicate numcols 0 + widths = replicate numcols Nothing Right [] -> return $ B.doc mempty Left e -> throwError $ PandocParsecError s e diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs index 67853aef7..33afbe59f 100644 --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -111,31 +111,33 @@ addBlock opts (Node _ (LIST listAttrs) nodes) = PAREN_DELIM -> OneParen exts = readerExtensions opts addBlock opts (Node _ (TABLE alignments) nodes) = - (Table [] aligns widths headers rows :) + (Table nullAttr (Caption Nothing []) (zip aligns widths) 0 headers rows [] :) where aligns = map fromTableCellAlignment alignments fromTableCellAlignment NoAlignment = AlignDefault fromTableCellAlignment LeftAligned = AlignLeft fromTableCellAlignment RightAligned = AlignRight fromTableCellAlignment CenterAligned = AlignCenter - widths = replicate numcols 0.0 + widths = replicate numcols Nothing numcols = if null rows' then 0 - else maximum $ map length rows' + else maximum $ map rowLength rows' rows' = map toRow $ filter isRow nodes (headers, rows) = case rows' of - (h:rs) -> (h, rs) + (h:rs) -> ([h], rs) [] -> ([], []) isRow (Node _ TABLE_ROW _) = True isRow _ = False isCell (Node _ TABLE_CELL _) = True isCell _ = False - toRow (Node _ TABLE_ROW ns) = map toCell $ filter isCell ns + toRow (Node _ TABLE_ROW ns) = Row nullAttr $ map toCell $ filter isCell ns toRow (Node _ t _) = error $ "toRow encountered non-row " ++ show t - toCell (Node _ TABLE_CELL []) = [] + toCell (Node _ TABLE_CELL []) = fromSimpleCell [] toCell (Node _ TABLE_CELL (n:ns)) - | isBlockNode n = addBlocks opts (n:ns) - | otherwise = [Plain (addInlines opts (n:ns))] + | isBlockNode n = fromSimpleCell $ addBlocks opts (n:ns) + | otherwise = fromSimpleCell [Plain (addInlines opts (n:ns))] toCell (Node _ t _) = error $ "toCell encountered non-cell " ++ show t + fromSimpleCell = Cell nullAttr Nothing 1 1 + rowLength (Row _ body) = length body -- all cells are 1×1 addBlock _ (Node _ TABLE_ROW _) = id -- handled in TABLE addBlock _ (Node _ TABLE_CELL _) = id -- handled in TABLE addBlock _ _ = id diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 7f71cb3c1..6c56c1bd7 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -676,10 +676,10 @@ getMediaobject e = do Just z -> mconcat <$> mapM parseInline (elContent z) figTitle <- gets dbFigureTitle - let (caption, title) = if isNull figTitle - then (getCaption e, "") - else (return figTitle, "fig:") - fmap (imageWith attr imageUrl title) caption + let (capt, title) = if isNull figTitle + then (getCaption e, "") + else (return figTitle, "fig:") + fmap (imageWith attr imageUrl title) capt getBlocks :: PandocMonad m => Element -> DB m Blocks getBlocks e = mconcat <$> @@ -844,9 +844,9 @@ parseBlock (Elem e) = return (mconcat $ intersperse (str "; ") terms', items') parseTable = do let isCaption x = named "title" x || named "caption" x - caption <- case filterChild isCaption e of - Just t -> getInlines t - Nothing -> return mempty + capt <- case filterChild isCaption e of + Just t -> getInlines t + Nothing -> return mempty let e' = fromMaybe e $ filterChild (named "tgroup") e let isColspec x = named "colspec" x || named "col" x let colspecs = case filterChild (named "colgroup") e' of @@ -868,12 +868,12 @@ parseBlock (Elem e) = Just "right" -> AlignRight Just "center" -> AlignCenter _ -> AlignDefault - let toWidth c = case findAttr (unqual "colwidth") c of - Just w -> fromMaybe 0 - $ safeRead $ "0" <> T.filter (\x -> + let toWidth c = do + w <- findAttr (unqual "colwidth") c + n <- safeRead $ "0" <> T.filter (\x -> (x >= '0' && x <= '9') || x == '.') (T.pack w) - Nothing -> 0 :: Double + if n > 0 then Just n else Nothing let numrows = case bodyrows of [] -> 0 xs -> maximum $ map length xs @@ -881,16 +881,16 @@ parseBlock (Elem e) = [] -> replicate numrows AlignDefault cs -> map toAlignment cs let widths = case colspecs of - [] -> replicate numrows 0 - cs -> let ws = map toWidth cs - tot = sum ws - in if all (> 0) ws - then map (/ tot) ws - else replicate numrows 0 + [] -> replicate numrows Nothing + cs -> let ws = map toWidth cs + in case sequence ws of + Just ws' -> let tot = sum ws' + in Just . (/ tot) <$> ws' + Nothing -> replicate numrows Nothing let headrows' = if null headrows then replicate numrows mempty else headrows - return $ table caption (zip aligns widths) + return $ table capt (zip aligns widths) headrows' bodyrows isEntry x = named "entry" x || named "td" x || named "th" x parseRow = mapM (parseMixed plain . elContent) . filterChildren isEntry diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index f616a5b7a..a5e8cb463 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -77,7 +77,7 @@ import Text.Pandoc.MediaBag (MediaBag) import Text.Pandoc.Options import Text.Pandoc.Readers.Docx.Combine import Text.Pandoc.Readers.Docx.Lists -import Text.Pandoc.Readers.Docx.Parse +import Text.Pandoc.Readers.Docx.Parse as Docx import Text.Pandoc.Shared import Text.Pandoc.Walk import Text.TeXMath (writeTeX) @@ -494,13 +494,13 @@ singleParaToPlain blks singleton $ Plain ils singleParaToPlain blks = blks -cellToBlocks :: PandocMonad m => Cell -> DocxContext m Blocks -cellToBlocks (Cell bps) = do +cellToBlocks :: PandocMonad m => Docx.Cell -> DocxContext m Blocks +cellToBlocks (Docx.Cell bps) = do blks <- smushBlocks <$> mapM bodyPartToBlocks bps return $ fromList $ blocksToDefinitions $ blocksToBullets $ toList blks -rowToBlocksList :: PandocMonad m => Row -> DocxContext m [Blocks] -rowToBlocksList (Row cells) = do +rowToBlocksList :: PandocMonad m => Docx.Row -> DocxContext m [Blocks] +rowToBlocksList (Docx.Row cells) = do blksList <- mapM cellToBlocks cells return $ map singleParaToPlain blksList @@ -645,7 +645,7 @@ bodyPartToBlocks (ListItem pPr _ _ _ parparts) = bodyPartToBlocks (Tbl _ _ _ []) = return $ para mempty bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do - let caption = text cap + let cap' = text cap (hdr, rows) = case firstRowFormatting look of True | null rs -> (Nothing, [r]) | otherwise -> (Just r, rs) @@ -659,8 +659,8 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do -- https://github.com/jgm/pandoc/pull/4361#issuecomment-365416155 nonEmpty [] = Nothing nonEmpty l = Just l - rowLength :: Row -> Int - rowLength (Row c) = length c + rowLength :: Docx.Row -> Int + rowLength (Docx.Row c) = length c -- pad cells. New Text.Pandoc.Builder will do that for us, -- so this is for compatibility while we switch over. @@ -676,9 +676,9 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do -- so should be possible. Alignment might be more difficult, -- since there doesn't seem to be a column entity in docx. let alignments = replicate width AlignDefault - widths = replicate width 0 :: [Double] + widths = replicate width Nothing - return $ table caption (zip alignments widths) hdrCells cells' + return $ table cap' (zip alignments widths) hdrCells cells' bodyPartToBlocks (OMathPara e) = return $ para $ displayMath (writeTeX e) diff --git a/src/Text/Pandoc/Readers/DokuWiki.hs b/src/Text/Pandoc/Readers/DokuWiki.hs index 384deb694..296c751a2 100644 --- a/src/Text/Pandoc/Readers/DokuWiki.hs +++ b/src/Text/Pandoc/Readers/DokuWiki.hs @@ -470,7 +470,7 @@ table = do let (headerRow, body) = if firstSeparator == '^' then (head rows, tail rows) else ([], rows) - let attrs = (AlignDefault, 0.0) <$ transpose rows + let attrs = (AlignDefault, Nothing) <$ transpose rows pure $ B.table mempty attrs headerRow body tableRows :: PandocMonad m => DWParser m [[B.Blocks]] diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 798661fe3..e3c3d00e6 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -61,7 +61,7 @@ import Text.Pandoc.Options ( import Text.Pandoc.Parsing hiding ((<|>)) import Text.Pandoc.Shared (addMetaField, blocksToInlines', crFilter, escapeURI, extractSpaces, htmlSpanLikeElements, elemText, splitTextBy, - onlySimpleTableCells, safeRead, underlineSpan, tshow) + onlySimpleCellBodies, safeRead, underlineSpan, tshow) import Text.Pandoc.Walk import Text.Parsec.Error import Text.TeXMath (readMathML, writeTeX) @@ -499,7 +499,7 @@ pTable = try $ do let rows''' = map (map snd) rows'' -- fail on empty table guard $ not $ null head' && null rows''' - let isSimple = onlySimpleTableCells $ fmap B.toList <$> head':rows''' + let isSimple = onlySimpleCellBodies $ fmap B.toList <$> head':rows''' let cols = if null head' then maximum (map length rows''') else length head' @@ -513,12 +513,12 @@ pTable = try $ do _ -> replicate cols AlignDefault let widths = if null widths' then if isSimple - then replicate cols 0 - else replicate cols (1.0 / fromIntegral cols) + then replicate cols Nothing + else replicate cols (Just (1.0 / fromIntegral cols)) else widths' return $ B.table caption (zip aligns widths) head' rows -pCol :: PandocMonad m => TagParser m Double +pCol :: PandocMonad m => TagParser m (Maybe Double) pCol = try $ do TagOpen _ attribs' <- pSatisfy (matchTagOpen "col" []) let attribs = toStringAttr attribs' @@ -535,10 +535,10 @@ pCol = try $ do fromMaybe 0.0 $ safeRead xs _ -> 0.0 if width > 0.0 - then return $ width / 100.0 - else return 0.0 + then return $ Just $ width / 100.0 + else return Nothing -pColgroup :: PandocMonad m => TagParser m [Double] +pColgroup :: PandocMonad m => TagParser m [Maybe Double] pColgroup = try $ do pSatisfy (matchTagOpen "colgroup" []) skipMany pBlank diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 749a63114..7303f9c32 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -91,7 +91,7 @@ docHToBlocks d' = else (toCells (head headerRows), map toCells (tail headerRows ++ bodyRows)) colspecs = replicate (maximum (map length body)) - (AlignDefault, 0.0) + (AlignDefault, Nothing) in B.table mempty colspecs header body where inlineFallback = B.plain $ docHToInlines False d' diff --git a/src/Text/Pandoc/Readers/Ipynb.hs b/src/Text/Pandoc/Readers/Ipynb.hs index bfd9572ce..079eacf97 100644 --- a/src/Text/Pandoc/Readers/Ipynb.hs +++ b/src/Text/Pandoc/Readers/Ipynb.hs @@ -69,7 +69,7 @@ notebookToPandoc opts notebook = do return $ Pandoc (Meta $ M.insert "jupyter" (MetaMap m) mempty) blocks cellToBlocks :: PandocMonad m - => ReaderOptions -> Text -> Cell a -> m B.Blocks + => ReaderOptions -> Text -> Ipynb.Cell a -> m B.Blocks cellToBlocks opts lang c = do let Source ts = cellSource c let source = mconcat ts diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs index 3672b05f6..3dfe9161b 100644 --- a/src/Text/Pandoc/Readers/JATS.hs +++ b/src/Text/Pandoc/Readers/JATS.hs @@ -134,14 +134,14 @@ getGraphic :: PandocMonad m => Maybe (Inlines, Text) -> Element -> JATS m Inlines getGraphic mbfigdata e = do let atVal a = attrValue a e - (ident, title, caption) = + (ident, title, capt) = case mbfigdata of - Just (capt, i) -> (i, "fig:" <> atVal "title", capt) + Just (capt', i) -> (i, "fig:" <> atVal "title", capt') Nothing -> (atVal "id", atVal "title", text (atVal "alt-text")) attr = (ident, T.words $ atVal "role", []) imageUrl = atVal "href" - return $ imageWith attr imageUrl title caption + return $ imageWith attr imageUrl title capt getBlocks :: PandocMonad m => Element -> JATS m Blocks getBlocks e = mconcat <$> @@ -230,20 +230,20 @@ parseBlock (Elem e) = -- implicit figure. otherwise, we emit a div with the contents case filterChildren (named "graphic") e of [g] -> do - caption <- case filterChild (named "caption") e of - Just t -> mconcat . - intersperse linebreak <$> - mapM getInlines - (filterChildren (const True) t) - Nothing -> return mempty - img <- getGraphic (Just (caption, attrValue "id" e)) g + capt <- case filterChild (named "caption") e of + Just t -> mconcat . + intersperse linebreak <$> + mapM getInlines + (filterChildren (const True) t) + Nothing -> return mempty + img <- getGraphic (Just (capt, attrValue "id" e)) g return $ para img _ -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e parseTable = do let isCaption x = named "title" x || named "caption" x - caption <- case filterChild isCaption e of - Just t -> getInlines t - Nothing -> return mempty + capt <- case filterChild isCaption e of + Just t -> getInlines t + Nothing -> return mempty let e' = fromMaybe e $ filterChild (named "tgroup") e let isColspec x = named "colspec" x || named "col" x let colspecs = case filterChild (named "colgroup") e' of @@ -265,26 +265,25 @@ parseBlock (Elem e) = Just "right" -> AlignRight Just "center" -> AlignCenter _ -> AlignDefault - let toWidth c = case findAttrText (unqual "colwidth") c of - Just w -> fromMaybe 0 - $ safeRead $ "0" <> T.filter (\x -> - isDigit x || x == '.') w - Nothing -> 0 :: Double + let toWidth c = do + w <- findAttrText (unqual "colwidth") c + n <- safeRead $ "0" <> T.filter (\x -> isDigit x || x == '.') w + if n > 0 then Just n else Nothing let numrows = foldl' max 0 $ map length bodyrows let aligns = case colspecs of [] -> replicate numrows AlignDefault cs -> map toAlignment cs let widths = case colspecs of - [] -> replicate numrows 0 - cs -> let ws = map toWidth cs - tot = sum ws - in if all (> 0) ws - then map (/ tot) ws - else replicate numrows 0 + [] -> replicate numrows Nothing + cs -> let ws = map toWidth cs + in case sequence ws of + Just ws' -> let tot = sum ws' + in Just . (/ tot) <$> ws' + Nothing -> replicate numrows Nothing let headrows' = if null headrows then replicate numrows mempty else headrows - return $ table caption (zip aligns widths) + return $ table capt (zip aligns widths) headrows' bodyrows isEntry x = named "entry" x || named "td" x || named "th" x parseRow = mapM (parseMixed plain . elContent) . filterChildren isEntry diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 038430f99..4b09f1402 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -2268,7 +2268,7 @@ splitWordTok = do setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) <> rest _ -> return () -parseAligns :: PandocMonad m => LP m [(Alignment, Double, ([Tok], [Tok]))] +parseAligns :: PandocMonad m => LP m [(Alignment, Maybe Double, ([Tok], [Tok]))] parseAligns = try $ do let maybeBar = skipMany (try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced))) @@ -2289,17 +2289,15 @@ parseAligns = try $ do ds <- trim . untokenize <$> manyTill anyTok (controlSeq "linewidth") spaces symbol '}' - case safeRead ds of - Just w -> return w - Nothing -> return 0.0 + return $ safeRead ds let alignSpec = do pref <- option [] alignPrefix spaces al <- alignChar - width <- colWidth <|> option 0.0 (do s <- untokenize <$> braced - pos <- getPosition - report $ SkippedContent s pos - return 0.0) + width <- colWidth <|> option Nothing (do s <- untokenize <$> braced + pos <- getPosition + report $ SkippedContent s pos + return Nothing) spaces suff <- option [] alignSuffix return (al, width, (pref, suff)) @@ -2399,11 +2397,11 @@ simpTable envname hasWidthParameter = try $ do addTableCaption :: PandocMonad m => Blocks -> LP m Blocks addTableCaption = walkM go - where go (Table c als ws hs rs) = do + where go (Table attr c spec rhs th tb tf) = do st <- getState let mblabel = sLastLabel st capt <- case (sCaption st, mblabel) of - (Just ils, Nothing) -> return $ toList ils + (Just ils, Nothing) -> return $ Caption Nothing (mcap ils) (Just ils, Just lab) -> do num <- getNextNumber sLastTableNum setState @@ -2411,11 +2409,14 @@ addTableCaption = walkM go , sLabels = M.insert lab [Str (renderDottedNum num)] (sLabels st) } - return $ toList ils -- add number?? + return $ Caption Nothing (mcap ils) -- add number?? (Nothing, _) -> return c return $ maybe id (\ident -> Div (ident, [], []) . (:[])) mblabel $ - Table capt als ws hs rs + Table attr capt spec rhs th tb tf go x = return x + mcap ils + | isNull ils = [] + | otherwise = [Para $ toList ils] block :: PandocMonad m => LP m Blocks diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs index c14cbea52..50dbb5992 100644 --- a/src/Text/Pandoc/Readers/Man.hs +++ b/src/Text/Pandoc/Readers/Man.hs @@ -107,9 +107,9 @@ parseTable = do bodyRows <- mapM (mapM parseTableCell . snd) bodyRows' isPlainTable <- tableCellsPlain <$> getState let widths = if isPlainTable - then repeat 0.0 - else repeat ((1.0 / fromIntegral (length alignments)) - :: Double) + then repeat Nothing + else repeat (Just (1.0 / fromIntegral (length alignments)) + :: Maybe Double) return $ B.table mempty (zip alignments widths) headerRow bodyRows) <|> fallback pos [] -> fallback pos @@ -160,7 +160,6 @@ parseTable = do 'r' -> Just AlignRight _ -> Nothing - parseNewParagraph :: PandocMonad m => ManParser m Blocks parseNewParagraph = do mmacro "P" <|> mmacro "PP" <|> mmacro "LP" <|> memptyLine diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 66f4df341..54d2752c7 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1417,11 +1417,14 @@ table = try $ do let widths' = if totalWidth < 1 then widths else map (/ totalWidth) widths + let strictPos w + | w > 0 = Just w + | otherwise = Nothing return $ do caption' <- caption heads' <- heads lns' <- lns - return $ B.table caption' (zip aligns widths') heads' lns' + return $ B.table caption' (zip aligns (strictPos <$> widths')) heads' lns' -- -- inline diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index a2ff51379..5e9aecc49 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -221,9 +221,9 @@ table = do let restwidth = tableWidth - sum widths let zerocols = length $ filter (==0.0) widths let defaultwidth = if zerocols == 0 || zerocols == length widths - then 0.0 - else restwidth / fromIntegral zerocols - let widths' = map (\w -> if w == 0 then defaultwidth else w) widths + then Nothing + else Just $ restwidth / fromIntegral zerocols + let widths' = map (\w -> if w == 0 then defaultwidth else Just w) widths let cellspecs = zip (map fst cellspecs') widths' rows' <- many $ try $ rowsep *> (map snd <$> tableRow) optional blanklines diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index a5def2479..1cabfa112 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -646,7 +646,7 @@ data MuseTableElement = MuseHeaderRow [Blocks] museToPandocTable :: MuseTable -> Blocks museToPandocTable (MuseTable caption headers body footers) = B.table caption attrs headRow (rows ++ body ++ footers) - where attrs = (AlignDefault, 0.0) <$ transpose (headers ++ body ++ footers) + where attrs = (AlignDefault, Nothing) <$ transpose (headers ++ body ++ footers) (headRow, rows) = fromMaybe ([], []) $ uncons headers museAppendElement :: MuseTableElement @@ -694,7 +694,7 @@ museGridTable = try $ do indices <- museGridTableHeader fmap rowsToTable . sequence <$> many1 (museGridTableRow indent indices) where rowsToTable rows = B.table mempty attrs [] rows - where attrs = (AlignDefault, 0.0) <$ transpose rows + where attrs = (AlignDefault, Nothing) <$ transpose rows -- | Parse a table. table :: PandocMonad m => MuseParser m (F Blocks) diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 69c8e2924..2afd8a66d 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -921,8 +921,8 @@ post_process (Pandoc m blocks) = Pandoc m (post_process' blocks) post_process' :: [Block] -> [Block] -post_process' (Table _ a w h r : Div ("", ["caption"], _) [Para inlines] : xs) = - Table inlines a w h r : post_process' xs +post_process' (Table attr _ specs rhs th tb tf : Div ("", ["caption"], _) blks : xs) + = Table attr (Caption Nothing blks) specs rhs th tb tf : post_process' xs post_process' bs = bs read_body :: OdtReader _x (Pandoc, MediaBag) diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index c80c179c6..aef6ae210 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -629,13 +629,13 @@ orgToPandocTable (OrgTable colProps heads lns) caption = else Nothing in B.table caption (map (convertColProp totalWidth) colProps) heads lns where - convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, Double) + convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, Maybe Double) convertColProp totalWidth colProp = let align' = fromMaybe AlignDefault $ columnAlignment colProp - width' = fromMaybe 0 $ (\w t -> (fromIntegral w / fromIntegral t)) - <$> columnRelWidth colProp - <*> totalWidth + width' = (\w t -> (fromIntegral w / fromIntegral t)) + <$> columnRelWidth colProp + <*> totalWidth in (align', width') tableRows :: PandocMonad m => OrgParser m [OrgTableRow] @@ -658,16 +658,16 @@ tableAlignRow = try $ do return $ OrgAlignRow colProps columnPropertyCell :: Monad m => OrgParser m ColumnProperty -columnPropertyCell = emptyCell <|> propCell <?> "alignment info" +columnPropertyCell = emptyOrgCell <|> propCell <?> "alignment info" where - emptyCell = ColumnProperty Nothing Nothing <$ try (skipSpaces *> endOfCell) + emptyOrgCell = ColumnProperty Nothing Nothing <$ try (skipSpaces *> endOfCell) propCell = try $ ColumnProperty <$> (skipSpaces *> char '<' *> optionMaybe tableAlignFromChar) <*> (optionMaybe (many1Char digit >>= safeRead) <* char '>' - <* emptyCell) + <* emptyOrgCell) tableAlignFromChar :: Monad m => OrgParser m Alignment tableAlignFromChar = try $ diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 430d24f4a..5db303d4d 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -770,24 +770,37 @@ tableDirective :: PandocMonad m tableDirective top fields body = do bs <- parseFromString' parseBlocks body case B.toList bs of - [Table _ aligns' widths' header' rows'] -> do + [Table attr _ tspecs' rhs thead tbody tfoot] -> do + let (aligns', widths') = unzip tspecs' title <- parseFromString' (trimInlines . mconcat <$> many inline) top columns <- getOption readerColumns - let numOfCols = length header' + let numOfCols = case thead of + [] -> 0 + (r:_) -> rowLength r let normWidths ws = - map (/ max 1.0 (fromIntegral (columns - numOfCols))) ws + strictPos . (/ max 1.0 (fromIntegral (columns - numOfCols))) <$> ws let widths = case trim <$> lookup "widths" fields of - Just "auto" -> replicate numOfCols 0.0 + Just "auto" -> replicate numOfCols Nothing Just "grid" -> widths' Just specs -> normWidths $ map (fromMaybe (0 :: Double) . safeRead) $ splitTextBy (`elem` (" ," :: String)) specs Nothing -> widths' -- align is not applicable since we can't represent whole table align - return $ B.singleton $ Table (B.toList title) - aligns' widths header' rows' + let tspecs = zip aligns' widths + return $ B.singleton $ Table attr (Caption Nothing (mpara title)) + tspecs rhs thead tbody tfoot _ -> return mempty - + where + -- only valid on the very first row of a table section + rowLength (Row _ rb) = sum $ cellLength <$> rb + cellLength (Cell _ _ _ w _) = if w < 0 then 0 else w + strictPos w + | w > 0 = Just w + | otherwise = Nothing + mpara t + | B.isNull t = [] + | otherwise = [Para $ B.toList t] -- TODO: :stub-columns:. -- Only the first row becomes the header even if header-rows: > 1, @@ -808,10 +821,10 @@ listTableDirective top fields body = do else ([], rows, length x) _ -> ([],[],0) widths = case trim <$> lookup "widths" fields of - Just "auto" -> replicate numOfCols 0 + Just "auto" -> replicate numOfCols Nothing Just specs -> normWidths $ map (fromMaybe (0 :: Double) . safeRead) $ splitTextBy (`elem` (" ," :: String)) specs - _ -> replicate numOfCols 0 + _ -> replicate numOfCols Nothing return $ B.table title (zip (replicate numOfCols AlignDefault) widths) headerRow @@ -820,7 +833,10 @@ listTableDirective top fields body = do takeRows _ = [] takeCells [BulletList cells] = map B.fromList cells takeCells _ = [] - normWidths ws = map (/ max 1 (sum ws)) ws + normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws + strictPos w + | w > 0 = Just w + | otherwise = Nothing csvTableDirective :: PandocMonad m => Text -> [(Text, Text)] -> Text @@ -873,14 +889,17 @@ csvTableDirective top fields rawcsv = do else ([], rows, length x) _ -> ([],[],0) title <- parseFromString' (trimInlines . mconcat <$> many inline) top - let normWidths ws = map (/ max 1 (sum ws)) ws + let strictPos w + | w > 0 = Just w + | otherwise = Nothing + let normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws let widths = case trim <$> lookup "widths" fields of - Just "auto" -> replicate numOfCols 0 + Just "auto" -> replicate numOfCols Nothing Just specs -> normWidths $ map (fromMaybe (0 :: Double) . safeRead) $ splitTextBy (`elem` (" ," :: String)) specs - _ -> replicate numOfCols 0 + _ -> replicate numOfCols Nothing return $ B.table title (zip (replicate numOfCols AlignDefault) widths) headerRow @@ -1293,13 +1312,14 @@ simpleTable headless = do sep simpleTableFooter -- Simple tables get 0s for relative column widths (i.e., use default) case B.toList tbl of - [Table c a _w h l] -> return $ B.singleton $ - Table c a (replicate (length a) 0) h l + [Table attr cap spec rhs th tb tf] -> return $ B.singleton $ + Table attr cap (rewidth spec) rhs th tb tf _ -> throwError $ PandocShouldNeverHappenError "tableWith returned something unexpected" where sep = return () -- optional (simpleTableSep '-') + rewidth = fmap $ fmap $ const Nothing gridTable :: PandocMonad m => Bool -- ^ Headerless table diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index ee6a80ce3..f14e3f710 100644 --- a/src/Text/Pandoc/Readers/TWiki.hs +++ b/src/Text/Pandoc/Readers/TWiki.hs @@ -229,11 +229,11 @@ table = try $ do where buildTable caption rows (aligns, heads) = B.table caption aligns heads rows - align rows = replicate (columCount rows) (AlignDefault, 0) + align rows = replicate (columCount rows) (AlignDefault, Nothing) columns rows = replicate (columCount rows) mempty columCount rows = length $ head rows -tableParseHeader :: PandocMonad m => TWParser m ((Alignment, Double), B.Blocks) +tableParseHeader :: PandocMonad m => TWParser m ((Alignment, Maybe Double), B.Blocks) tableParseHeader = try $ do char '|' leftSpaces <- length <$> many spaceChar @@ -245,9 +245,9 @@ tableParseHeader = try $ do return (tableAlign leftSpaces rightSpaces, content) where tableAlign left right - | left >= 2 && left == right = (AlignCenter, 0) - | left > right = (AlignRight, 0) - | otherwise = (AlignLeft, 0) + | left >= 2 && left == right = (AlignCenter, Nothing) + | left > right = (AlignRight, Nothing) + | otherwise = (AlignLeft, Nothing) tableParseRow :: PandocMonad m => TWParser m [B.Blocks] tableParseRow = many1Till tableParseColumn newline diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 5aae11751..3d2a962e9 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -378,7 +378,7 @@ table = try $ do let nbOfCols = maximum $ map length (headers:rows) let aligns = map minimum $ transpose $ map (map (snd . fst)) (headers:rows) return $ B.table caption - (zip aligns (replicate nbOfCols 0.0)) + (zip aligns (replicate nbOfCols Nothing)) (map snd headers) (map (map snd) rows) diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 68ba6dd7a..5d2f11864 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -268,7 +268,7 @@ table = try $ do let rowsPadded = map (pad size) rows' let headerPadded = if null tableHeader then mempty else pad size tableHeader return $ B.table mempty - (zip aligns (replicate ncolumns 0.0)) + (zip aligns (replicate ncolumns Nothing)) headerPadded rowsPadded pad :: (Monoid a) => Int -> [a] -> [a] |