From bdab9915ad01a4ee3542a15e4f43102b8a4e2a20 Mon Sep 17 00:00:00 2001 From: TuongNM Date: Sat, 20 Sep 2025 21:05:29 +0200 Subject: OpenDocument writer: Add missing table elements (#11157) Add missing header rows after the first one, footer rows as well as TableBody header rows. Also apply hlint suggestions to use Down and fuse mapM/map. Closes #10002. --- src/Text/Pandoc/Writers/OpenDocument.hs | 42 +++++-- test/command/10002.md | 203 ++++++++++++++++++++++++++++++++ 2 files changed, 232 insertions(+), 13 deletions(-) create mode 100644 test/command/10002.md diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 28f0d13f1..72ee05c4e 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -21,7 +21,7 @@ import Data.Char (chr) import Data.Foldable (find) import Data.List (sortOn, sortBy, foldl') import qualified Data.Map as Map -import Data.Ord (comparing) +import Data.Ord (comparing, Down (Down)) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T @@ -260,7 +260,7 @@ writeOpenDocument opts (Pandoc meta blocks) = do b <- blocksToOpenDocument opts blocks return (b, m) let styles = stTableStyles s ++ stParaStyles s ++ formulaStyles ++ - map snd (sortBy (flip (comparing fst)) ( + map snd (sortBy (comparing (Down . fst)) ( Map.elems (stTextStyles s))) listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" <> tshow n)] (vcat l) @@ -413,7 +413,7 @@ blockToOpenDocument o = \case setInDefinitionList False return r unhighlighted s = flush . vcat <$> - (mapM (inPreformattedTags . (:[])) (map preformatted (T.lines s))) + (mapM ((inPreformattedTags . (:[])) . preformatted) (T.lines s)) mkDiv attr s = do let (ident,_,kvs) = attr i = withLangFromAttr attr $ @@ -433,7 +433,7 @@ blockToOpenDocument o = \case <$> orderedListToOpenDocument o pn b table :: PandocMonad m => WriterOptions -> Ann.Table -> OD m (Doc Text) table opts - (Ann.Table (ident, _, _) (Caption _ c) colspecs thead tbodies _) = do + (Ann.Table (ident, _, _) (Caption _ c) colspecs thead tbodies tfoot) = do tn <- length <$> gets stTableStyles pn <- length <$> gets stParaStyles let genIds = map chr [65..] @@ -459,10 +459,11 @@ blockToOpenDocument o = \case else unNumberedCaption "TableCaption" th <- colHeadsToOpenDocument o (map fst paraHStyles) thead tr <- mapM (tableBodyToOpenDocument o (map fst paraHStyles) (map fst paraStyles)) tbodies + tf <- tableFootToOpenDocument o (map fst paraStyles) tfoot let tableDoc = inTags True "table:table" [ ("table:name" , name) , ("table:style-name", name) - ] (vcat columns $$ th $$ vcat tr) + ] (vcat columns $$ th $$ vcat tr $$ tf) return $ case writerTableCaptionPosition opts of CaptionAbove -> captionDoc $$ tableDoc @@ -521,18 +522,33 @@ colHeadsToOpenDocument :: PandocMonad m colHeadsToOpenDocument o ns (Ann.TableHead _ hs) = case hs of [] -> return empty - (x:_) -> - let (Ann.HeaderRow _ _ c) = x - in inTagsIndented "table:table-header-rows" . - inTagsIndented "table:table-row" . - vcat <$> mapM (tableItemToOpenDocument o "TableHeaderRowCell") (zip ns c) + xs -> inTagsIndented "table:table-header-rows" <$> + tableHeaderRowsToOpenDocument o ns "TableHeaderRowCell" xs + +tableHeaderRowsToOpenDocument :: PandocMonad m + => WriterOptions -> [Text] -> Text -> [Ann.HeaderRow] + -> OD m (Doc Text) +tableHeaderRowsToOpenDocument o ns s headerRows = + vcat <$> mapM headerRowToOpenDocument headerRows + where + headerRowToOpenDocument (Ann.HeaderRow _ _ c) = + inTagsIndented "table:table-row" . + vcat <$> mapM (tableItemToOpenDocument o s) (zip ns c) tableBodyToOpenDocument:: PandocMonad m => WriterOptions -> [Text] -> [Text] -> Ann.TableBody -> OD m (Doc Text) -tableBodyToOpenDocument o headns bodyns tb = - let (Ann.TableBody _ _ _ r) = tb - in vcat <$> mapM (tableRowToOpenDocument o headns bodyns) r +tableBodyToOpenDocument o headns bodyns tb = do + let (Ann.TableBody _ _ hs r) = tb + tableRowHeaders <- tableHeaderRowsToOpenDocument o headns "TableRowCell" hs + tableRows <- mapM (tableRowToOpenDocument o headns bodyns) r + return $ tableRowHeaders $$ vcat tableRows + +tableFootToOpenDocument :: PandocMonad m + => WriterOptions -> [Text] -> Ann.TableFoot + -> OD m (Doc Text) +tableFootToOpenDocument o ns (Ann.TableFoot _ r) = + tableHeaderRowsToOpenDocument o ns "TableRowCell" r tableRowToOpenDocument :: PandocMonad m => WriterOptions -> [Text] -> [Text] -> Ann.BodyRow diff --git a/test/command/10002.md b/test/command/10002.md new file mode 100644 index 000000000..0a9d84694 --- /dev/null +++ b/test/command/10002.md @@ -0,0 +1,203 @@ +```` +% pandoc -f native -t opendocument +[ Table + ( "" , [] , [] ) + (Caption Nothing []) + [ ( AlignDefault , ColWidthDefault ) + , ( AlignDefault , ColWidthDefault ) + , ( AlignDefault , ColWidthDefault ) + ] + (TableHead + ( "" , [] , [] ) + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 3) + [ Plain + [ Str "First" + , Space + , Str "Header" + , Space + , Str "Row" + ] + ] + ] + , Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Second" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Header" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Row" ] ] + ] + ]) + [ TableBody + ( "" , [] , [] ) + (RowHeadColumns 0) + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Header - Table" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Header - Body" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Header - Row" ] ] + ] + ] + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Table" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Body" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Row" ] ] + ] + ] + ] + (TableFoot + ( "" , [] , [] ) + [ Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 3) + [ Plain + [ Str "First" + , Space + , Str "Footer" + , Space + , Str "Row" + ] + ] + ] + , Row + ( "" , [] , [] ) + [ Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Second" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Footer" ] ] + , Cell + ( "" , [] , [] ) + AlignDefault + (RowSpan 1) + (ColSpan 1) + [ Plain [ Str "Row" ] ] + ] + ]) +] +^D + + + + + + + + First Header + Row + + + + + Second + + + Header + + + Row + + + + + + Header - Table + + + Header - Body + + + Header - Row + + + + + Table + + + Body + + + Row + + + + + First Footer + Row + + + + + Second + + + Footer + + + Row + + + +```` -- cgit v1.2.3