xml-conduit 1.3.0 → 1.3.1
raw patch · 5 files changed
+239/−24 lines, 5 files
Files
- ChangeLog.md +4/−0
- LICENSE +16/−21
- Text/XML/Stream/Parse.hs +172/−1
- test/main.hs +45/−0
- xml-conduit.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.3.1++* Add functions to ignore subtrees & result-streaming (yield) parsers [#58](https://github.com/snoyberg/xml/pull/58)+ ## 1.3.0 * Drop system-filepath
LICENSE view
@@ -1,25 +1,20 @@-The following license covers this documentation, and the source code, except-where otherwise indicated.- Copyright 2010, Suite Solutions. All rights reserved. -Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--* Redistributions of source code must retain the above copyright notice, this- list of conditions and the following disclaimer.+Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions: -* Redistributions in binary form must reproduce the above copyright notice,- this list of conditions and the following disclaimer in the documentation- and/or other materials provided with the distribution.+The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO-EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT-NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,-OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Text/XML/Stream/Parse.hs view
@@ -43,6 +43,35 @@ -- -- > [Person {age = 25, name = "Michael"},Person {age = 2, name = "Eliezer"}] --+-- This module also supports streaming results using 'yield'.+-- This allows parser results to be processed using conduits+-- while a particular parser (e.g. 'many') is still running.+-- Without using streaming results, you have to wait until the parser finished+-- before you can process the result list. Large XML files might be easier+-- to process by using streaming results.+-- See http://stackoverflow.com/q/21367423/2597135 for a related discussion.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > import Control.Monad.Trans.Resource+-- > import Data.Conduit+-- > import Data.Text (Text, unpack)+-- > import Text.XML.Stream.Parse+-- > import Text.XML (Name)+-- > import Control.Monad.Trans.Class (lift)+-- > import Control.Monad (void)+-- > import qualified Data.Conduit.List as CL+-- >+-- > data Person = Person Int Text deriving Show+-- >+-- > parsePerson = tagName "person" (requireAttr "age") $ \age -> do+-- > name <- content+-- > return $ Person (read $ unpack age) name+-- >+-- > parsePeople = void $ tagNoAttr "people" $ manyYield parsePerson+-- >+-- > main = runResourceT $+-- > parseFile def "people.xml" $$ parsePeople =$ CL.mapM_ (lift . print)+-- -- Previous versions of this module contained a number of more sophisticated -- functions written by Aristid Breitkreuz and Dmitry Olshansky. To keep this -- package simpler, those functions are being moved to a separate package. This@@ -71,8 +100,20 @@ , tagPredicate , tagName , tagNoAttr+ , tagIgnoreAttrs+ , tagPredicateIgnoreAttrs , content , contentMaybe+ -- * Ignoring tags/trees+ , ignoreTag+ , ignoreTagName+ , ignoreAnyTagName+ , ignoreAllTags+ , ignoreTree+ , ignoreTreeName+ , ignoreAnyTreeName+ , ignoreAllTrees+ , ignoreAllTreesContent -- * Attribute parsing , AttrParser , attr@@ -85,7 +126,13 @@ , orE , choose , many+ , manyIgnore+ , many' , force+ -- * Streaming combinators+ , manyYield+ , manyIgnoreYield+ , manyYield' -- * Exceptions , XmlException (..) -- * Other types@@ -367,7 +414,7 @@ char' '-' char' '-' c <- T.pack <$> manyTill anyChar (string "-->") -- FIXME use takeWhile instead- return $ TokenComment c+ return $ TokenComment c parseCdata = do _ <- string "[CDATA[" t <- T.pack <$> manyTill anyChar (string "]]>") -- FIXME use takeWhile instead@@ -653,6 +700,79 @@ -> CI.ConduitM Event o m (Maybe a) tagNoAttr name f = tagName name (return ()) $ const f ++-- | A further simplified tag parser, which ignores all attributes, if any exist+tagIgnoreAttrs :: MonadThrow m+ => Name -- ^ The name this parser matches to+ -> CI.ConduitM Event o m a -- ^ Handler function to handle the children of the matched tag+ -> CI.ConduitM Event o m (Maybe a)+tagIgnoreAttrs name f = tagName name ignoreAttrs $ const f++-- | A further simplified tag parser, which ignores all attributes, if any exist+tagPredicateIgnoreAttrs :: MonadThrow m+ => (Name -> Bool) -- ^ The name predicate this parser matches to+ -> CI.ConduitM Event o m a -- ^ Handler function to handle the children of the matched tag+ -> CI.ConduitM Event o m (Maybe a)+tagPredicateIgnoreAttrs namePred f = tagPredicate namePred ignoreAttrs $ const f++-- | Ignore an empty tag and all of its attributes by predicate.+-- This does not ignore the tag recursively+-- (i.e. it assumes there are no child elements).+-- This functions returns 'Just' if the tag matched.+ignoreTag :: MonadThrow m+ => (Name -> Bool) -- ^ The predicate name to match to+ -> ConduitM Event o m (Maybe ())+ignoreTag namePred = tagPredicateIgnoreAttrs namePred (return ())++-- | Like 'ignoreTag', but matches an exact name+ignoreTagName :: MonadThrow m+ => Name -- ^ The name to match to+ -> ConduitM Event o m (Maybe ())+ignoreTagName name = ignoreTag (== name)++-- | Like 'ignoreTagName', but matches any name from a list of names.+ignoreAnyTagName :: MonadThrow m+ => [Name] -- ^ The name to match to+ -> ConduitM Event o m (Maybe ())+ignoreAnyTagName names = ignoreTag (`elem` names)++-- | Like 'ignoreTag', but matches all tag name.+--+-- > ignoreAllTags = ignoreTag (const True)+ignoreAllTags :: MonadThrow m => ConduitM Event o m (Maybe ())+ignoreAllTags = ignoreTag $ const True++-- | Ignore an empty tag, its attributes and its children subtree recursively.+-- Both content and text events are ignored.+-- This functions returns 'Just' if the tag matched.+ignoreTree :: MonadThrow m+ => (Name -> Bool) -- ^ The predicate name to match to+ -> ConduitM Event o m (Maybe ())+ignoreTree namePred =+ tagPredicateIgnoreAttrs namePred (const () <$> many ignoreAllTreesContent)++-- | Like 'ignoreTagName', but also ignores non-empty tabs+ignoreTreeName :: MonadThrow m+ => Name+ -> ConduitM Event o m (Maybe ())+ignoreTreeName name = ignoreTree (== name)++-- | Like 'ignoreTagName', but matches any name from a list of names.+ignoreAnyTreeName :: MonadThrow m+ => [Name] -- ^ The name to match to+ -> ConduitM Event o m (Maybe ())+ignoreAnyTreeName names = ignoreTree (`elem` names)++-- | Like 'ignoreAllTags', but ignores entire subtrees.+--+-- > ignoreAllTrees = ignoreTree (const True)+ignoreAllTrees :: MonadThrow m => ConduitM Event o m (Maybe ())+ignoreAllTrees = ignoreTree $ const True++-- | Like 'ignoreAllTrees', but also ignores all content events+ignoreAllTreesContent :: MonadThrow m => ConduitM Event o m (Maybe ())+ignoreAllTreesContent = (void <$> contentMaybe) `orE` ignoreAllTrees+ -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return @Just@), this function returns 'Nothing'. --@@ -786,6 +906,57 @@ go front = i >>= maybe (return $ front []) (\y -> go $ front . (:) y)++-- | Keep parsing elements as long as the parser returns 'Just'+-- or the ignore parser returns 'Just'.+manyIgnore :: Monad m+ => Consumer Event m (Maybe a)+ -> Consumer Event m (Maybe ())+ -> Consumer Event m [a]+manyIgnore i ignored =+ go id+ where+ go front = i >>=+ maybe (onFail front) (\y -> go $ front . (:) y)+ -- onFail is called if the main parser fails+ onFail front =+ ignored >>= maybe (return $ front []) (const $ go front)++-- | Like @many@, but any tags and content the consumer doesn't match on+-- are silently ignored.+many' :: MonadThrow m+ => Consumer Event m (Maybe a)+ -> Consumer Event m [a]+many' consumer = manyIgnore consumer ignoreAllTreesContent++-- | Like 'many', but uses 'yield' so the result list can be streamed+-- to downstream conduits without waiting for 'manyYield' to finished+manyYield :: Monad m+ => ConduitM a b m (Maybe b)+ -> Conduit a m b+manyYield consumer =+ loop+ where+ loop = consumer >>= maybe (return ()) (\x -> yield x >> loop)++-- | Like @manyIgnore@, but uses 'yield' so the result list can be streamed+-- to downstream conduits without waiting for 'manyYield' to finished+manyIgnoreYield :: MonadThrow m+ => ConduitM Event b m (Maybe b) -- ^ Consuming parser that generates the result stream+ -> Consumer Event m (Maybe ()) -- ^ Ignore parser that consumes elements to be ignored+ -> Conduit Event m b+manyIgnoreYield consumer ignoreParser =+ loop+ where+ loop = consumer >>= maybe onFail (\x -> yield x >> loop)+ onFail = ignoreParser >>= maybe (return ()) (const loop)++-- | Like @many'@, but uses 'yield' so the result list can be streamed+-- to downstream conduits without waiting for 'manyYield' to finished+manyYield' :: MonadThrow m+ => ConduitM Event b m (Maybe b)+ -> Conduit Event m b+manyYield' consumer = manyIgnoreYield consumer ignoreAllTreesContent type DecodeEntities = Text -> Content
test/main.hs view
@@ -20,6 +20,7 @@ import Text.XML.Cursor ((&/), (&//), (&.//), ($|), ($/), ($//), ($.//)) import Data.Text(Text) import Control.Monad+import Control.Applicative ((<$>)) import Control.Monad.Trans.Class (lift) import qualified Data.Text as T import qualified Data.Set as Set@@ -39,6 +40,8 @@ it "has valid parser combinators" combinators it "has working choose function" testChoose it "has working many function" testMany+ it "has working many' function" testMany'+ it "has working manyYield function" testManyYield it "has working orE" testOrE it "is idempotent to parse and pretty render a document" documentParsePrettyRender it "ignores the BOM" parseIgnoreBOM@@ -166,6 +169,28 @@ , "</hello>" ] +testManyYield :: Assertion+testManyYield = do+ -- Basically the same as testMany, but consume the streamed result+ result <- C.runResourceT $+ P.parseLBS def input C.$$ helloParser+ C.$= CL.consume+ length result @?= 5+ where+ helloParser = void $ P.tagNoAttr "hello" $ P.manyYield successParser+ successParser = P.tagNoAttr "success" $ return ()+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , "<success/>"+ , "<success/>"+ , "<success/>"+ , "<success/>"+ , "<success/>"+ , "</hello>"+ ]+ testMany :: Assertion testMany = C.runResourceT $ P.parseLBS def input C.$$ do P.force "need hello" $ P.tagNoAttr "hello" $ do@@ -180,6 +205,26 @@ , "<success/>" , "<success/>" , "<success/>"+ , "<success/>"+ , "</hello>"+ ]++testMany' :: Assertion+testMany' = C.runResourceT $ P.parseLBS def input C.$$ do+ P.force "need hello" $ P.tagNoAttr "hello" $ do+ x <- P.many' $ P.tagNoAttr "success" $ return ()+ liftIO $ length x @?= 5+ where+ input = L.concat+ [ "<?xml version='1.0'?>"+ , "<!DOCTYPE foo []>\n"+ , "<hello>"+ , "<success/>"+ , "<success/>"+ , "<success/>"+ , "<foobar/>"+ , "<success/>"+ , "<foo><bar attr=\"1\">some content</bar></foo>" , "<success/>" , "</hello>" ]
xml-conduit.cabal view
@@ -1,6 +1,6 @@ name: xml-conduit-version: 1.3.0-license: BSD3+version: 1.3.1+license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com> maintainer: Michael Snoyman <michael@snoyman.com>