Implement the new Table type

author: despresc <christian.j.j.despres@gmail.com> 2020-03-28 18:22:48 -0400
committer: despresc <christian.j.j.despres@gmail.com> 2020-04-15 23:03:22 -0400
commit: 7254a2ae0ba40b29c04b8924f27739614229432b (patch)
tree: 114e3143953451e3212511e7bf2e178548d3e1bd /src/Text/Pandoc/Readers
parent: 83c1ce1d77d3ef058e4e5c645a8eb0379fab780f (diff)
download: pandoc-7254a2ae0ba40b29c04b8924f27739614229432b.tar.gz
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]
author	despresc <christian.j.j.despres@gmail.com>	2020-03-28 18:22:48 -0400
committer	despresc <christian.j.j.despres@gmail.com>	2020-04-15 23:03:22 -0400
commit	7254a2ae0ba40b29c04b8924f27739614229432b (patch)
tree	114e3143953451e3212511e7bf2e178548d3e1bd /src/Text/Pandoc/Readers
parent	83c1ce1d77d3ef058e4e5c645a8eb0379fab780f (diff)
download	pandoc-7254a2ae0ba40b29c04b8924f27739614229432b.tar.gz