1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.OOXML (ooxmlTest) where
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)
import Tests.Helpers
import Data.Algorithm.Diff
import System.FilePath.Glob (compile, match)
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.
compareXML (Elem myElem) (Elem goodElem)
| (QName "created" _ (Just "dcterms")) <- elName myElem
, (QName "created" _ (Just "dcterms")) <- elName goodElem =
Nothing
compareXML (Elem myElem) (Elem goodElem)
| (QName "modified" _ (Just "dcterms")) <- elName myElem
, (QName "modified" _ (Just "dcterms")) <- elName goodElem =
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
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 =
showDiff (1,1)
(getDiff (lines $ showContent elemA) (lines $ showContent elemB))
goldenArchive :: FilePath -> IO Archive
goldenArchive fp = toArchive . BL.fromStrict <$> BS.readFile fp
testArchive :: (WriterOptions -> Pandoc -> PandocIO BL.ByteString)
-> WriterOptions
-> FilePath
-> IO Archive
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
compareFileList :: FilePath -> Archive -> Archive -> Maybe String
compareFileList goldenFP goldenArch testArch =
let testFiles = filesInArchive testArch
goldenFiles = filesInArchive goldenArch
diffTestGolden = testFiles \\ goldenFiles
diffGoldenTest = goldenFiles \\ testFiles
results =
[ if null diffGoldenTest
then Nothing
else Just $
"Files in " ++ goldenFP ++ " but not in generated archive:\n" ++
intercalate ", " diffGoldenTest
, if null diffTestGolden
then Nothing
else Just $
"Files in generated archive but not in " ++ goldenFP ++ ":\n" ++
intercalate ", " diffTestGolden
]
in
if null $ catMaybes results
then Nothing
else Just $ intercalate "\n" $ catMaybes results
compareXMLFile' :: FilePath -> Archive -> Archive -> Either String ()
compareXMLFile' fp goldenArch testArch = do
testEntry <- case findEntryByPath fp testArch of
Just entry -> Right entry
Nothing -> Left $
"Can't extract " ++ fp ++ " from generated archive"
testXMLDoc <- case parseXMLDoc $ fromEntry testEntry of
Just doc -> Right doc
Nothing -> Left $
"Can't parse xml in " ++ fp ++ " from generated archive"
goldenEntry <- case findEntryByPath fp goldenArch of
Just entry -> Right entry
Nothing -> Left $
"Can't extract " ++ fp ++ " from archive in stored file"
goldenXMLDoc <- case parseXMLDoc $ fromEntry goldenEntry of
Just doc -> Right doc
Nothing -> Left $
"Can't parse xml in " ++ fp ++ " from archive in stored file"
let testContent = Elem testXMLDoc
goldenContent = Elem goldenXMLDoc
display difference = "Non-matching xml in "
++ fp ++ ":\n"
++ "* " ++ show difference ++ "\n"
++ displayDiff testContent goldenContent
maybe (Right ()) (Left . display) (compareXML goldenContent testContent)
compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String
compareXMLFile fp goldenArch testArch =
case compareXMLFile' fp goldenArch testArch of
Right _ -> Nothing
Left s -> Just s
compareAllXMLFiles :: Archive -> Archive -> Maybe String
compareAllXMLFiles goldenArch testArch =
let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
allXMLFiles = sort $
filter
(\fp -> ".xml" `isSuffixOf` fp || ".rels" `isSuffixOf` fp)
allFiles
results =
mapMaybe (\fp -> compareXMLFile fp goldenArch testArch) allXMLFiles
in
if null results
then Nothing
else Just $ unlines results
compareMediaFile' :: FilePath -> Archive -> Archive -> Either String ()
compareMediaFile' fp goldenArch testArch = do
testEntry <- case findEntryByPath fp testArch of
Just entry -> Right entry
Nothing -> Left $
"Can't extract " ++ fp ++ " from generated archive"
goldenEntry <- case findEntryByPath fp goldenArch of
Just entry -> Right entry
Nothing -> Left $
"Can't extract " ++ fp ++ " from archive in stored file"
if fromEntry testEntry == fromEntry goldenEntry
then Right ()
else Left $
"Non-matching binary file: " ++ fp
compareMediaFile :: FilePath -> Archive -> Archive -> Maybe String
compareMediaFile fp goldenArch testArch =
case compareMediaFile' fp goldenArch testArch of
Right _ -> Nothing
Left s -> Just s
compareAllMediaFiles :: Archive -> Archive -> Maybe String
compareAllMediaFiles goldenArch testArch =
let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
mediaPattern = compile "*/media/*"
allMediaFiles = sort $
filter (match mediaPattern) allFiles
results =
mapMaybe (\fp -> compareMediaFile fp goldenArch testArch) allMediaFiles
in
if null results
then Nothing
else Just $ unlines results
ooxmlTest :: (WriterOptions -> Pandoc -> PandocIO BL.ByteString)
-> String
-> WriterOptions
-> FilePath
-> FilePath
-> TestTree
ooxmlTest writerFn testName opts nativeFP goldenFP =
goldenTest
testName
(goldenArchive goldenFP)
(testArchive writerFn opts nativeFP)
(\goldenArch testArch ->
let res = catMaybes [ compareFileList goldenFP goldenArch testArch
, compareAllXMLFiles goldenArch testArch
, compareAllMediaFiles goldenArch testArch
]
in return $ if null res then Nothing else Just $ unlines res)
(\a -> BL.writeFile goldenFP $ fromArchive a)
|
