Docx writer: use namespace URI instead of prefix in extractPageLayout (#11697)

When a reference document uses a non-standard namespace prefix for the
WordprocessingML namespace (e.g. `ns0` instead of `w`), `sectPr` elements
copied from the reference would retain the non-`w` prefix, producing
malformed XML in the output document.  Similarly,
`extractPageLayout` only matched elements with prefix `w`, missing
`sectPr` elements with other prefixes.  This is fixed by matching on the
namespace URI rather than the prefix, and normalizing the prefix to `w`
on all elements and attributes copied from reference-doc `sectPr`.

Some new tests have been added, and the test suite has been streamlined
using helper functions.

test/Tests/Writers/Docx.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Tests.Writers.Docx (tests) where
 
-import Codec.Archive.Zip (findEntryByPath, fromEntry, toArchive)
+import Codec.Archive.Zip (Archive, findEntryByPath, fromEntry, toArchive)
 import qualified Data.ByteString.Lazy as BL
 import Data.List (isInfixOf, isPrefixOf)
 import qualified Data.Map as M
@@ -12,7 +12,34 @@ import Test.Tasty
 import Test.Tasty.HUnit
 import Tests.Writers.OOXML
 import Text.Pandoc
-import Text.XML.Light (QName(QName), findAttr, findElements, parseXMLDoc)
+import Text.XML.Light ( Element, QName(QName), findAttr, findElements
+                      , parseXMLDoc )
+
+wmlName :: String -> QName
+wmlName n = QName n
+  (Just "http://schemas.openxmlformats.org/wordprocessingml/2006/main")
+  (Just "w")
+
+entryBytes :: String -> Archive -> IO BL.ByteString
+entryBytes path archive =
+  maybe (assertFailure $ "Missing " ++ path) (return . fromEntry) $
+    findEntryByPath path archive
+
+entryXml :: String -> Archive -> IO Element
+entryXml path archive =
+  maybe (assertFailure $ "Invalid " ++ path) return . parseXMLDoc
+    =<< entryBytes path archive
+
+documentXml :: WriterOptions -> Pandoc -> IO Element
+documentXml opts doc =
+  entryXml "word/document.xml" . toArchive =<<
+    runIOorExplode (setVerbosity ERROR >> writeDocx opts doc)
+
+documentXmlFromNative :: WriterOptions -> FilePath -> IO Element
+documentXmlFromNative opts fp = do
+  txt <- T.readFile fp
+  entryXml "word/document.xml" . toArchive =<<
+    runIOorExplode (setVerbosity ERROR >> readNative def txt >>= writeDocx opts)
 
 -- we add an extra check to make sure that we're not writing in the
 -- toplevel docx directory. We don't want to accidentally overwrite an
@@ -223,82 +250,39 @@ tests = [ testGroup "inlines"
             "docx/golden/document-properties-short-desc.docx"
           ]
         , testGroup "top-level-division"
-          -- Helper to count occurrences of a substring
-          -- Note: counts by splitting on "<w:sectPr" which marks section properties
           [ testCase "no section break before first chapter (#10578)" $ do
-              -- With --top-level-division=chapter, there should be no section
-              -- break before the first chapter (to avoid blank first page)
               let opts = def{ writerTopLevelDivision = TopLevelChapter }
-              bs <- runIOorExplode $ do
-                setVerbosity ERROR
-                let doc = Pandoc mempty
-                          [ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
-                          , Para [Str "First", Space, Str "chapter."]
-                          ]
-                writeDocx opts doc
-              let archive = toArchive bs
-              entry <- case findEntryByPath "word/document.xml" archive of
-                Nothing -> assertFailure "Missing word/document.xml in output docx"
-                Just e -> return e
-              let docXml = show (fromEntry entry)
-              -- Count occurrences of "<w:sectPr" (opening tag for section properties)
-              let countOccurrences needle haystack =
-                    length (filter (needle `isPrefixOf`) (tails haystack))
-                    where tails [] = []; tails s@(_:xs) = s : tails xs
-              let sectPrCount = countOccurrences "<w:sectPr" docXml
-              -- Should have exactly 1 sectPr (the final document section),
-              -- not 2 (which would mean one before the chapter heading)
-              assertBool ("Expected 1 sectPr (final section only), found " ++ show sectPrCount)
+              doc <- documentXml opts $ Pandoc mempty
+                [ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
+                , Para [Str "First", Space, Str "chapter."]
+                ]
+              let sectPrCount = length $ findElements (wmlName "sectPr") doc
+              assertBool ("Expected 1 sectPr, found " ++ show sectPrCount)
                 (sectPrCount == 1)
           , testCase "section breaks between chapters (#11482)" $ do
-              -- With --top-level-division=chapter, there should be section
-              -- breaks between chapters (but not before the first one)
               let opts = def{ writerTopLevelDivision = TopLevelChapter }
-              bs <- runIOorExplode $ do
-                setVerbosity ERROR
-                let doc = Pandoc mempty
-                          [ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
-                          , Para [Str "First", Space, Str "chapter."]
-                          , Header 1 ("ch2", [], []) [Str "Chapter", Space, Str "2"]
-                          , Para [Str "Second", Space, Str "chapter."]
-                          , Header 1 ("ch3", [], []) [Str "Chapter", Space, Str "3"]
-                          , Para [Str "Third", Space, Str "chapter."]
-                          ]
-                writeDocx opts doc
-              let archive = toArchive bs
-              entry <- case findEntryByPath "word/document.xml" archive of
-                Nothing -> assertFailure "Missing word/document.xml in output docx"
-                Just e -> return e
-              let docXml = show (fromEntry entry)
-              -- Count occurrences of "<w:sectPr" (opening tag for section properties)
-              let countOccurrences needle haystack =
-                    length (filter (needle `isPrefixOf`) (tails haystack))
-                    where tails [] = []; tails s@(_:xs) = s : tails xs
-              let sectPrCount = countOccurrences "<w:sectPr" docXml
-              -- Should have 3 sectPr elements:
-              -- - 1 before chapter 2
-              -- - 1 before chapter 3
-              -- - 1 final document section
-              -- (No section break before chapter 1)
-              assertBool ("Expected 3 sectPr elements, found " ++ show sectPrCount)
+              doc <- documentXml opts $ Pandoc mempty
+                [ Header 1 ("ch1", [], []) [Str "Chapter", Space, Str "1"]
+                , Para [Str "First", Space, Str "chapter."]
+                , Header 1 ("ch2", [], []) [Str "Chapter", Space, Str "2"]
+                , Para [Str "Second", Space, Str "chapter."]
+                , Header 1 ("ch3", [], []) [Str "Chapter", Space, Str "3"]
+                , Para [Str "Third", Space, Str "chapter."]
+                ]
+              let sectPrCount = length $ findElements (wmlName "sectPr") doc
+              assertBool ("Expected 3 sectPrs, found " ++ show sectPrCount)
                 (sectPrCount == 3)
           ]
         , testGroup "reference docx"
           [ testCase "no media directory override in content types" $ do
-              let opts = def{ writerReferenceDoc = Just "docx/inline_images.docx" }
+              let opts = def{writerReferenceDoc=Just "docx/inline_images.docx"}
               txt <- T.readFile "docx/inline_formatting.native"
               bs <- runIOorExplode $ do
                 mblang <- toLang (Just (Text.pack "en-US") :: Maybe Text)
                 maybe (return ()) setTranslations mblang
                 setVerbosity ERROR
                 readNative def txt >>= writeDocx opts
-              let archive = toArchive bs
-              entry <- case findEntryByPath "[Content_Types].xml" archive of
-                Nothing -> assertFailure "Missing [Content_Types].xml in output docx"
-                Just e -> return e
-              doc <- case parseXMLDoc (fromEntry entry) of
-                Nothing -> assertFailure "Failed to parse [Content_Types].xml"
-                Just d -> return d
+              doc <- entryXml "[Content_Types].xml" $ toArchive bs
               let partNameAttr = QName "PartName" Nothing Nothing
               let overrideName = QName "Override" Nothing Nothing
               let overrides = findElements overrideName doc
@@ -311,43 +295,41 @@ tests = [ testGroup "inlines"
               -- First, verify that the german-reference.docx actually has de-DE
               refBs <- BL.readFile "docx/german-reference.docx"
               let refArchive = toArchive refBs
-              refEntry <- case findEntryByPath "word/styles.xml" refArchive of
-                Nothing -> assertFailure "Missing word/styles.xml in german-reference.docx"
-                Just e -> return e
-              let refStylesXml = show (fromEntry refEntry)
+              refStylesXml <- show <$> entryBytes "word/styles.xml" refArchive
               let getLangLines = filter ("w:lang" `isInfixOf`) . lines
               assertBool ("german-reference.docx w:lang line: " ++
                   unlines (getLangLines refStylesXml))
                 (any ("de-DE" `isInfixOf`) (getLangLines refStylesXml))
               -- Now test that using this reference preserves the language
-              let opts = def{ writerReferenceDoc = Just "docx/german-reference.docx" }
+              let opts = def{writerReferenceDoc=Just "docx/german-reference.docx"}
               txt <- T.readFile "docx/inline_formatting.native"
               bs <- runIOorExplode $ do
                 setVerbosity ERROR
                 readNative def txt >>= writeDocx opts
-              let archive = toArchive bs
-              entry <- case findEntryByPath "word/styles.xml" archive of
-                Nothing -> assertFailure "Missing word/styles.xml in output docx"
-                Just e -> return e
-              let stylesXml = show (fromEntry entry)
+              stylesXml <- show <$> entryBytes "word/styles.xml" (toArchive bs)
               -- Find the w:lang line for debugging
               -- Check that the styles.xml contains the German language
               assertBool ("Language from reference docx not preserved. w:lang lines: " ++ unlines (getLangLines stylesXml))
                 (any ("de-DE" `isInfixOf`) (getLangLines stylesXml))
+          , testCase "section properties from non-w-prefix reference docx" $ do
+              let opts = def{writerReferenceDoc=Just "docx/ns0-reference.docx"}
+              doc <- documentXmlFromNative opts "docx/inline_formatting.native"
+              case findElements (wmlName "sectPr") doc of
+                [] -> assertFailure "sectPr not found in output"
+                sectPr:_ -> do
+                  assertBool "pgSz not found in output"
+                    (not $ null $ findElements (wmlName "pgSz") sectPr)
+                  findAttr (wmlName "type") sectPr @?= Just "continuous"
           , testCase "language from metadata overrides reference docx" $ do
               -- Use a reference docx with German language, but specify French in metadata
-              let opts = def{ writerReferenceDoc = Just "docx/german-reference.docx" }
+              let opts = def{writerReferenceDoc=Just "docx/german-reference.docx"}
               bs <- runIOorExplode $ do
                 setVerbosity ERROR
                 -- Create a document with French language metadata
                 let doc = Pandoc (Meta $ M.fromList [("lang", MetaString "fr-FR")])
                                  [Para [Str "Test"]]
                 writeDocx opts doc
-              let archive = toArchive bs
-              entry <- case findEntryByPath "word/styles.xml" archive of
-                Nothing -> assertFailure "Missing word/styles.xml in output docx"
-                Just e -> return e
-              let stylesXml = show (fromEntry entry)
+              stylesXml <- show <$> entryBytes "word/styles.xml" (toArchive bs)
               -- Check that the styles.xml contains the French language (not German)
               let getLangLines = filter ("w:lang" `isInfixOf`) . lines
               assertBool "Language from metadata did not override reference docx (expected fr-FR)"
@@ -364,11 +346,7 @@ tests = [ testGroup "inlines"
                           , Para [Str "Para", Space, Str "after."]
                           ]
                 writeDocx opts doc
-              let archive = toArchive bs
-              entry <- case findEntryByPath "word/document.xml" archive of
-                Nothing -> assertFailure "Missing word/document.xml in output docx"
-                Just e -> return e
-              let docXml = show (fromEntry entry)
+              docXml <- show <$> entryBytes "word/document.xml" (toArchive bs)
               assertBool
                 ("Expected FirstParagraph style after heading with footnote, got: "
                   ++ docXml)