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.

2 files changed, 232 insertions, 13 deletions

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
+<table:table table:name="Table1" table:style-name="Table1">
+  <table:table-column table:style-name="Table1.A" />
+  <table:table-column table:style-name="Table1.B" />
+  <table:table-column table:style-name="Table1.C" />
+  <table:table-header-rows>
+    <table:table-row>
+      <table:table-cell table:style-name="TableHeaderRowCell" office:value-type="string" table:number-columns-spanned="3">
+        <text:p text:style-name="Table_20_Heading">First Header
+        Row</text:p>
+      </table:table-cell>
+    </table:table-row>
+    <table:table-row>
+      <table:table-cell table:style-name="TableHeaderRowCell" office:value-type="string">
+        <text:p text:style-name="Table_20_Heading">Second</text:p>
+      </table:table-cell>
+      <table:table-cell table:style-name="TableHeaderRowCell" office:value-type="string">
+        <text:p text:style-name="Table_20_Heading">Header</text:p>
+      </table:table-cell>
+      <table:table-cell table:style-name="TableHeaderRowCell" office:value-type="string">
+        <text:p text:style-name="Table_20_Heading">Row</text:p>
+      </table:table-cell>
+    </table:table-row>
+  </table:table-header-rows>
+  <table:table-row>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Heading">Header - Table</text:p>
+    </table:table-cell>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Heading">Header - Body</text:p>
+    </table:table-cell>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Heading">Header - Row</text:p>
+    </table:table-cell>
+  </table:table-row>
+  <table:table-row>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Contents">Table</text:p>
+    </table:table-cell>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Contents">Body</text:p>
+    </table:table-cell>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Contents">Row</text:p>
+    </table:table-cell>
+  </table:table-row>
+  <table:table-row>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string" table:number-columns-spanned="3">
+      <text:p text:style-name="Table_20_Contents">First Footer
+      Row</text:p>
+    </table:table-cell>
+  </table:table-row>
+  <table:table-row>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Contents">Second</text:p>
+    </table:table-cell>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Contents">Footer</text:p>
+    </table:table-cell>
+    <table:table-cell table:style-name="TableRowCell" office:value-type="string">
+      <text:p text:style-name="Table_20_Contents">Row</text:p>
+    </table:table-cell>
+  </table:table-row>
+</table:table>
+````