diff options
| author | despresc <christian.j.j.despres@gmail.com> | 2020-04-04 16:35:42 -0400 | 
|---|---|---|
| committer | despresc <christian.j.j.despres@gmail.com> | 2020-04-15 23:03:22 -0400 | 
| commit | 4e34d366df31937cdc69b6b366355f10a84c16b2 (patch) | |
| tree | 844503b0f59439acaec5d2f8e2f016e2eb1d214c /src/Text/Pandoc | |
| parent | f8ce38975b547fe7fc8c12ccee3a940b35d8b9cf (diff) | |
| download | pandoc-4e34d366df31937cdc69b6b366355f10a84c16b2.tar.gz | |
Adapt to the newest Table type, fix some previous adaptation issues
- Writers.Native is now adapted to the new Table type.
- Inline captions should now be conditionally wrapped in a Plain, not
  a Para block.
- The toLegacyTable function now lives in Writers.Shared.
Diffstat (limited to 'src/Text/Pandoc')
54 files changed, 210 insertions, 168 deletions
| diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index db9f097ef..f314649f0 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -21,7 +21,7 @@ import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)  import Text.Pandoc.Definition  import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)  import Text.Pandoc.Lua.Marshaling.CommonState () -import Text.Pandoc.Shared (toLegacyTable) +import Text.Pandoc.Writers.Shared (toLegacyTable)  import qualified Foreign.Lua as Lua  import qualified Text.Pandoc.Lua.Util as LuaUtil @@ -168,7 +168,7 @@ pushBlock = \case    Para blcks               -> pushViaConstructor "Para" blcks    Plain blcks              -> pushViaConstructor "Plain" blcks    RawBlock f cs            -> pushViaConstructor "RawBlock" f cs -  Table _ blkCapt specs _ thead tbody tfoot -> +  Table _ blkCapt specs thead tbody tfoot ->      let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot      in pushViaConstructor "Table" capt aligns widths headers rows @@ -195,12 +195,11 @@ peekBlock idx = defineHowTo "get Block value" $ do        "RawBlock"       -> uncurry RawBlock <$> elementContent        "Table"          -> (\(capt, aligns, widths, headers, body) ->                                Table nullAttr -                                    (Caption Nothing $ maybePara capt) +                                    (Caption Nothing $ maybePlain capt)                                      (zip aligns (map strictPos widths)) -                                    0 -                                    [toRow headers] -                                    (map toRow body) -                                    []) +                                    (TableHead nullAttr [toRow headers]) +                                    [TableBody nullAttr 0 [] (map toRow body)] +                                    (TableFoot nullAttr []))                            <$> elementContent        _ -> Lua.throwException ("Unknown block type: " <> tag)   where @@ -208,10 +207,10 @@ peekBlock idx = defineHowTo "get Block value" $ do     elementContent :: Peekable a => Lua a     elementContent = LuaUtil.rawField idx "c" -   strictPos w = if w > 0 then Just w else Nothing -   maybePara [] = [] -   maybePara x  = [Para x] -   toRow = Row nullAttr . map (\blk -> Cell nullAttr Nothing 1 1 blk) +   strictPos w = if w > 0 then ColWidth w else ColWidthDefault +   maybePlain [] = [] +   maybePlain x  = [Plain x] +   toRow = Row nullAttr . map (\blk -> Cell nullAttr AlignDefault 1 1 blk)  -- | Push an inline element to the top of the lua stack.  pushInline :: Inline -> Lua () diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs index 5b62001de..695c7b44e 100644 --- a/src/Text/Pandoc/Lua/Walk.hs +++ b/src/Text/Pandoc/Lua/Walk.hs @@ -59,6 +59,18 @@ instance Walkable (SingletonsList Inline) Row where    walkM = walkRowM    query = queryRow +instance Walkable (SingletonsList Inline) TableHead where +  walkM = walkTableHeadM +  query = queryTableHead + +instance Walkable (SingletonsList Inline) TableBody where +  walkM = walkTableBodyM +  query = queryTableBody + +instance Walkable (SingletonsList Inline) TableFoot where +  walkM = walkTableFootM +  query = queryTableFoot +  instance Walkable (SingletonsList Inline) Caption where    walkM = walkCaptionM    query = queryCaption @@ -102,6 +114,18 @@ instance Walkable (SingletonsList Block) Row where    walkM = walkRowM    query = queryRow +instance Walkable (SingletonsList Block) TableHead where +  walkM = walkTableHeadM +  query = queryTableHead + +instance Walkable (SingletonsList Block) TableBody where +  walkM = walkTableBodyM +  query = queryTableBody + +instance Walkable (SingletonsList Block) TableFoot where +  walkM = walkTableFootM +  query = queryTableFoot +  instance Walkable (SingletonsList Block) Caption where    walkM = walkCaptionM    query = queryCaption diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index aa961e814..f17a9af1d 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -928,8 +928,8 @@ tableWith headerParser rowParser lineParser footerParser = try $ do    return $ B.table mempty (zip aligns (map fromWidth widths)) <$> heads <*> rows    where      fromWidth n -      | n > 0     = Just n -      | otherwise = Nothing +      | n > 0     = ColWidth n +      | otherwise = ColWidthDefault  type TableComponents mf = ([Alignment], [Double], mf [Blocks], mf [[Blocks]]) diff --git a/src/Text/Pandoc/Readers/CSV.hs b/src/Text/Pandoc/Readers/CSV.hs index 8608a1a2c..a1272d47f 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 Nothing +             widths = replicate numcols ColWidthDefault      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 33afbe59f..d1f732bf1 100644 --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -111,13 +111,19 @@ addBlock opts (Node _ (LIST listAttrs) nodes) =                       PAREN_DELIM  -> OneParen          exts = readerExtensions opts  addBlock opts (Node _ (TABLE alignments) nodes) = -  (Table nullAttr (Caption Nothing []) (zip aligns widths) 0 headers rows [] :) +  (Table +    nullAttr +    (Caption Nothing []) +    (zip aligns widths) +    (TableHead nullAttr headers) +    [TableBody nullAttr 0 [] rows] +    (TableFoot nullAttr []) :)    where aligns = map fromTableCellAlignment alignments          fromTableCellAlignment NoAlignment   = AlignDefault          fromTableCellAlignment LeftAligned   = AlignLeft          fromTableCellAlignment RightAligned  = AlignRight          fromTableCellAlignment CenterAligned = AlignCenter -        widths = replicate numcols Nothing +        widths = replicate numcols ColWidthDefault          numcols = if null rows'                       then 0                       else maximum $ map rowLength rows' @@ -136,7 +142,7 @@ addBlock opts (Node _ (TABLE alignments) nodes) =            | 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 +        fromSimpleCell = Cell nullAttr AlignDefault 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 diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 6c56c1bd7..4001d647e 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -881,12 +881,12 @@ parseBlock (Elem e) =                                       [] -> replicate numrows AlignDefault                                       cs -> map toAlignment cs                        let widths = case colspecs of -                                     [] -> replicate numrows Nothing +                                     [] -> replicate numrows ColWidthDefault                                       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 +                                                            in  ColWidth . (/ tot) <$> ws' +                                                Nothing  -> replicate numrows ColWidthDefault                        let headrows' = if null headrows                                           then replicate numrows mempty                                           else headrows diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index a5e8cb463..69aa18f73 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -676,7 +676,7 @@ 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 Nothing +      widths = replicate width ColWidthDefault    return $ table cap' (zip alignments widths) hdrCells cells'  bodyPartToBlocks (OMathPara e) = diff --git a/src/Text/Pandoc/Readers/DokuWiki.hs b/src/Text/Pandoc/Readers/DokuWiki.hs index 296c751a2..ee26eed84 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, Nothing) <$ transpose rows +  let attrs = (AlignDefault, ColWidthDefault) <$ 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 8de9ebc19..30b812913 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -513,12 +513,12 @@ pTable = try $ do                      _      -> replicate cols AlignDefault    let widths = if null widths'                    then if isSimple -                       then replicate cols Nothing -                       else replicate cols (Just (1.0 / fromIntegral cols)) +                       then replicate cols ColWidthDefault +                       else replicate cols (ColWidth (1.0 / fromIntegral cols))                    else widths'    return $ B.table caption (zip aligns widths) head' rows -pCol :: PandocMonad m => TagParser m (Maybe Double) +pCol :: PandocMonad m => TagParser m ColWidth  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 $ Just $ width / 100.0 -    else return Nothing +    then return $ ColWidth $ width / 100.0 +    else return ColWidthDefault -pColgroup :: PandocMonad m => TagParser m [Maybe Double] +pColgroup :: PandocMonad m => TagParser m [ColWidth]  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 7303f9c32..5bef6f9fd 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, Nothing) +                             (AlignDefault, ColWidthDefault)           in  B.table mempty colspecs header body    where inlineFallback = B.plain $ docHToInlines False d' diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs index 3dfe9161b..24d2ef4a1 100644 --- a/src/Text/Pandoc/Readers/JATS.hs +++ b/src/Text/Pandoc/Readers/JATS.hs @@ -274,12 +274,12 @@ parseBlock (Elem e) =                                       [] -> replicate numrows AlignDefault                                       cs -> map toAlignment cs                        let widths = case colspecs of -                                     [] -> replicate numrows Nothing +                                     [] -> replicate numrows ColWidthDefault                                       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 +                                                            in  ColWidth . (/ tot) <$> ws' +                                                Nothing  -> replicate numrows ColWidthDefault                        let headrows' = if null headrows                                           then replicate numrows mempty                                           else headrows diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 4b09f1402..ea5549543 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, Maybe Double, ([Tok], [Tok]))] +parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]  parseAligns = try $ do    let maybeBar = skipMany          (try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced))) @@ -2319,7 +2319,11 @@ parseAligns = try $ do    spaces    egroup    spaces -  return aligns' +  return $ map toSpec aligns' +  where +    toColWidth (Just w) | w > 0 = ColWidth w +    toColWidth _                = ColWidthDefault +    toSpec (x, y, z) = (x, toColWidth y, z)  parseTableRow :: PandocMonad m                => Text   -- ^ table environment name @@ -2397,11 +2401,11 @@ simpTable envname hasWidthParameter = try $ do  addTableCaption :: PandocMonad m => Blocks -> LP m Blocks  addTableCaption = walkM go -  where go (Table attr c spec rhs th tb tf) = do +  where go (Table attr c spec th tb tf) = do            st <- getState            let mblabel = sLastLabel st            capt <- case (sCaption st, mblabel) of -                   (Just ils, Nothing)  -> return $ Caption Nothing (mcap ils) +                   (Just ils, Nothing)  -> return $ caption Nothing (plain ils)                     (Just ils, Just lab) -> do                       num <- getNextNumber sLastTableNum                       setState @@ -2409,15 +2413,11 @@ addTableCaption = walkM go                           , sLabels = M.insert lab                                      [Str (renderDottedNum num)]                                      (sLabels st) } -                     return $ Caption Nothing (mcap ils) -- add number?? +                     return $ caption Nothing (plain ils) -- add number??                     (Nothing, _)  -> return c            return $ maybe id (\ident -> Div (ident, [], []) . (:[])) mblabel $ -                     Table attr capt spec rhs th tb tf +                     Table attr capt spec th tb tf          go x = return x -        mcap ils -          | isNull ils = [] -          | otherwise  = [Para $ toList ils] -  block :: PandocMonad m => LP m Blocks  block = do diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs index 50dbb5992..e175135da 100644 --- a/src/Text/Pandoc/Readers/Man.hs +++ b/src/Text/Pandoc/Readers/Man.hs @@ -107,9 +107,8 @@ parseTable = do        bodyRows <- mapM (mapM parseTableCell . snd) bodyRows'        isPlainTable <- tableCellsPlain <$> getState        let widths = if isPlainTable -                      then repeat Nothing -                      else repeat (Just (1.0 / fromIntegral (length alignments)) -                                   :: Maybe Double) +                      then repeat ColWidthDefault +                      else repeat $ ColWidth (1.0 / fromIntegral (length alignments))        return $ B.table mempty (zip alignments widths)                    headerRow bodyRows) <|> fallback pos      [] -> fallback pos diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 54d2752c7..222c227e2 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1418,8 +1418,8 @@ table = try $ do                     then widths                     else map (/ totalWidth) widths    let strictPos w -        | w > 0     = Just w -        | otherwise = Nothing +        | w > 0     = ColWidth w +        | otherwise = ColWidthDefault    return $ do      caption' <- caption      heads' <- heads diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index 5e9aecc49..0396c95de 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 Nothing -                        else Just $ restwidth / fromIntegral zerocols -  let widths' = map (\w -> if w == 0 then defaultwidth else Just w) widths +                        then ColWidthDefault +                        else ColWidth $ restwidth / fromIntegral zerocols +  let widths' = map (\w -> if w > 0 then ColWidth w else defaultwidth) 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 1cabfa112..34a9a7367 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, Nothing) <$ transpose (headers ++ body ++ footers) +  where attrs = (AlignDefault, ColWidthDefault) <$ 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, Nothing) <$ transpose rows +                           where attrs = (AlignDefault, ColWidthDefault) <$ 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 2afd8a66d..cbf7236d0 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 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' (Table attr _ specs th tb tf : Div ("", ["caption"], _) blks : xs) +  = Table attr (Caption Nothing blks) specs 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 aef6ae210..5dbaa2a17 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -629,14 +629,14 @@ orgToPandocTable (OrgTable colProps heads lns) caption =                     else Nothing    in B.table caption (map (convertColProp totalWidth) colProps) heads lns   where -   convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, Maybe Double) +   convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, ColWidth)     convertColProp totalWidth colProp =       let         align' = fromMaybe AlignDefault $ columnAlignment colProp         width' = (\w t -> (fromIntegral w / fromIntegral t))                  <$> columnRelWidth colProp                  <*> totalWidth -     in (align', width') +     in (align', maybe ColWidthDefault ColWidth width')  tableRows :: PandocMonad m => OrgParser m [OrgTableRow]  tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow) diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 5db303d4d..0dadd5120 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -770,17 +770,17 @@ tableDirective :: PandocMonad m  tableDirective top fields body = do    bs <- parseFromString' parseBlocks body    case B.toList bs of -       [Table attr _ tspecs' rhs thead tbody tfoot] -> do +       [Table attr _ tspecs' thead@(TableHead _ thrs) tbody tfoot] -> do           let (aligns', widths') = unzip tspecs'           title <- parseFromString' (trimInlines . mconcat <$> many inline) top           columns <- getOption readerColumns -         let numOfCols = case thead of +         let numOfCols = case thrs of                 [] -> 0                 (r:_) -> rowLength r           let normWidths ws =                  strictPos . (/ max 1.0 (fromIntegral (columns - numOfCols))) <$> ws           let widths = case trim <$> lookup "widths" fields of -                           Just "auto" -> replicate numOfCols Nothing +                           Just "auto" -> replicate numOfCols ColWidthDefault                             Just "grid" -> widths'                             Just specs -> normWidths                                 $ map (fromMaybe (0 :: Double) . safeRead) @@ -788,19 +788,16 @@ tableDirective top fields body = do                             Nothing -> widths'           -- align is not applicable since we can't represent whole table align           let tspecs = zip aligns' widths -         return $ B.singleton $ Table attr (Caption Nothing (mpara title)) -                                  tspecs rhs thead tbody tfoot +         return $ B.singleton $ Table attr (B.caption Nothing (B.plain title)) +                                  tspecs 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 +    cellLength (Cell _ _ _ w _) = max 1 (getColSpan w)      strictPos w -      | w > 0     = Just w -      | otherwise = Nothing -    mpara t -      | B.isNull t  = [] -      | otherwise = [Para $ B.toList t] +      | w > 0     = ColWidth w +      | otherwise = ColWidthDefault  -- TODO: :stub-columns:.  -- Only the first row becomes the header even if header-rows: > 1, @@ -821,10 +818,10 @@ listTableDirective top fields body = do                     else ([], rows, length x)          _ -> ([],[],0)        widths = case trim <$> lookup "widths" fields of -        Just "auto" -> replicate numOfCols Nothing +        Just "auto" -> replicate numOfCols ColWidthDefault          Just specs -> normWidths $ map (fromMaybe (0 :: Double) . safeRead) $                             splitTextBy (`elem` (" ," :: String)) specs -        _ -> replicate numOfCols Nothing +        _ -> replicate numOfCols ColWidthDefault    return $ B.table title               (zip (replicate numOfCols AlignDefault) widths)               headerRow @@ -835,8 +832,8 @@ listTableDirective top fields body = do            takeCells _                  = []            normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws            strictPos w -            | w > 0     = Just w -            | otherwise = Nothing +            | w > 0     = ColWidth w +            | otherwise = ColWidthDefault  csvTableDirective :: PandocMonad m                     => Text -> [(Text, Text)] -> Text @@ -890,16 +887,16 @@ csvTableDirective top fields rawcsv = do                     _ -> ([],[],0)           title <- parseFromString' (trimInlines . mconcat <$> many inline) top           let strictPos w -               | w > 0     = Just w -               | otherwise = Nothing +               | w > 0     = ColWidth w +               | otherwise = ColWidthDefault           let normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws           let widths =                 case trim <$> lookup "widths" fields of -                 Just "auto" -> replicate numOfCols Nothing +                 Just "auto" -> replicate numOfCols ColWidthDefault                   Just specs -> normWidths                                 $ map (fromMaybe (0 :: Double) . safeRead)                                 $ splitTextBy (`elem` (" ," :: String)) specs -                 _ -> replicate numOfCols Nothing +                 _ -> replicate numOfCols ColWidthDefault           return $ B.table title                    (zip (replicate numOfCols AlignDefault) widths)                    headerRow @@ -1312,14 +1309,14 @@ simpleTable headless = do             sep simpleTableFooter    -- Simple tables get 0s for relative column widths (i.e., use default)    case B.toList tbl of -       [Table attr cap spec rhs th tb tf] -> return $ B.singleton $ -                                                Table attr cap (rewidth spec) rhs th tb tf +       [Table attr cap spec th tb tf] -> return $ B.singleton $ +                                         Table attr cap (rewidth spec) th tb tf         _ ->           throwError $ PandocShouldNeverHappenError              "tableWith returned something unexpected"   where    sep = return () -- optional (simpleTableSep '-') -  rewidth = fmap $ fmap $ const Nothing +  rewidth = fmap $ fmap $ const ColWidthDefault  gridTable :: PandocMonad m            => Bool -- ^ Headerless table diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index f14e3f710..b39e3303e 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, Nothing) +    align rows      = replicate (columCount rows) (AlignDefault, ColWidthDefault)      columns rows    = replicate (columCount rows) mempty      columCount rows = length $ head rows -tableParseHeader :: PandocMonad m => TWParser m ((Alignment, Maybe Double), B.Blocks) +tableParseHeader :: PandocMonad m => TWParser m ((Alignment, ColWidth), 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, Nothing) -      | left > right = (AlignRight, Nothing) -      | otherwise = (AlignLeft, Nothing) +      | left >= 2 && left == right = (AlignCenter, ColWidthDefault) +      | left > right = (AlignRight, ColWidthDefault) +      | otherwise = (AlignLeft, ColWidthDefault)  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 3d2a962e9..a0680ac81 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 Nothing)) +    (zip aligns (replicate nbOfCols ColWidthDefault))      (map snd headers)      (map (map snd) rows) diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 5d2f11864..fc1c8c5cf 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 Nothing)) +                    (zip aligns (replicate ncolumns ColWidthDefault))                        headerPadded rowsPadded  pad :: (Monoid a) => Int -> [a] -> [a] diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 0418aa6e2..4a60866af 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -77,7 +77,6 @@ module Text.Pandoc.Shared (                       htmlSpanLikeElements,                       splitSentences,                       filterIpynbOutput, -                     toLegacyTable,                       -- * TagSoup HTML handling                       renderTags',                       -- * File handling @@ -993,12 +992,14 @@ blockToInlines (DefinitionList pairslst) =        mconcat (map blocksToInlines' blkslst)  blockToInlines (Header _ _  ils) = B.fromList ils  blockToInlines HorizontalRule = mempty -blockToInlines (Table _ _ _ _ headers rows feet) = +blockToInlines (Table _ _ _ (TableHead _ hbd) bodies (TableFoot _ fbd)) =    mconcat $ intersperse B.linebreak $ -    map (mconcat . map blocksToInlines') (plainRowBody <$> headers <> rows <> feet) +    map (mconcat . map blocksToInlines') (plainRowBody <$> hbd <> unTableBodies bodies <> fbd)    where      plainRowBody (Row _ body) = cellBody <$> body      cellBody (Cell _ _ _ _ body) = body +    unTableBody (TableBody _ _ hd bd) = hd <> bd +    unTableBodies = concatMap unTableBody  blockToInlines (Div _ blks) = blocksToInlines' blks  blockToInlines Null = mempty @@ -1012,30 +1013,6 @@ blocksToInlines' = blocksToInlinesWithSep defaultBlocksSeparator  blocksToInlines :: [Block] -> [Inline]  blocksToInlines = B.toList . blocksToInlines' --- | Convert the relevant components of a new-style table (with block --- caption, row headers, row and column spans, and so on) to those of --- an old-style table (inline caption, table head with one row, no --- foot, and so on). -toLegacyTable :: Caption -              -> [ColSpec] -              -> TableHead -              -> TableBody -              -> TableFoot -              -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]]) -toLegacyTable (Caption _ cbody) specs th tb tf = (cbody', aligns, widths, th', tb') -  where -    numcols = length specs -    (aligns, mwidths) = unzip specs -    widths = map (fromMaybe 0) mwidths -    unRow (Row _ x) = map unCell x -    unCell (Cell _ _ _ _ x) = x -    cbody' = blocksToInlines cbody -    sanitise = pad mempty numcols . unRow -    pad element upTo list = take upTo (list ++ repeat element) -    (th', tb') = case th of -      (r:rs) -> (sanitise r, map sanitise $ rs <> tb <> tf) -      []     -> ([], map sanitise $ tb <> tf) -  -- | Inline elements used to separate blocks when squashing blocks into  -- inlines.  defaultBlocksSeparator :: Inlines diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index b9d93188a..e0ee830de 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -191,7 +191,7 @@ blockToAsciiDoc opts (BlockQuote blocks) = do                       else contents    let bar = text "____"    return $ bar $$ chomp contents' $$ bar <> blankline -blockToAsciiDoc opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToAsciiDoc opts (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    caption' <- inlineListToAsciiDoc opts caption    let caption'' = if null caption diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index bd798ee73..bab74c77c 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -27,7 +27,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad)  import Text.Pandoc.Definition  import Text.Pandoc.Options  import Text.Pandoc.Shared (capitalize, isTightList, -    linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow, toLegacyTable) +    linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow)  import Text.Pandoc.Templates (renderTemplate)  import Text.Pandoc.Walk (walk, walkM)  import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes) @@ -154,7 +154,7 @@ blockToNodes opts (DefinitionList items) ns =            Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs          dlToBullet (term, xs) =            Para term : concat xs -blockToNodes opts t@(Table _ blkCapt specs _ thead tbody tfoot) ns = +blockToNodes opts t@(Table _ blkCapt specs thead tbody tfoot) ns =    let (capt, aligns, _widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    in if isEnabled Ext_pipe_tables opts && onlySimpleTableCells (headers : rows)          then do diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index f3d7219d1..6066f9bb2 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -255,7 +255,7 @@ blockToConTeXt (DefinitionList lst) =  blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline  -- If this is ever executed, provide a default for the reference identifier.  blockToConTeXt (Header level attr lst) = sectionHeader attr level lst -blockToConTeXt (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToConTeXt (Table _ blkCapt specs thead tbody tfoot) = do      let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot      opts <- gets stOptions      let tabl = if isEnabled Ext_ntb opts diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index beb2301c9..2be64d56f 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -29,7 +29,6 @@ import Text.Pandoc.Lua (Global (..), LuaException (LuaException),                          runLua, setGlobals)  import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)  import Text.Pandoc.Options -import Text.Pandoc.Shared (toLegacyTable)  import Text.Pandoc.Templates (renderTemplate)  import qualified Text.Pandoc.UTF8 as UTF8  import Text.Pandoc.Writers.Shared @@ -150,7 +149,7 @@ blockToCustom (CodeBlock attr str) =  blockToCustom (BlockQuote blocks) =    Lua.callFunc "BlockQuote" (Stringify blocks) -blockToCustom (Table _ blkCapt specs _ thead tbody tfoot) = +blockToCustom (Table _ blkCapt specs thead tbody tfoot) =    let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot        aligns' = map show aligns        capt' = Stringify capt diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 7af357fb0..ba468cf4f 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -263,7 +263,7 @@ blockToDocbook _ b@(RawBlock f str)        report $ BlockNotRendered b        return empty  blockToDocbook _ HorizontalRule = return empty -- not semantic -blockToDocbook opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToDocbook opts (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    captionDoc <- if null caption                     then return empty diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index f9e173bb2..2caba59cc 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -970,7 +970,7 @@ blockToOpenXML' _ HorizontalRule = do      $ mknode "v:rect" [("style","width:0;height:1.5pt"),                         ("o:hralign","center"),                         ("o:hrstd","t"),("o:hr","t")] () ] -blockToOpenXML' opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToOpenXML' opts (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    setFirstPara    modify $ \s -> s { stInTable = True } diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index ce99aaa9d..b01d9a7bb 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -35,10 +35,10 @@ import Text.Pandoc.ImageSize  import Text.Pandoc.Logging  import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText))  import Text.Pandoc.Shared (camelCaseToHyphenated, escapeURI, isURI, linesToPara, -                           removeFormatting, trimr, tshow, toLegacyTable) +                           removeFormatting, trimr, tshow)  import Text.Pandoc.Templates (renderTemplate)  import Text.DocLayout (render, literal) -import Text.Pandoc.Writers.Shared (defField, metaToContext) +import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)  data WriterState = WriterState {    } @@ -166,7 +166,7 @@ blockToDokuWiki opts (BlockQuote blocks) = do       then return $ T.unlines $ map ("> " <>) $ T.lines contents       else return $ "<HTML><blockquote>\n" <> contents <> "</blockquote></HTML>" -blockToDokuWiki opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToDokuWiki opts (Table _ blkCapt specs thead tbody tfoot) = do    let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    captionDoc <- if null capt                     then return "" diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 5b62119a3..83bcf2038 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -40,8 +40,8 @@ import Text.Pandoc.Definition  import Text.Pandoc.Logging  import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)  import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, -                           makeSections, tshow, toLegacyTable) -import Text.Pandoc.Writers.Shared (lookupMetaString) +                           makeSections, tshow) +import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable)  -- | Data to be written at the end of the document:  -- (foot)notes, URLs, references, images. @@ -334,7 +334,7 @@ blockToXml h@Header{} = do    report $ BlockNotRendered h    return []  blockToXml HorizontalRule = return [ el "empty-line" () ] -blockToXml (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToXml (Table _ blkCapt specs thead tbody tfoot) = do      let (caption, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot      hd <- mkrow "th" headers aligns      bd <- mapM (\r -> mkrow "td" r aligns) rows diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 070631f0d..77585e920 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -885,7 +885,7 @@ blockToHtml opts (DefinitionList lst) = do                       return $ mconcat $ nl opts : term' : nl opts :                                          intersperse (nl opts) defs') lst    defList opts contents -blockToHtml opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToHtml opts (Table _ blkCapt specs thead tbody tfoot) = do    let (capt, aligns, widths, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot    captionDoc <- if null capt                     then return mempty diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 57e2f0ea7..925160602 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -115,7 +115,7 @@ blockToHaddock _ (CodeBlock (_,_,_) str) =  -- Nothing in haddock corresponds to block quotes:  blockToHaddock opts (BlockQuote blocks) =    blockListToHaddock opts blocks -blockToHaddock opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToHaddock opts (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    caption' <- inlineListToHaddock opts caption    let caption'' = if null caption diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 5575ab2bb..57066d303 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -321,7 +321,7 @@ blockToICML opts style (Header lvl (_, cls, _) lst) =                     else ""    in parStyle opts stl lst  blockToICML _ _ HorizontalRule = return empty -- we could insert a page break instead -blockToICML opts style (Table _ blkCapt specs _ thead tbody tfoot) = +blockToICML opts style (Table _ blkCapt specs thead tbody tfoot) =    let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot        style' = tableName : style        noHeader  = all null headers diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index f739613b6..47d8c00cf 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -356,7 +356,7 @@ blockToJATS _ b@(RawBlock f str)        report $ BlockNotRendered b        return empty  blockToJATS _ HorizontalRule = return empty -- not semantic -blockToJATS opts (Table _ blkCapt specs _ th tb tf) = +blockToJATS opts (Table _ blkCapt specs th tb tf) =    case toLegacyTable blkCapt specs th tb tf of      ([], aligns, widths, headers, rows) -> captionlessTable aligns widths headers rows      (caption, aligns, widths, headers, rows) -> do diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs index bd22c161f..1bf14c6a0 100644 --- a/src/Text/Pandoc/Writers/Jira.hs +++ b/src/Text/Pandoc/Writers/Jira.hs @@ -26,10 +26,10 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad)  import Text.Pandoc.Definition  import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText),                              WrapOption (..)) -import Text.Pandoc.Shared (linesToPara, stringify, toLegacyTable) +import Text.Pandoc.Shared (linesToPara, stringify)  import Text.Pandoc.Templates (renderTemplate)  import Text.Pandoc.Writers.Math (texMathToInlines) -import Text.Pandoc.Writers.Shared (defField, metaToContext) +import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)  import Text.DocLayout (literal, render)  import qualified Data.Text as T  import qualified Text.Jira.Markup as Jira @@ -98,7 +98,7 @@ toJiraBlocks blocks = do          Plain xs             -> singleton . Jira.Para <$> toJiraInlines xs          RawBlock fmt cs      -> rawBlockToJira fmt cs          Null                 -> return mempty -        Table _ blkCapt specs _ thead tbody tfoot -> singleton <$> do +        Table _ blkCapt specs thead tbody tfoot -> singleton <$> do            let (_, _, _, hd, body) = toLegacyTable blkCapt specs thead tbody tfoot            headerRow <- if all null hd                         then pure Nothing diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 274f5108a..c3a2762d2 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -759,7 +759,7 @@ blockToLaTeX (Header level (id',classes,_) lst) = do    hdr <- sectionHeader classes id' level lst    modify $ \s -> s{stInHeading = False}    return hdr -blockToLaTeX (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToLaTeX (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot    (captionText, captForLof, captNotes) <- getCaption False caption    let toHeaders hs = do contents <- tableRowToLaTeX True aligns widths hs diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index dda1e1cf1..105906138 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -139,7 +139,7 @@ blockToMan opts (CodeBlock _ str) = return $  blockToMan opts (BlockQuote blocks) = do    contents <- blockListToMan opts blocks    return $ literal ".RS" $$ contents $$ literal ".RE" -blockToMan opts (Table _ blkCapt specs _ thead tbody tfoot) = +blockToMan opts (Table _ blkCapt specs thead tbody tfoot) =    let (caption, alignments, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot        aligncode AlignLeft    = "l"        aligncode AlignRight   = "r" diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 4d4d02028..7a11e3c16 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -574,7 +574,7 @@ blockToMarkdown' opts (BlockQuote blocks) = do                    else if plain then "  " else "> "    contents <- blockListToMarkdown opts blocks    return $ (prefixed leader contents) <> blankline -blockToMarkdown' opts t@(Table _ blkCapt specs _ thead tbody tfoot) = do +blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    let numcols = maximum (length aligns : length widths :                             map length (headers:rows)) diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index fbfb7acb4..8d1745e8e 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -150,7 +150,7 @@ blockToMediaWiki (BlockQuote blocks) = do    contents <- blockListToMediaWiki blocks    return $ "<blockquote>" <> contents <> "</blockquote>" -blockToMediaWiki (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToMediaWiki (Table _ blkCapt specs thead tbody tfoot) = do    let (capt, aligns, widths, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot    caption <- if null capt                  then return "" diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index ad2a7a3fd..6c9d8a783 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -215,7 +215,7 @@ blockToMs opts (BlockQuote blocks) = do    contents <- blockListToMs opts blocks    setFirstPara    return $ literal ".QS" $$ contents $$ literal ".QE" -blockToMs opts (Table _ blkCapt specs _ thead tbody tfoot) = +blockToMs opts (Table _ blkCapt specs thead tbody tfoot) =    let (caption, alignments, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot        aligncode AlignLeft    = "l"        aligncode AlignRight   = "r" diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index f2bc91290..88b4c2ef9 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -259,7 +259,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do    return $ blankline <> attr' $$ nowrap (header' <> contents) <> blankline  -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors  blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline -blockToMuse (Table _ blkCapt specs _ thead tbody tfoot) = +blockToMuse (Table _ blkCapt specs thead tbody tfoot) =    if isSimple && numcols > 1      then simpleTable caption headers rows      else do diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index a533496c1..4d4dfca15 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -40,18 +40,15 @@ prettyBlock (DefinitionList items) = "DefinitionList" $$    prettyList (map deflistitem items)      where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <>             nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")" -prettyBlock (Table attr blkCapt specs rhs thead tbody tfoot) = +prettyBlock (Table attr blkCapt specs thead tbody tfoot) =    mconcat [ "Table "            , text (show attr)            , " " -          , prettyCaption blkCapt -          , " " -          , text (show specs) -          , " " -          , text (show rhs) ] $$ -  prettyRows thead $$ -  prettyRows tbody $$ -  prettyRows tfoot +          , prettyCaption blkCapt ] $$ +  prettyList (map (text . show) specs) $$ +  prettyHead thead $$ +  prettyBodies tbody $$ +  prettyFoot tfoot    where prettyRows = prettyList . map prettyRow          prettyRow (Row a body) =            text ("Row " <> show a) $$ prettyList (map prettyCell body) @@ -59,14 +56,26 @@ prettyBlock (Table attr blkCapt specs rhs thead tbody tfoot) =            mconcat [ "Cell "                    , text (show a)                    , " " -                  , text (showsPrec 11 ma "") -                  , " " +                  , text (show ma) +                  , " ("                    , text (show h) -                  , " " -                  , text (show w) ] $$ +                  , ") (" +                  , text (show w) +                  , ")" ] $$            prettyList (map prettyBlock b)          prettyCaption (Caption mshort body) =            "(Caption " <> text (showsPrec 11 mshort "") $$ prettyList (map prettyBlock body) <> ")" +        prettyHead (TableHead thattr body) +          = "(TableHead " <> text (show thattr) $$ prettyRows body <> ")" +        prettyBody (TableBody tbattr rhc hd bd) +          = mconcat [ "(TableBody " +                    , text (show tbattr) +                    , " (" +                    , text (show rhc) +                    , ")" ] $$ prettyRows hd $$ prettyRows bd <> ")" +        prettyBodies = prettyList . map prettyBody +        prettyFoot (TableFoot tfattr body) +          = "(TableFoot " <> text (show tfattr) $$ prettyRows body <> ")"  prettyBlock (Div attr blocks) =    text ("Div " <> show attr) $$ prettyList (map prettyBlock blocks)  prettyBlock block = text $ show block diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 12599772f..9c802118a 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -31,7 +31,7 @@ import Text.Pandoc.Definition  import Text.Pandoc.Logging  import Text.Pandoc.Options  import Text.DocLayout -import Text.Pandoc.Shared (linesToPara, tshow, toLegacyTable) +import Text.Pandoc.Shared (linesToPara, tshow)  import Text.Pandoc.Templates (renderTemplate)  import qualified Text.Pandoc.Translations as Term (Term(Figure, Table))  import Text.Pandoc.Writers.Math @@ -359,7 +359,7 @@ blockToOpenDocument o bs      | BulletList     b <- bs = setFirstPara >> bulletListToOpenDocument o b      | OrderedList  a b <- bs = setFirstPara >> orderedList a b      | CodeBlock    _ s <- bs = setFirstPara >> preformatted s -    | Table _ bc s _ th tb tf +    | Table _ bc s th tb tf                         <- bs = let (c, a, w, h, r) = toLegacyTable bc s th tb tf                                 in setFirstPara >> table c a w h r      | HorizontalRule   <- bs = setFirstPara >> return (selfClosingTag "text:p" diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index d8d89d2eb..8e7f4dbf1 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -183,7 +183,7 @@ blockToOrg (BlockQuote blocks) = do    contents <- blockListToOrg blocks    return $ blankline $$ "#+BEGIN_QUOTE" $$             nest 2 contents $$ "#+END_QUOTE" $$ blankline -blockToOrg (Table _ blkCapt specs _ thead tbody tfoot) =  do +blockToOrg (Table _ blkCapt specs thead tbody tfoot) =  do    let (caption', _, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    caption'' <- inlineListToOrg caption'    let caption = if null caption' diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index dbacbb3cf..68345bcd1 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -54,9 +54,10 @@ import Text.Pandoc.Logging  import Text.Pandoc.Walk  import Data.Time (UTCTime)  import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element" -import Text.Pandoc.Shared (tshow, toLegacyTable) +import Text.Pandoc.Shared (tshow)  import Text.Pandoc.Writers.Shared (lookupMetaInlines, lookupMetaBlocks -                                 , lookupMetaString, toTableOfContents) +                                 , lookupMetaString, toTableOfContents +                                 , toLegacyTable)  import qualified Data.Map as M  import qualified Data.Set as S  import Data.Maybe (maybeToList, fromMaybe) @@ -541,7 +542,7 @@ blockToShape (Para (il:_))  | Link _ (il':_) target <- il                              , Image attr ils (url, _) <- il' =        (withAttr attr . Pic def{picPropLink = Just $ ExternalTarget target} (T.unpack url))        <$> inlinesToParElems ils -blockToShape (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToShape (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, algn, _, hdrCells, rows) = toLegacyTable blkCapt specs thead tbody tfoot    caption' <- inlinesToParElems caption    hdrCells' <- rowToParagraphs algn hdrCells diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 85354d93f..a390cc6cf 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -284,7 +284,7 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do  blockToRST (BlockQuote blocks) = do    contents <- blockListToRST blocks    return $ nest 3 contents <> blankline -blockToRST (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToRST (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    caption' <- inlineListToRST caption    let blocksToDoc opts bs = do diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index e45a73f79..da24e8b71 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -254,7 +254,7 @@ blockToRTF indent alignment (Header level _ lst) = do    contents <- inlinesToRTF lst    return $ rtfPar indent 0 alignment $               "\\b \\fs" <> tshow (40 - (level * 4)) <> " " <> contents -blockToRTF indent alignment (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToRTF indent alignment (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, sizes, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    caption' <- inlinesToRTF caption    header' <- if all null headers diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 9ba6dcc8a..fb4e8eca6 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -34,6 +34,7 @@ module Text.Pandoc.Writers.Shared (                       , toSuperscript                       , toTableOfContents                       , endsWithPlain +                     , toLegacyTable                       )  where  import Safe (lastMay) @@ -50,7 +51,7 @@ import qualified Text.Pandoc.Builder as Builder  import Text.Pandoc.Definition  import Text.Pandoc.Options  import Text.DocLayout -import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink) +import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink, blocksToInlines)  import Text.Pandoc.Walk (walk)  import qualified Text.Pandoc.UTF8 as UTF8  import Text.Pandoc.XML (escapeStringForXML) @@ -426,3 +427,32 @@ endsWithPlain xs =    case lastMay xs of      Just Plain{} -> True      _            -> False + +-- | Convert the relevant components of a new-style table (with block +-- caption, row headers, row and column spans, and so on) to those of +-- an old-style table (inline caption, table head with one row, no +-- foot, and so on). +toLegacyTable :: Caption +              -> [ColSpec] +              -> TableHead +              -> [TableBody] +              -> TableFoot +              -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]]) +toLegacyTable (Caption _ cbody) specs (TableHead _ th) tb (TableFoot _ tf) +  = (cbody', aligns, widths, th', tb') +  where +    numcols = length specs +    (aligns, mwidths) = unzip specs +    fromWidth (ColWidth w) | w > 0 = w +    fromWidth _                    = 0 +    widths = map fromWidth mwidths +    unRow (Row _ x) = map unCell x +    unCell (Cell _ _ _ _ x) = x +    unBody (TableBody _ _ hd bd) = hd <> bd +    unBodies = concatMap unBody +    cbody' = blocksToInlines cbody +    sanitise = pad mempty numcols . unRow +    pad element upTo list = take upTo (list ++ repeat element) +    (th', tb') = case th of +      (r:rs) -> (sanitise r, map sanitise $ rs <> unBodies tb <> tf) +      []     -> ([], map sanitise $ unBodies tb <> tf) diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index d1bc514c1..f7fa19b1b 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -194,7 +194,7 @@ blockToTEI _ HorizontalRule = return $  -- | TEI Tables  -- TEI Simple's tables are composed of cells and rows; other  -- table info in the AST is here lossily discard. -blockToTEI opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToTEI opts (Table _ blkCapt specs thead tbody tfoot) = do    let (_, _, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    headers' <- tableHeadersToTEI opts headers    rows' <- mapM (tableRowToTEI opts) rows diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index a4b1d3a57..ef1ee7d25 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -228,7 +228,7 @@ blockToTexinfo (Header level (ident,_,_) lst)        seccmd 4 = return "@subsubsection "        seccmd _ = throwError $ PandocSomeError "illegal seccmd level" -blockToTexinfo (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToTexinfo (Table _ blkCapt specs thead tbody tfoot) = do    let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot    headers <- if all null heads                  then return empty diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 2e02448e3..e68303cfe 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -168,7 +168,7 @@ blockToTextile opts (BlockQuote blocks) = do    contents <- blockListToTextile opts blocks    return $ "<blockquote>\n\n" <> contents <> "\n</blockquote>\n" -blockToTextile opts (Table _ blkCapt specs _ thead tbody tfoot) +blockToTextile opts (Table _ blkCapt specs thead tbody tfoot)    = case toLegacyTable blkCapt specs thead tbody tfoot of        ([], aligns, widths, headers, rows') | all (==0) widths -> do          hs <- mapM (liftM (("_. " <>) . stripTrailingNewlines) . blockListToTextile opts) headers diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs index 43729d0b0..bfc61c3b5 100644 --- a/src/Text/Pandoc/Writers/XWiki.hs +++ b/src/Text/Pandoc/Writers/XWiki.hs @@ -43,6 +43,7 @@ import Text.Pandoc.Logging  import Text.Pandoc.Options  import Text.Pandoc.Shared  import Text.Pandoc.Writers.MediaWiki (highlightingLangs) +import Text.Pandoc.Writers.Shared (toLegacyTable)  data WriterState = WriterState {    listLevel :: Text -- String at the beginning of items @@ -122,7 +123,7 @@ blockToXWiki (DefinitionList items) = do    return $ vcat contents <> if Text.null lev then "\n" else ""  -- TODO: support more features -blockToXWiki (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToXWiki (Table _ blkCapt specs thead tbody tfoot) = do    let (_, _, _, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot    headers' <- mapM (tableCellXWiki True) headers    otherRows <- mapM formRow rows' diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 0709744d5..e311abe7b 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -32,9 +32,9 @@ import Text.Pandoc.Logging  import Text.Pandoc.Options (WrapOption (..),             WriterOptions (writerTableOfContents, writerTemplate,                            writerWrapText)) -import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, trimr, toLegacyTable) +import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, trimr)  import Text.Pandoc.Templates (renderTemplate) -import Text.Pandoc.Writers.Shared (defField, metaToContext) +import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)  data WriterState = WriterState {      stIndent  :: Text,           -- Indent after the marker at the beginning of list items @@ -132,7 +132,7 @@ blockToZimWiki opts (BlockQuote blocks) = do    contents <- blockListToZimWiki opts blocks    return $ T.unlines $ map ("> " <>) $ T.lines contents -blockToZimWiki opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToZimWiki opts (Table _ blkCapt specs thead tbody tfoot) = do    let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot    captionDoc <- if null capt                     then return "" | 
