Docx reader and writer: support row heads.

Reader: When `w:tblLook` has `w:firstColumn` set (or an equivalent bit
mask), we set row heads = 1 in the AST.

Writer: set `w:firstColumn` in `w:tblLook` when there are row
heads. (Word only allows one, so this is triggered by any number
of row heads > 0.)

Closes jgm#9495.

Author: jgm

src/Text/Pandoc/Readers/Docx.hs

@@ -815,6 +815,8 @@ bodyPartToBlocks (Tbl mbsty cap grid look parts) = do
       cap' = caption shortCaption fullCaption
       (hdr, rows) = splitHeaderRows (firstRowFormatting look) parts
 
+  let rowHeadCols = if firstColumnFormatting look then 1 else 0
+
   let width = maybe 0 maximum $ nonEmpty $ map rowLength parts
       rowLength :: Docx.Row -> Int
       rowLength (Docx.Row _ c) = sum (fmap (\(Docx.Cell _ gridSpan _ _) -> fromIntegral gridSpan) c)
@@ -838,7 +840,7 @@ bodyPartToBlocks (Tbl mbsty cap grid look parts) = do
   return $ tableWith attr cap'
                  (zip alignments widths)
                  (TableHead nullAttr headerCells)
-                 [TableBody nullAttr 0 [] bodyCells]
+                 [TableBody nullAttr (RowHeadColumns rowHeadCols) [] bodyCells]
                  (TableFoot nullAttr [])
 bodyPartToBlocks HRule = pure Pandoc.horizontalRule
 

src/Text/Pandoc/Readers/Docx/Parse.hs

@@ -294,11 +294,15 @@ data BodyPart = Paragraph ParagraphStyle [ParPart]
 
 type TblGrid = [Integer]
 
-newtype TblLook = TblLook {firstRowFormatting::Bool}
+data TblLook = TblLook { firstRowFormatting ::Bool
+                       , firstColumnFormatting :: Bool
+                       }
               deriving Show
 
 defaultTblLook :: TblLook
-defaultTblLook = TblLook{firstRowFormatting = False}
+defaultTblLook = TblLook{ firstRowFormatting = False
+                        , firstColumnFormatting = False
+                        }
 
 data Row = Row TblHeader [Cell] deriving Show
 
@@ -691,17 +695,25 @@ elemToTblGrid _ _ = throwError WrongElem
 
 elemToTblLook :: NameSpaces -> Element -> D TblLook
 elemToTblLook ns element | isElem ns "w" "tblLook" element =
-  let firstRow = findAttrByName ns "w" "firstRow" element
-      val = findAttrByName ns "w" "val" element
+  let val = findAttrByName ns "w" "val" element
       firstRowFmt =
-        case firstRow of
+        case findAttrByName ns "w" "firstRow" element of
           Just "1" -> True
           Just  _  -> False
           Nothing -> case val of
             Just bitMask -> testBitMask bitMask 0x020
             Nothing      -> False
+      firstColFmt =
+        case findAttrByName ns "w" "firstColumn" element of
+          Just "1" -> True
+          Just  _  -> False
+          Nothing -> case val of
+            Just bitMask -> testBitMask bitMask 0x080
+            Nothing      -> False
   in
-   return TblLook{firstRowFormatting = firstRowFmt}
+   return TblLook{ firstRowFormatting = firstRowFmt
+                 , firstColumnFormatting = firstColFmt
+                 }
 elemToTblLook _ _ = throwError WrongElem
 
 elemToRow :: NameSpaces -> Element -> D Row

src/Text/Pandoc/Writers/Docx/Table.hs

@@ -63,6 +63,7 @@ import Text.Pandoc.XML.Light.Types
 import qualified Data.Text as T
 import qualified Text.Pandoc.Translations as Term
 import qualified Text.Pandoc.Writers.GridTable as Grid
+import Data.Bits ((.|.))
 
 tableToOpenXML :: PandocMonad m
                => WriterOptions
@@ -71,7 +72,7 @@ tableToOpenXML :: PandocMonad m
                -> WS m [Content]
 tableToOpenXML opts blocksToOpenXML gridTable = do
   setFirstPara
