xml-conduit 1.3.3.1 → 1.3.4
raw patch · 4 files changed
+219/−13 lines, 4 files
Files
- ChangeLog.md +4/−0
- Text/XML/Stream/Parse.hs +23/−9
- test/main.hs +191/−3
- xml-conduit.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.3.4++* dropWS retains consumed whitespace values [#74](https://github.com/snoyberg/xml/issues/74) [#75](https://github.com/snoyberg/xml/pull/75) [#76](https://github.com/snoyberg/xml/pull/76)+ ## 1.3.3.1 * Generalize signature of choose (Fixes [#72](https://github.com/snoyberg/xml/issues/72)) [#73](https://github.com/snoyberg/xml/pull/73)
Text/XML/Stream/Parse.hs view
@@ -652,27 +652,38 @@ -- of a tag, given the value return from the @AttrParser@ -> CI.ConduitM Event o m (Maybe c) tag checkName attrParser f = do- x <- dropWS- case x of+ (x, leftovers) <- dropWS []+ res <- case x of Just (EventBeginElement name as) -> case checkName name of Just y -> case runAttrParser' (attrParser y) as of Left e -> lift $ monadThrow e Right z -> do- CL.drop 1 z' <- f z- a <- dropWS+ (a, _leftovers') <- dropWS [] case a of Just (EventEndElement name')- | name == name' -> CL.drop 1 >> return (Just z')+ | name == name' -> return (Just z') _ -> lift $ monadThrow $ XmlException ("Expected end tag for: " ++ show name) a Nothing -> return Nothing _ -> return Nothing++ case res of+ -- Did not parse, put back all of the leading whitespace events and the+ -- final observed event generated by dropWS+ Nothing -> mapM_ leftover leftovers+ -- Parse succeeded, discard all of those whitespace events and the+ -- first parsed event+ Just _ -> return ()++ return res where- -- Drop Events until we encount a non-whitespace element- dropWS = do- x <- CL.peek+ -- Drop Events until we encounter a non-whitespace element. Return all of+ -- the events consumed here (including the first non-whitespace event) so+ -- that the calling function can treat them as leftovers if the parse fails+ dropWS leftovers = do+ x <- await let isWS = case x of Just EventBeginDocument -> True@@ -689,7 +700,10 @@ Just EventComment{} -> True Just EventCDATA{} -> False Nothing -> False- if isWS then CL.drop 1 >> dropWS else return x+ leftovers' = maybe id (:) x leftovers+ if isWS+ then dropWS leftovers'+ else return (x, leftovers') runAttrParser' p as = case runAttrParser p as of Left e -> Left e
test/main.hs view
@@ -38,7 +38,7 @@ describe "XML parsing and rendering" $ do it "is idempotent to parse and render a document" documentParseRender it "has valid parser combinators" combinators- it "has working choose function" testChoose+ context "has working choose function" testChoose it "has working many function" testMany it "has working many' function" testMany' it "has working manyYield function" testManyYield@@ -155,8 +155,196 @@ , "</hello>" ] -testChoose :: Assertion-testChoose = C.runResourceT $ P.parseLBS def input C.$$ do+testChoose :: Spec+testChoose = do+ it "can choose between elements"+ testChooseEitherElem+ it "can choose between elements and text, returning text"+ testChooseElemOrTextIsText+ it "can choose between elements and text, returning elements"+ testChooseElemOrTextIsElem+ it "can choose between text and elements, returning text"+ testChooseTextOrElemIsText+ it "can choose between text and elements, returning elements"+ testChooseTextOrElemIsElem+ it "can choose between text and elements, when the text is encoded"+ testChooseElemOrTextIsEncoded+ it "can choose between text and elements, when the text is encoded, NBSP"+ testChooseElemOrTextIsEncodedNBSP+ it "can choose between elements and text, when the text is whitespace"+ testChooseElemOrTextIsWhiteSpace+ it "can choose between text and elements, when the text is whitespace"+ testChooseTextOrElemIsWhiteSpace+ it "can choose betwen text and elements, when the whitespace is both literal and encoded"+ testChooseElemOrTextIsChunkedText+ it "can choose between text and elements, when the text is chunked the other way"+ testChooseElemOrTextIsChunkedText2++testChooseElemOrTextIsText :: Assertion+testChooseElemOrTextIsText = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.tagNoAttr "failure" $ return "boom"+ , P.contentMaybe+ ]+ liftIO $ x @?= Just " something "+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , " something "+ , "</hello>"+ ]++testChooseElemOrTextIsEncoded :: Assertion+testChooseElemOrTextIsEncoded = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.tagNoAttr "failure" $ return "boom"+ , P.contentMaybe+ ]+ liftIO $ x @?= Just "\x20something\x20"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , " something "+ , "</hello>"+ ]++testChooseElemOrTextIsEncodedNBSP :: Assertion+testChooseElemOrTextIsEncodedNBSP = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.tagNoAttr "failure" $ return "boom"+ , P.contentMaybe+ ]+ liftIO $ x @?= Just "\160something\160"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , " something "+ , "</hello>"+ ]+++testChooseElemOrTextIsWhiteSpace :: Assertion+testChooseElemOrTextIsWhiteSpace = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.tagNoAttr "failure" $ return "boom"+ , P.contentMaybe+ ]+ liftIO $ x @?= Just "\x20\x20\x20"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello> </hello>"+ ]++testChooseTextOrElemIsWhiteSpace :: Assertion+testChooseTextOrElemIsWhiteSpace = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.contentMaybe+ , P.tagNoAttr "failure" $ return "boom"+ ]+ liftIO $ x @?= Just "\x20\x20\x20"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello> </hello>"+ ]++testChooseElemOrTextIsChunkedText :: Assertion+testChooseElemOrTextIsChunkedText = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.tagNoAttr "failure" $ return "boom"+ , P.contentMaybe+ ]+ liftIO $ x @?= Just "\x20\x20\x20"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>   </hello>"+ ]++testChooseElemOrTextIsChunkedText2 :: Assertion+testChooseElemOrTextIsChunkedText2 = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.tagNoAttr "failure" $ return "boom"+ , P.contentMaybe+ ]+ liftIO $ x @?= Just "\x20\x20\x20"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>   </hello>"+ ]++testChooseElemOrTextIsElem :: Assertion+testChooseElemOrTextIsElem = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.tagNoAttr "success" $ return "success"+ , P.contentMaybe+ ]+ liftIO $ x @?= Just "success"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , "<success/>"+ , "</hello>"+ ]++testChooseTextOrElemIsText :: Assertion+testChooseTextOrElemIsText = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.contentMaybe+ , P.tagNoAttr "failure" $ return "boom"+ ]+ liftIO $ x @?= Just " something "+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , " something "+ , "</hello>"+ ]++testChooseTextOrElemIsElem :: Assertion+testChooseTextOrElemIsElem = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.choose+ [ P.contentMaybe+ , P.tagNoAttr "success" $ return "success"+ ]+ liftIO $ x @?= Just "success"+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , "<success/>"+ , "</hello>"+ ]++testChooseEitherElem :: Assertion+testChooseEitherElem = C.runResourceT $ P.parseLBS def input C.$$ do P.force "need hello" $ P.tagNoAttr "hello" $ do x <- P.choose [ P.tagNoAttr "failure" $ return 1
xml-conduit.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-version: 1.3.3.1+version: 1.3.4 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com>