diff options
Diffstat (limited to 'test/Tests/Writers/OOXML.hs')
-rw-r--r-- | test/Tests/Writers/OOXML.hs | 78 |
1 files changed, 54 insertions, 24 deletions
diff --git a/test/Tests/Writers/OOXML.hs b/test/Tests/Writers/OOXML.hs index 83f05cfec..43543954c 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,34 +19,59 @@ 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 goodElem) (Elem myElem) | (QName "created" _ (Just "dcterms")) <- elName myElem , (QName "created" _ (Just "dcterms")) <- elName goodElem = - True -compareXMLBool (Elem myElem) (Elem goodElem) + Nothing +compareXML (Elem goodElem) (Elem myElem) | (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 - -displayDiff :: Content -> Content -> String + Nothing +compareXML (Elem goodElem) (Elem myElem) = + (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 goodCData) (Text myCData) = + (if cdVerbatim myCData == cdVerbatim goodCData + && cdData myCData == cdData goodCData + then Nothing + else Just (CDatasDiffer (Comparison { mine = myCData, good = goodCData }))) +compareXML (CRef goodStr) (CRef myStr) = + if myStr == goodStr + then Nothing + else Just (CRefsDiffer (Comparison { mine = myStr, good = goodStr })) +compareXML g m = 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 :: Element -> Element -> String displayDiff elemA elemB = showDiff (1,1) - (getDiff (lines $ showContent elemA) (lines $ showContent elemB)) + (getDiff (lines $ ppElement elemA) (lines $ ppElement elemB)) goldenArchive :: FilePath -> IO Archive goldenArchive fp = toArchive . BL.fromStrict <$> BS.readFile fp @@ -57,6 +84,7 @@ testArchive writerFn opts fp = do txt <- T.readFile fp bs <- runIOorExplode $ do setTranslations "en-US" + setVerbosity ERROR -- otherwise test output is confusingly noisy readNative def txt >>= writerFn opts return $ toArchive bs @@ -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 testXMLDoc goldenXMLDoc - 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 = |