Provide more detailed XML diff in tests

I had some failing tests and couldn’t tell what was different in the
XML. Updating the comparison to return what’s different made it easier
to figure out what was wrong, and I think will be helpful for others in
future.

1 files changed, 51 insertions, 21 deletions

diff --git a/test/Tests/Writers/OOXML.hs b/test/Tests/Writers/OOXML.hs
index 83f05cfec..299e3e547 100644
--- a/test/Tests/Writers/OOXML.hs
+++ b/test/Tests/Writers/OOXML.hs
@@ -3,13 +3,15 @@
 
 module Tests.Writers.OOXML (ooxmlTest) where
 
-import Text.Pandoc
+import Text.Pandoc hiding (Attr)
 import Test.Tasty
 import Test.Tasty.Golden.Advanced
+import Control.Applicative ((<|>))
 import Codec.Archive.Zip
 import Text.XML.Light
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
+import Data.Foldable (asum)
 import qualified Data.Text.IO as T
 import Data.List (isSuffixOf, sort, (\\), intercalate, union)
 import Data.Maybe (catMaybes, mapMaybe)
@@ -17,29 +19,55 @@ import Tests.Helpers
 import Data.Algorithm.Diff
 import System.FilePath.Glob (compile, match)
 
-compareXMLBool :: Content -> Content -> Bool
+compareXML :: Content -> Content -> Maybe XMLDifference
 -- We make a special exception for times at the moment, and just pass
 -- them because we can't control the utctime when running IO. Besides,
 -- so long as we have two times, we're okay.
-compareXMLBool (Elem myElem) (Elem goodElem)
+compareXML (Elem myElem) (Elem goodElem)
   | (QName "created" _ (Just "dcterms")) <- elName myElem
   , (QName "created" _ (Just "dcterms")) <- elName goodElem =
-      True
-compareXMLBool (Elem myElem) (Elem goodElem)
+      Nothing
+compareXML (Elem myElem) (Elem goodElem)
   | (QName "modified" _ (Just "dcterms")) <- elName myElem
   , (QName "modified" _ (Just "dcterms")) <- elName goodElem =
-      True
-compareXMLBool (Elem myElem) (Elem goodElem) =
-  elName myElem == elName goodElem &&
-  elAttribs myElem == elAttribs goodElem &&
-  and (zipWith compareXMLBool (elContent myElem) (elContent goodElem))
-compareXMLBool (Text myCData) (Text goodCData) =
-  cdVerbatim myCData == cdVerbatim goodCData &&
-  cdData myCData == cdData goodCData &&
-  cdLine myCData == cdLine goodCData
-compareXMLBool (CRef myStr) (CRef goodStr) =
-  myStr == goodStr
-compareXMLBool _ _ = False
+      Nothing
+compareXML (Elem myElem) (Elem goodElem) =
+  (if elName myElem == elName goodElem
+   then Nothing
+   else Just
+    (ElemNamesDiffer
+     (Comparison {mine = elName myElem, good = elName goodElem}))
+  )
+  <|> (if sort (elAttribs myElem) == sort (elAttribs goodElem)
+   then Nothing
+   else Just
+    (ElemAttributesDiffer
+     (Comparison { mine = sort (elAttribs myElem)
+                 , good = sort (elAttribs goodElem)
+                 })))
+  <|> asum (zipWith compareXML (elContent myElem) (elContent goodElem))
+compareXML (Text myCData) (Text goodCData) =
+  (if cdVerbatim myCData == cdVerbatim goodCData
+    && cdData myCData == cdData goodCData
+    && cdLine myCData == cdLine goodCData
+   then Nothing
+   else Just (CDatasDiffer (Comparison { mine = myCData, good = goodCData })))
+compareXML (CRef myStr) (CRef goodStr) =
+  if myStr == goodStr
+  then Nothing
+  else Just (CRefsDiffer (Comparison { mine = myStr, good = goodStr }))
+compareXML m g = Just (OtherContentsDiffer (Comparison {mine = m, good = g}))
+
+data XMLDifference
+  = ElemNamesDiffer (Comparison QName)
+  | ElemAttributesDiffer (Comparison [Attr])
+  | CDatasDiffer (Comparison CData)
+  | CRefsDiffer (Comparison String)
+  | OtherContentsDiffer (Comparison Content)
+  deriving (Show)
+
+data Comparison a = Comparison { good :: a, mine :: a }
+  deriving (Show)
 
 displayDiff :: Content -> Content -> String
 displayDiff elemA elemB =
@@ -106,11 +134,13 @@ compareXMLFile' fp goldenArch testArch = do
 
   let testContent = Elem testXMLDoc
       goldenContent = Elem goldenXMLDoc
+      display difference = "Non-matching xml in "
+        ++ fp ++ ":\n"
+        ++ "* " ++ show difference ++ "\n"
+        ++ displayDiff testContent goldenContent
 
-  if compareXMLBool goldenContent testContent
-    then Right ()
-    else Left $
-    "Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff testContent goldenContent
+
+  maybe (Right ()) (Left . display) (compareXML goldenContent testContent)
 
 compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String
 compareXMLFile fp goldenArch testArch =