Hello community,
here is the log from the commit of package ghc-xml-conduit for openSUSE:Factory checked in at 2015-08-15 11:39:39
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-xml-conduit (Old)
and /work/SRC/openSUSE:Factory/.ghc-xml-conduit.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-xml-conduit"
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-xml-conduit/ghc-xml-conduit.changes 2015-07-24 09:58:13.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-xml-conduit.new/ghc-xml-conduit.changes 2015-08-15 11:39:41.000000000 +0200
@@ -1,0 +2,7 @@
+Fri Aug 7 08:47:05 UTC 2015 - mimi.vx@gmail.com
+
+- update to 1.3.1
+* Add functions to ignore subtrees & result-streaming (yield) parsers
+* Drop system-filepath
+
+-------------------------------------------------------------------
Old:
----
xml-conduit-1.2.6.tar.gz
New:
----
xml-conduit-1.3.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-xml-conduit.spec ++++++
--- /var/tmp/diff_new_pack.as4izK/_old 2015-08-15 11:39:41.000000000 +0200
+++ /var/tmp/diff_new_pack.as4izK/_new 2015-08-15 11:39:41.000000000 +0200
@@ -20,7 +20,7 @@
%bcond_with tests
Name: ghc-xml-conduit
-Version: 1.2.6
+Version: 1.3.1
Release: 0
Summary: Pure-Haskell utilities for dealing with XML with the conduit package
Group: System/Libraries
@@ -45,7 +45,6 @@
BuildRequires: ghc-deepseq-devel
BuildRequires: ghc-monad-control-devel
BuildRequires: ghc-resourcet-devel
-BuildRequires: ghc-system-filepath-devel
BuildRequires: ghc-text-devel
BuildRequires: ghc-transformers-devel
BuildRequires: ghc-xml-types-devel
++++++ xml-conduit-1.2.6.tar.gz -> xml-conduit-1.3.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.2.6/ChangeLog.md new/xml-conduit-1.3.1/ChangeLog.md
--- old/xml-conduit-1.2.6/ChangeLog.md 2015-05-09 20:22:30.000000000 +0200
+++ new/xml-conduit-1.3.1/ChangeLog.md 2015-07-17 02:35:37.000000000 +0200
@@ -1,3 +1,11 @@
+## 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
+
## 1.2.6
* Reuse 'MonadThrow' and 'force' for 'AttrParser' [#52](https://github.com/snoyberg/xml/pull/52)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.2.6/LICENSE new/xml-conduit-1.3.1/LICENSE
--- old/xml-conduit-1.2.6/LICENSE 2015-05-09 20:22:30.000000000 +0200
+++ new/xml-conduit-1.3.1/LICENSE 2015-07-17 02:35:37.000000000 +0200
@@ -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.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.2.6/Text/XML/Stream/Parse.hs new/xml-conduit-1.3.1/Text/XML/Stream/Parse.hs
--- old/xml-conduit-1.2.6/Text/XML/Stream/Parse.hs 2015-05-09 20:22:30.000000000 +0200
+++ new/xml-conduit-1.3.1/Text/XML/Stream/Parse.hs 2015-07-17 02:35:37.000000000 +0200
@@ -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
@@ -130,8 +177,7 @@
import Data.Text.Read (Reader, decimal, hexadecimal)
import Data.Typeable (Typeable)
import Data.Word (Word32)
-import Filesystem.Path.CurrentOS (FilePath, encodeString)
-import Prelude hiding (FilePath, takeWhile)
+import Prelude hiding (takeWhile)
import Text.XML.Stream.Token
type Ents = [(Text, Text)]
@@ -368,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
@@ -654,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'.
--
@@ -691,7 +810,7 @@
=> ParseSettings
-> FilePath
-> Producer m Event
-parseFile ps fp = sourceFile (encodeString fp) =$= parseBytes ps
+parseFile ps fp = sourceFile fp =$= parseBytes ps
-- | Parse an event stream from a lazy 'L.ByteString'.
parseLBS :: MonadThrow m
@@ -788,6 +907,57 @@
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
-- | Default implementation of 'DecodeEntities': handles numeric entities and
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.2.6/Text/XML/Unresolved.hs new/xml-conduit-1.3.1/Text/XML/Unresolved.hs
--- old/xml-conduit-1.2.6/Text/XML/Unresolved.hs 2015-05-09 20:22:30.000000000 +0200
+++ new/xml-conduit-1.3.1/Text/XML/Unresolved.hs 2015-07-17 02:35:37.000000000 +0200
@@ -41,8 +41,7 @@
, R.rsNamespaces
) where
-import Prelude hiding (writeFile, readFile, FilePath)
-import Filesystem.Path.CurrentOS (FilePath, encodeString)
+import Prelude hiding (writeFile, readFile)
import Data.XML.Types
import Control.Exception (Exception, SomeException)
import Data.Typeable (Typeable)
@@ -69,7 +68,7 @@
import Data.Conduit.Lazy (lazyConsume)
readFile :: P.ParseSettings -> FilePath -> IO Document
-readFile ps fp = runResourceT $ CB.sourceFile (encodeString fp) $$ sinkDoc ps
+readFile ps fp = runResourceT $ CB.sourceFile fp $$ sinkDoc ps
sinkDoc :: MonadThrow m
=> P.ParseSettings
@@ -78,7 +77,7 @@
writeFile :: R.RenderSettings -> FilePath -> Document -> IO ()
writeFile rs fp doc =
- runResourceT $ renderBytes rs doc $$ CB.sinkFile (encodeString fp)
+ runResourceT $ renderBytes rs doc $$ CB.sinkFile fp
renderLBS :: R.RenderSettings -> Document -> L.ByteString
renderLBS rs doc =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.2.6/Text/XML.hs new/xml-conduit-1.3.1/Text/XML.hs
--- old/xml-conduit-1.2.6/Text/XML.hs 2015-05-09 20:22:30.000000000 +0200
+++ new/xml-conduit-1.3.1/Text/XML.hs 2015-07-17 02:35:37.000000000 +0200
@@ -91,8 +91,7 @@
import qualified Data.Text as T
import Data.Either (partitionEithers)
import Control.Monad.Trans.Resource (MonadThrow, monadThrow, runExceptionT, runResourceT)
-import Prelude hiding (readFile, writeFile, FilePath)
-import Filesystem.Path.CurrentOS (FilePath, encodeString)
+import Prelude hiding (readFile, writeFile)
import Control.Exception (SomeException, Exception, throwIO, handle)
import Text.XML.Stream.Parse (ParseSettings, def, psDecodeEntities)
import Data.ByteString (ByteString)
@@ -230,7 +229,7 @@
readFile :: ParseSettings -> FilePath -> IO Document
readFile ps fp = handle
(throwIO . InvalidXMLFile fp)
- (runResourceT $ CB.sourceFile (encodeString fp) $$ sinkDoc ps)
+ (runResourceT $ CB.sourceFile fp $$ sinkDoc ps)
data XMLException = InvalidXMLFile FilePath SomeException
deriving Typeable
@@ -238,7 +237,7 @@
instance Show XMLException where
show (InvalidXMLFile fp e) = concat
[ "Error parsing XML file "
- , encodeString fp
+ , fp
, ": "
, show e
]
@@ -286,7 +285,7 @@
writeFile :: R.RenderSettings -> FilePath -> Document -> IO ()
writeFile rs fp doc =
- runResourceT $ renderBytes rs doc $$ CB.sinkFile (encodeString fp)
+ runResourceT $ renderBytes rs doc $$ CB.sinkFile fp
renderLBS :: R.RenderSettings -> Document -> L.ByteString
renderLBS rs doc =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.2.6/test/main.hs new/xml-conduit-1.3.1/test/main.hs
--- old/xml-conduit-1.2.6/test/main.hs 2015-05-09 20:22:30.000000000 +0200
+++ new/xml-conduit-1.3.1/test/main.hs 2015-07-17 02:35:37.000000000 +0200
@@ -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
@@ -183,6 +208,26 @@
, "<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>