Skip to content

Commit 8bac1ee

Browse files
Added failing diagnostic test for choosing
This demonstrates the issues with the current tokenisation.
1 parent 6bc6f65 commit 8bac1ee

File tree

1 file changed

+154
-3
lines changed

1 file changed

+154
-3
lines changed

xml-conduit/test/main.hs

Lines changed: 154 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ main = hspec $ do
3838
describe "XML parsing and rendering" $ do
3939
it "is idempotent to parse and render a document" documentParseRender
4040
it "has valid parser combinators" combinators
41-
it "has working choose function" testChoose
41+
context "has working choose function" testChoose
4242
it "has working many function" testMany
4343
it "has working many' function" testMany'
4444
it "has working manyYield function" testManyYield
@@ -155,8 +155,159 @@ combinators = C.runResourceT $ P.parseLBS def input C.$$ do
155155
, "</hello>"
156156
]
157157

158-
testChoose :: Assertion
159-
testChoose = C.runResourceT $ P.parseLBS def input C.$$ do
158+
testChoose :: Spec
159+
testChoose = do
160+
it "can choose between elements"
161+
testChooseEitherElem
162+
it "can choose between elements and text, returning text"
163+
testChooseElemOrTextIsText
164+
it "can choose between elements and text, returning elements"
165+
testChooseElemOrTextIsElem
166+
it "can choose between text and elements, returning text"
167+
testChooseTextOrElemIsText
168+
it "can choose between text and elements, returning elements"
169+
testChooseTextOrElemIsElem
170+
it "can choose between text and elements, when the text is encoded"
171+
testChooseElemOrTextIsEncoded
172+
it "can choose between text and elements, when the text is whitespace"
173+
testChooseElemOrTextIsWhiteSpace
174+
it "can choose betwen text and elements, when the whitespace is both literal and encoded"
175+
testChooseElemOrTextIsChunkedText
176+
it "can choose between text and elements, when the text is chunked the other way"
177+
testChooseElemOrTextIsChunkedText2
178+
179+
testChooseElemOrTextIsText :: Assertion
180+
testChooseElemOrTextIsText = C.runResourceT $ P.parseLBS def input C.$$ do
181+
P.force "need hello" $ P.tagNoAttr "hello" $ do
182+
x <- P.choose
183+
[ P.tagNoAttr "failure" $ return "boom"
184+
, P.contentMaybe
185+
]
186+
liftIO $ x @?= Just " something "
187+
where
188+
input = L.concat
189+
[ "<?xml version='1.0'?>"
190+
, "<!DOCTYPE foo []>\n"
191+
, "<hello>"
192+
, " something "
193+
, "</hello>"
194+
]
195+
196+
testChooseElemOrTextIsEncoded :: Assertion
197+
testChooseElemOrTextIsEncoded = C.runResourceT $ P.parseLBS def input C.$$ do
198+
P.force "need hello" $ P.tagNoAttr "hello" $ do
199+
x <- P.choose
200+
[ P.tagNoAttr "failure" $ return "boom"
201+
, P.contentMaybe
202+
]
203+
liftIO $ x @?= Just "\160something\160"
204+
where
205+
input = L.concat
206+
[ "<?xml version='1.0'?>"
207+
, "<!DOCTYPE foo []>\n"
208+
, "<hello>"
209+
, "&#160;something&#160;"
210+
, "</hello>"
211+
]
212+
213+
testChooseElemOrTextIsWhiteSpace :: Assertion
214+
testChooseElemOrTextIsWhiteSpace = C.runResourceT $ P.parseLBS def input C.$$ do
215+
P.force "need hello" $ P.tagNoAttr "hello" $ do
216+
x <- P.choose
217+
[ P.tagNoAttr "failure" $ return "boom"
218+
, P.contentMaybe
219+
]
220+
liftIO $ x @?= Just "\x20\x20\x20"
221+
where
222+
input = L.concat
223+
[ "<?xml version='1.0'?>"
224+
, "<!DOCTYPE foo []>\n"
225+
, "<hello> </hello>"
226+
]
227+
228+
testChooseElemOrTextIsChunkedText :: Assertion
229+
testChooseElemOrTextIsChunkedText = C.runResourceT $ P.parseLBS def input C.$$ do
230+
P.force "need hello" $ P.tagNoAttr "hello" $ do
231+
x <- P.choose
232+
[ P.tagNoAttr "failure" $ return "boom"
233+
, P.contentMaybe
234+
]
235+
liftIO $ x @?= Just "\x20\x20\x20"
236+
where
237+
input = L.concat
238+
[ "<?xml version='1.0'?>"
239+
, "<!DOCTYPE foo []>\n"
240+
, "<hello> &#x20; </hello>"
241+
]
242+
243+
testChooseElemOrTextIsChunkedText2 :: Assertion
244+
testChooseElemOrTextIsChunkedText2 = C.runResourceT $ P.parseLBS def input C.$$ do
245+
P.force "need hello" $ P.tagNoAttr "hello" $ do
246+
x <- P.choose
247+
[ P.tagNoAttr "failure" $ return "boom"
248+
, P.contentMaybe
249+
]
250+
liftIO $ x @?= Just "\x20\x20\x20"
251+
where
252+
input = L.concat
253+
[ "<?xml version='1.0'?>"
254+
, "<!DOCTYPE foo []>\n"
255+
, "<hello>&#x20; &#x20;</hello>"
256+
]
257+
258+
testChooseElemOrTextIsElem :: Assertion
259+
testChooseElemOrTextIsElem = C.runResourceT $ P.parseLBS def input C.$$ do
260+
P.force "need hello" $ P.tagNoAttr "hello" $ do
261+
x <- P.choose
262+
[ P.tagNoAttr "success" $ return "success"
263+
, P.contentMaybe
264+
]
265+
liftIO $ x @?= Just "success"
266+
where
267+
input = L.concat
268+
[ "<?xml version='1.0'?>"
269+
, "<!DOCTYPE foo []>\n"
270+
, "<hello>"
271+
, "<success/>"
272+
, "</hello>"
273+
]
274+
275+
testChooseTextOrElemIsText :: Assertion
276+
testChooseTextOrElemIsText = C.runResourceT $ P.parseLBS def input C.$$ do
277+
P.force "need hello" $ P.tagNoAttr "hello" $ do
278+
x <- P.choose
279+
[ P.contentMaybe
280+
, P.tagNoAttr "failure" $ return "boom"
281+
]
282+
liftIO $ x @?= Just " something "
283+
where
284+
input = L.concat
285+
[ "<?xml version='1.0'?>"
286+
, "<!DOCTYPE foo []>\n"
287+
, "<hello>"
288+
, " something "
289+
, "</hello>"
290+
]
291+
292+
testChooseTextOrElemIsElem :: Assertion
293+
testChooseTextOrElemIsElem = C.runResourceT $ P.parseLBS def input C.$$ do
294+
P.force "need hello" $ P.tagNoAttr "hello" $ do
295+
x <- P.choose
296+
[ P.contentMaybe
297+
, P.tagNoAttr "success" $ return "success"
298+
]
299+
liftIO $ x @?= Just "success"
300+
where
301+
input = L.concat
302+
[ "<?xml version='1.0'?>"
303+
, "<!DOCTYPE foo []>\n"
304+
, "<hello>"
305+
, "<success/>"
306+
, "</hello>"
307+
]
308+
309+
testChooseEitherElem :: Assertion
310+
testChooseEitherElem = C.runResourceT $ P.parseLBS def input C.$$ do
160311
P.force "need hello" $ P.tagNoAttr "hello" $ do
161312
x <- P.choose
162313
[ P.tagNoAttr "failure" $ return 1

0 commit comments

Comments
 (0)