-  let (Grid.Table (ident,_,tableAttr) caption colspecs _rowheads thead tbodies tfoot) =
+  let (Grid.Table (ident,_,tableAttr) caption colspecs rowheads thead tbodies tfoot) =
         gridTable
   let (Caption _maybeShortCaption captionBlocks) = caption
   tablenum <- gets stNextTableNum
@@ -106,7 +107,8 @@ tableToOpenXML opts blocksToOpenXML gridTable = do
   -- 0×0100  Apply last column conditional formatting
   -- 0×0200  Do not apply row banding conditional formatting
   -- 0×0400  Do not apply column banding conditional formattin
-  let tblLookVal = if hasHeader then (0x20 :: Int) else 0
+  let tblLookVal = (if hasHeader then (0x20 :: Int) else 0) .|.
+                   (if rowheads > 0 then (0x80 :: Int) else 0)
   let (gridCols, tblWattr) = tableLayout (elems colspecs)
   listLevel <- asks envListLevel
   let tblStyle =  fromMaybe "Table" (lookup "custom-style" tableAttr)
@@ -122,7 +124,7 @@ tableToOpenXML opts blocksToOpenXML gridTable = do
             [ mknode "w:tblLayout" [("w:type", "fixed")] () | hasWidths ] ++
             [ mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0")
                                  ,("w:lastRow",if hasFooter then "1" else "0")
-                                 ,("w:firstColumn","0")
+                                 ,("w:firstColumn",if rowheads > 0 then "1" else "0")
                                  ,("w:lastColumn","0")
                                  ,("w:noHBand","0")
                                  ,("w:noVBand","0")

test/command/9358.docx

@@ -0,0 +1,98 @@
+```
+% pandoc -f native -t docx | pandoc -f docx -t native
+[ Table
+    ( "" , [] , [] )
+    (Caption Nothing [])
+    [ ( AlignDefault , ColWidth 0.5 )
+    , ( AlignDefault , ColWidth 0.5 )
+    ]
+    (TableHead
+       ( "" , [] , [] )
+       [ Row
+           ( "" , [] , [] )
+           [ Cell
+               ( "" , [] , [] )
+               AlignDefault
+               (RowSpan 1)
+               (ColSpan 1)
+               [ Plain [ Str "1" ] ]
+           , Cell
+               ( "" , [] , [] )
+               AlignDefault
+               (RowSpan 1)
+               (ColSpan 1)
+               [ Plain [ Str "2" ] ]
+           ]
+       ])
+    [ TableBody
+        ( "" , [] , [] )
+        (RowHeadColumns 1)
+        []
+        [ Row
+            ( "" , [] , [] )
+            [ Cell
+                ( "" , [] , [] )
+                AlignDefault
+                (RowSpan 1)
+                (ColSpan 1)
+                [ Plain [ Str "3" ] ]
+            , Cell
+                ( "" , [] , [] )
+                AlignDefault
+                (RowSpan 1)
+                (ColSpan 1)
+                [ Plain [ Str "4" ] ]
+            ]
+        ]
+    ]
+    (TableFoot ( "" , [] , [] ) [])
+]
+^D
+[ Table
+    ( "" , [] , [] )
+    (Caption Nothing [])
+    [ ( AlignDefault , ColWidth 0.5 )
+    , ( AlignDefault , ColWidth 0.5 )
+    ]
+    (TableHead
+       ( "" , [] , [] )
+       [ Row
+           ( "" , [] , [] )
+           [ Cell
+               ( "" , [] , [] )
+               AlignDefault
+               (RowSpan 1)
+               (ColSpan 1)
+               [ Plain [ Str "1" ] ]
+           , Cell
+               ( "" , [] , [] )
+               AlignDefault
+               (RowSpan 1)
+               (ColSpan 1)
+               [ Plain [ Str "2" ] ]
+           ]
+       ])
+    [ TableBody
+        ( "" , [] , [] )
+        (RowHeadColumns 1)
+        []
+        [ Row
+            ( "" , [] , [] )
+            [ Cell
+                ( "" , [] , [] )
+                AlignDefault
+                (RowSpan 1)
+                (ColSpan 1)
+                [ Plain [ Str "3" ] ]
+            , Cell
+                ( "" , [] , [] )
+                AlignDefault
+                (RowSpan 1)
+                (ColSpan 1)
+                [ Plain [ Str "4" ] ]
+            ]
+        ]
+    ]
+    (TableFoot ( "" , [] , [] ) [])
+]
+```