xml-conduit 1.3.5 → 1.4.0

raw patch · 8 files changed

+359/−287 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Text/XML.hs +70/−73
• Text/XML/Cursor.hs +33/−36
• Text/XML/Stream/Parse.hs +158/−110
• Text/XML/Stream/Render.hs +5/−4
• Text/XML/Unresolved.hs +38/−38
• test/main.hs +49/−25
• xml-conduit.cabal +1/−1

@@ -1,3 +1,8 @@+## 1.4.0++* Improve XmlException definition and usage+* Add 'takeAllTreesContent' function+ ## 1.3.5  * Improvements for using xml-conduit for streaming XML protocols [#85](https://github.com/snoyberg/xml/pull/85)

@@ -1,9 +1,9 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE PatternGuards      #-}+{-# LANGUAGE RankNTypes         #-} -- | DOM-based parsing and rendering. -- -- This module requires that all entities be resolved at parsing. If you need@@ -73,58 +73,56 @@     , fromXMLElement     ) where -import qualified Data.XML.Types as X-import Data.XML.Types-    ( Prologue (..)-    , Miscellaneous (..)-    , Instruction (..)-    , Name (..)-    , Doctype (..)-    , ExternalID (..)-    )-import Data.Typeable (Typeable)-import Data.Data (Data)-import Control.DeepSeq(NFData(rnf))-import Data.Text (Text)-import qualified Text.XML.Stream.Parse as P-import qualified Text.XML.Unresolved as D-import qualified Text.XML.Stream.Render as R-import qualified Data.Text as T-import Data.Either (partitionEithers)-import Control.Monad.Trans.Resource (MonadThrow, monadThrow, runExceptionT, runResourceT)-import Prelude hiding (readFile, writeFile)-import Control.Exception (SomeException, Exception, throwIO, handle)-import Text.XML.Stream.Parse (ParseSettings, def, psDecodeEntities)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as L-import Control.Monad.ST (runST)-import qualified Data.Set as Set-import qualified Data.Map as Map-import Data.Set (Set)+import           Control.Applicative          ((<$>))+import           Control.DeepSeq              (NFData (rnf))+import           Control.Exception            (Exception, SomeException, handle,+                                               throw, throwIO)+import           Control.Monad.ST             (runST)+import           Control.Monad.Trans.Resource (MonadThrow, monadThrow,+                                               runExceptionT, runResourceT)+import           Data.ByteString              (ByteString)+import qualified Data.ByteString.Lazy         as L+import           Data.Data                    (Data)+import           Data.Either                  (partitionEithers)+import qualified Data.Map                     as Map+import           Data.Set                     (Set)+import qualified Data.Set                     as Set+import           Data.Text                    (Text)+import qualified Data.Text                    as T+import           Data.Typeable                (Typeable)+import           Data.XML.Types               (Doctype (..), ExternalID (..),+                                               Instruction (..),+                                               Miscellaneous (..), Name (..),+                                               Prologue (..))+import qualified Data.XML.Types               as X+import           Prelude                      hiding (readFile, writeFile)+import           Text.XML.Stream.Parse        (ParseSettings, def,+                                               psDecodeEntities)+import qualified Text.XML.Stream.Parse        as P+import qualified Text.XML.Stream.Render       as R+import qualified Text.XML.Unresolved          as D -import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE-import Data.Conduit-import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Binary as CB-import System.IO.Unsafe (unsafePerformIO)-import Control.Exception (throw)-import Control.Monad.Trans.Resource (runExceptionT)-import Control.Monad.Trans.Class (lift)-import Data.Conduit.Lazy (lazyConsume)+import           Control.Monad.Trans.Class    (lift)+import           Data.Conduit+import qualified Data.Conduit.Binary          as CB+import           Data.Conduit.Lazy            (lazyConsume)+import qualified Data.Conduit.List            as CL+import qualified Data.Text.Lazy               as TL+import qualified Data.Text.Lazy.Encoding      as TLE+import           System.IO.Unsafe             (unsafePerformIO) -import qualified Text.Blaze as B-import qualified Text.Blaze.Html as B-import qualified Text.Blaze.Html5 as B5-import qualified Text.Blaze.Internal as BI-import Data.Monoid (mempty, mappend)-import Data.String (fromString)-import Data.List (foldl')-import Control.Arrow (first)+import           Control.Arrow                (first)+import           Data.List                    (foldl')+import           Data.Monoid                  (mappend, mempty)+import           Data.String                  (fromString)+import qualified Text.Blaze                   as B+import qualified Text.Blaze.Html              as B+import qualified Text.Blaze.Html5             as B5+import qualified Text.Blaze.Internal          as BI  data Document = Document     { documentPrologue :: Prologue-    , documentRoot :: Element+    , documentRoot     :: Element     , documentEpilogue :: [Miscellaneous]     }   deriving (Show, Eq, Typeable, Data)@@ -143,16 +141,16 @@  #if MIN_VERSION_containers(0, 4, 2) instance NFData Node where-  rnf (NodeElement e) = rnf e `seq` ()+  rnf (NodeElement e)     = rnf e `seq` ()   rnf (NodeInstruction i) = rnf i `seq` ()-  rnf (NodeContent t) = rnf t `seq` ()-  rnf (NodeComment t) = rnf t `seq` ()+  rnf (NodeContent t)     = rnf t `seq` ()+  rnf (NodeComment t)     = rnf t `seq` () #endif  data Element = Element-    { elementName :: Name+    { elementName       :: Name     , elementAttributes :: Map.Map Name Text-    , elementNodes :: [Node]+    , elementNodes      :: [Node]     }   deriving (Show, Eq, Ord, Typeable, Data) @@ -186,24 +184,24 @@ toXMLNode = toXMLNode' def  toXMLNode' :: R.RenderSettings -> Node -> X.Node-toXMLNode' rs (NodeElement e) = X.NodeElement $ toXMLElement' rs e-toXMLNode' _ (NodeContent t) = X.NodeContent $ X.ContentText t-toXMLNode' _ (NodeComment c) = X.NodeComment c+toXMLNode' rs (NodeElement e)    = X.NodeElement $ toXMLElement' rs e+toXMLNode' _ (NodeContent t)     = X.NodeContent $ X.ContentText t+toXMLNode' _ (NodeComment c)     = X.NodeComment c toXMLNode' _ (NodeInstruction i) = X.NodeInstruction i  fromXMLDocument :: X.Document -> Either (Set Text) Document fromXMLDocument (X.Document a b c) =     case fromXMLElement b of-        Left es -> Left es+        Left es  -> Left es         Right b' -> Right $ Document a b' c  fromXMLElement :: X.Element -> Either (Set Text) Element fromXMLElement (X.Element name as nodes) =     case (lnodes, las) of         ([], []) -> Right $ Element name ras rnodes-        (x, []) -> Left $ Set.unions x-        ([], y) -> Left $ Set.unions y-        (x, y) -> Left $ Set.unions x `Set.union` Set.unions y+        (x, [])  -> Left $ Set.unions x+        ([], y)  -> Left $ Set.unions y+        (x, y)   -> Left $ Set.unions x `Set.union` Set.unions y   where     enodes = map fromXMLNode nodes     (lnodes, rnodes) = partitionEithers enodes@@ -212,16 +210,15 @@     ras = Map.fromList ras'     go (x, y) =         case go' [] id y of-            Left es -> Left es+            Left es  -> Left es             Right y' -> Right (x, y')-    go' [] front [] = Right $ T.concat $ front []-    go' errs _ [] = Left $ Set.fromList errs-    go' errs front (X.ContentText t:ys) = go' errs (front . (:) t) ys+    go' [] front []                       = Right $ T.concat $ front []+    go' errs _ []                         = Left $ Set.fromList errs+    go' errs front (X.ContentText t:ys)   = go' errs (front . (:) t) ys     go' errs front (X.ContentEntity t:ys) = go' (t : errs) front ys  fromXMLNode :: X.Node -> Either (Set Text) Node-fromXMLNode (X.NodeElement e) =-    either Left (Right . NodeElement) $ fromXMLElement e+fromXMLNode (X.NodeElement e) = NodeElement <$> fromXMLElement e fromXMLNode (X.NodeContent (X.ContentText t)) = Right $ NodeContent t fromXMLNode (X.NodeContent (X.ContentEntity t)) = Left $ Set.singleton t fromXMLNode (X.NodeComment c) = Right $ NodeComment c@@ -324,7 +321,7 @@         childrenHtml =             case (name `elem` ["style", "script"], children) of                 (True, [NodeContent t]) -> B.preEscapedToMarkup t-                _ -> mapM_ B.toMarkup children+                _                       -> mapM_ B.toMarkup children          isVoid = nameLocalName name' `Set.member` voidElems @@ -339,13 +336,13 @@         close = fromString $ concat ["</", name, ">"]          attrs' :: [B.Attribute]-        attrs' = map goAttr $ map (first nameLocalName) $ Map.toList attrs+        attrs' = map (goAttr . first nameLocalName) $ Map.toList attrs         goAttr (key, value) = B.customAttribute (B.textTag key) $ B.toValue value  instance B.ToMarkup Node where     toMarkup (NodeElement e) = B.toMarkup e     toMarkup (NodeContent t) = B.toMarkup t-    toMarkup _ = mempty+    toMarkup _               = mempty  voidElems :: Set.Set T.Text voidElems = Set.fromAscList $ T.words $ T.pack "area base br col command embed hr img input keygen link meta param source track wbr"

@@ -60,33 +60,34 @@  import           Control.Exception            (Exception) import           Control.Monad-import           Data.Function                (on)-import           Text.XML import           Control.Monad.Trans.Resource (MonadThrow, monadThrow)-import qualified Data.Text                    as T+import           Data.Function                (on) import qualified Data.Map                     as Map-import qualified Text.XML.Cursor.Generic      as CG-import           Text.XML.Cursor.Generic      (node, child, parent, descendant, orSelf) import           Data.Maybe                   (maybeToList)+import qualified Data.Text                    as T+import           Text.XML+import           Text.XML.Cursor.Generic      (child, descendant, node, orSelf,+                                               parent)+import qualified Text.XML.Cursor.Generic      as CG  -- TODO: Consider [Cursor] -> [Cursor]? -- | The type of an Axis that returns a list of Cursors. -- They are roughly modeled after <http://www.w3.org/TR/xpath/#axes>.--- +-- -- Axes can be composed with '>=>', where e.g. @f >=> g@ means that on all results of--- the @f@ axis, the @g@ axis will be applied, and all results joined together. +-- the @f@ axis, the @g@ axis will be applied, and all results joined together. -- Because Axis is just a type synonym for @Cursor -> [Cursor]@, it is possible to use -- other standard functions like '>>=' or 'concatMap' similarly.--- +-- -- The operators '&|', '&/', '&//' and '&.//' can be used to combine axes so that the second--- axis works on the context nodes, children, descendants, respectively the context node as +-- axis works on the context nodes, children, descendants, respectively the context node as -- well as its descendants of the results of the first axis.--- +-- -- The operators '$|', '$/', '$//' and '$.//' can be used to apply an axis (right-hand side) -- to a cursor so that it is applied on the cursor itself, its children, its descendants, -- respectively itself and its descendants.--- --- Note that many of these operators also work on /generalised Axes/ that can return +--+-- Note that many of these operators also work on /generalised Axes/ that can return -- lists of something other than Cursors, for example Content elements. type Axis = Cursor -> [Cursor] @@ -97,11 +98,11 @@ class Boolean a where     bool :: a -> Bool -instance Boolean Bool where +instance Boolean Bool where     bool = id-instance Boolean [a] where +instance Boolean [a] where     bool = not . null-instance Boolean (Maybe a) where +instance Boolean (Maybe a) where     bool (Just _) = True     bool _        = False instance Boolean (Either a b) where@@ -125,29 +126,25 @@     CG.toCursor cs   where     cs (NodeElement (Element _ _ x)) = x-    cs _ = []+    cs _                             = []  -- | Filter cursors that don't pass a check. check :: Boolean b => (Cursor -> b) -> Axis-check f c = case bool $ f c of-              False -> []-              True -> [c]+check f c = [c | bool $ f c]  -- | Filter nodes that don't pass a check. checkNode :: Boolean b => (Node -> b) -> Axis-checkNode f c = check (f . node) c+checkNode f = check (f . node)  -- | Filter elements that don't pass a check, and remove all non-elements. checkElement :: Boolean b => (Element -> b) -> Axis checkElement f c = case node c of-                     NodeElement e -> case bool $ f e of-                                        True -> [c]-                                        False -> []+                     NodeElement e -> [c | bool $ f e]                      _ -> []  -- | Filter elements that don't pass a name check, and remove all non-elements. checkName :: Boolean b => (Name -> b) -> Axis-checkName f c = checkElement (f . elementName) c+checkName f = checkElement (f . elementName)  -- | Remove all non-elements. Compare roughly to XPath: -- /A node test * is true for any node of the principal node type. For example, child::* will select all element children of the context node [...]/.@@ -166,7 +163,7 @@  -- | Select only text nodes, and directly give the 'Content' values. XPath: -- /The node test text() is true for any text node./--- +-- -- Note that this is not strictly an 'Axis', but will work with most combinators. content :: Cursor -> [T.Text] content c = case node c of@@ -175,23 +172,23 @@  -- | Select attributes on the current element (or nothing if it is not an element). XPath: -- /the attribute axis contains the attributes of the context node; the axis will be empty unless the context node is an element/--- +-- -- Note that this is not strictly an 'Axis', but will work with most combinators.--- --- The return list of the generalised axis contains as elements lists of 'Content' +--+-- The return list of the generalised axis contains as elements lists of 'Content' -- elements, each full list representing an attribute value. attribute :: Name -> Cursor -> [T.Text] attribute n c =     case node c of         NodeElement e -> maybeToList $ Map.lookup n $ elementAttributes e-        _ -> []+        _             -> []  -- | Select attributes on the current element (or nothing if it is not an element).  Namespace and case are ignored. XPath: -- /the attribute axis contains the attributes of the context node; the axis will be empty unless the context node is an element/--- +-- -- Note that this is not strictly an 'Axis', but will work with most combinators.--- --- The return list of the generalised axis contains as elements lists of 'Content' +--+-- The return list of the generalised axis contains as elements lists of 'Content' -- elements, each full list representing an attribute value. laxAttribute :: T.Text -> Cursor -> [T.Text] laxAttribute n c =@@ -213,13 +210,13 @@ attributeIs :: Name -> T.Text -> Axis attributeIs n v c =     case node c of-        NodeElement (Element _ as _) -> if Just v == Map.lookup n as then [c] else []-        _ -> []+        NodeElement (Element _ as _) -> [ c | Just v == Map.lookup n as]+        _                            -> []  force :: (Exception e, MonadThrow f) => e -> [a] -> f a-force e [] = monadThrow e+force e []    = monadThrow e force _ (x:_) = return x  forceM :: (Exception e, MonadThrow f) => e -> [f a] -> f a-forceM e [] = monadThrow e+forceM e []    = monadThrow e forceM _ (x:_) = x

@@ -1,9 +1,11 @@ {-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts   #-} {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE PatternGuards      #-} {-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE TupleSections      #-} -- | This module provides both a native Haskell solution for parsing XML -- documents into a stream of events, and a set of parser combinators for -- dealing with a stream of events.@@ -132,6 +134,7 @@     , manyYield     , manyIgnoreYield     , manyYield'+    , takeAllTreesContent       -- * Exceptions     , XmlException (..)       -- * Other types@@ -139,6 +142,8 @@     , EventPos     ) where import qualified Control.Applicative          as A+import           Control.Applicative          ((<$>))+import           Control.Monad.Fix            (fix) import           Control.Monad.Trans.Resource (MonadResource, MonadThrow (..),                                                monadThrow) import           Data.Attoparsec.Text         (Parser, anyChar, char, manyTill,@@ -172,7 +177,8 @@ import           Data.Text                    (Text, pack) import qualified Data.Text                    as T import qualified Data.Text                    as TS-import           Data.Text.Encoding           (decodeUtf32BEWith, decodeUtf8With)+import           Data.Text.Encoding           (decodeUtf32BEWith,+                                               decodeUtf8With) import           Data.Text.Encoding.Error     (ignore, lenientDecode) import           Data.Text.Read               (Reader, decimal, hexadecimal) import           Data.Typeable                (Typeable)@@ -189,7 +195,7 @@     (es, n', if isClosed then [begin, end] else [begin])   where     l0 = case n of-            [] -> NSLevel Nothing Map.empty+            []  -> NSLevel Nothing Map.empty             x:_ -> x     (as', l') = foldl' go (id, l0) as     go (front, l) (TName kpref kname, val) =@@ -229,7 +235,7 @@   where     (l, n') =         case n of-            [] -> (NSLevel Nothing Map.empty, [])+            []   -> (NSLevel Nothing Map.empty, [])             x:xs -> (x, xs) tokenToEvent _ es n (TokenContent (ContentEntity e))     | Just t <- lookup e es = (es, n, [EventContent $ ContentText t])@@ -274,15 +280,15 @@         (x, y) = S.splitAt 4 bs         (toDrop, mcodec) =             case S.unpack x of-                [0x00, 0x00, 0xFE, 0xFF] -> (4, Just $ CT.utf32_be)-                [0xFF, 0xFE, 0x00, 0x00] -> (4, Just $ CT.utf32_le)-                0xFE : 0xFF: _           -> (2, Just $ CT.utf16_be)-                0xFF : 0xFE: _           -> (2, Just $ CT.utf16_le)-                0xEF : 0xBB: 0xBF : _    -> (3, Just $ CT.utf8)-                [0x00, 0x00, 0x00, 0x3C] -> (0, Just $ CT.utf32_be)-                [0x3C, 0x00, 0x00, 0x00] -> (0, Just $ CT.utf32_le)-                [0x00, 0x3C, 0x00, 0x3F] -> (0, Just $ CT.utf16_be)-                [0x3C, 0x00, 0x3F, 0x00] -> (0, Just $ CT.utf16_le)+                [0x00, 0x00, 0xFE, 0xFF] -> (4, Just CT.utf32_be)+                [0xFF, 0xFE, 0x00, 0x00] -> (4, Just CT.utf32_le)+                0xFE : 0xFF: _           -> (2, Just CT.utf16_be)+                0xFF : 0xFE: _           -> (2, Just CT.utf16_le)+                0xEF : 0xBB: 0xBF : _    -> (3, Just CT.utf8)+                [0x00, 0x00, 0x00, 0x3C] -> (0, Just CT.utf32_be)+                [0x3C, 0x00, 0x00, 0x00] -> (0, Just CT.utf32_le)+                [0x00, 0x3C, 0x00, 0x3F] -> (0, Just CT.utf16_be)+                [0x3C, 0x00, 0x3F, 0x00] -> (0, Just CT.utf16_le)                 _                        -> (0, Nothing) -- Assuming UTF-8  checkXMLDecl :: MonadThrow m@@ -295,10 +301,10 @@   where     loop chunks0 parser nextChunk =         case parser $ decodeUtf8With lenientDecode nextChunk of-            AT.Fail _ _ _ -> fallback+            AT.Fail{} -> fallback             AT.Partial f -> await >>= maybe fallback (loop chunks f)             AT.Done _ (TokenBeginDocument attrs) -> findEncoding attrs-            AT.Done _ _ -> fallback+            AT.Done{} -> fallback       where         chunks = nextChunk : chunks0         fallback = complete CT.utf8@@ -308,8 +314,8 @@         findEncoding ((TName _ "encoding", [ContentText enc]):_) =             case enc of                 "iso-8859-1" -> complete CT.iso8859_1-                "utf-8" -> complete CT.utf8-                _ -> complete CT.utf8+                "utf-8"      -> complete CT.utf8+                _            -> complete CT.utf8         findEncoding (_:xs) = findEncoding xs  type EventPos = (Maybe PositionRange, Event)@@ -395,7 +401,7 @@             (es', levels', events) = tokenToEvent ps es levels token  data ParseSettings = ParseSettings-    { psDecodeEntities :: DecodeEntities+    { psDecodeEntities   :: DecodeEntities     , psRetainNamespaces :: Bool     -- ^ Whether the original xmlns attributes should be retained in the parsed     -- values. For more information on motivation, see:@@ -442,7 +448,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@@ -453,7 +459,7 @@         name <- parseName         let i =                 case name of-                    TName Nothing x -> x+                    TName Nothing x  -> x                     TName (Just x) y -> T.concat [x, ":", y]         skipSpace         eid <- fmap Just parsePublicID <|>@@ -530,23 +536,23 @@ parseName =   name <$> parseIdent <*> A.optional (char ':' >> parseIdent)   where-    name i1 Nothing = TName Nothing i1+    name i1 Nothing   = TName Nothing i1     name i1 (Just i2) = TName (Just i1) i2  parseIdent :: Parser Text parseIdent =     takeWhile1 valid   where-    valid '&' = False-    valid '<' = False-    valid '>' = False-    valid ':' = False-    valid '?' = False-    valid '=' = False-    valid '"' = False+    valid '&'  = False+    valid '<'  = False+    valid '>'  = False+    valid ':'  = False+    valid '?'  = False+    valid '='  = False+    valid '"'  = False     valid '\'' = False-    valid '/' = False-    valid c  = not $ isXMLSpace c+    valid '/'  = False+    valid c    = not $ isXMLSpace c  parseContent :: DecodeEntities              -> Bool -- break on double quote@@ -563,11 +569,11 @@     parseText' = do         bs <- takeWhile1 valid         return $ ContentText bs-    valid '"' = not breakDouble+    valid '"'  = not breakDouble     valid '\'' = not breakSingle-    valid '&' = False -- amp-    valid '<' = False -- lt-    valid _  = True+    valid '&'  = False -- amp+    valid '<'  = False -- lt+    valid _    = True  skipSpace :: Parser () skipSpace = skipWhile isXMLSpace@@ -579,14 +585,14 @@ -- -- in <http://www.w3.org/TR/2008/REC-xml-20081126/#sec-common-syn>. isXMLSpace :: Char -> Bool-isXMLSpace ' ' = True+isXMLSpace ' '  = True isXMLSpace '\t' = True isXMLSpace '\r' = True isXMLSpace '\n' = True-isXMLSpace _ = False+isXMLSpace _    = False  newline :: Parser ()-newline = ((char '\r' >> char '\n') <|> char '\n') >> return ()+newline = void $ (char '\r' >> char '\n') <|> char '\n'  char' :: Char -> Parser () char' = void . char@@ -601,12 +607,12 @@ contentMaybe = do     x <- CL.peek     case pc' x of-        Ignore -> CL.drop 1 >> contentMaybe+        Ignore      -> CL.drop 1 >> contentMaybe         IsContent t -> CL.drop 1 >> fmap Just (takeContents (t:))-        IsError e -> lift $ monadThrow $ XmlException e x-        NotContent -> return Nothing+        IsError e   -> lift $ monadThrow $ InvalidEntity e x+        NotContent  -> return Nothing   where-    pc' Nothing = NotContent+    pc' Nothing  = NotContent     pc' (Just x) = pc x     pc (EventContent (ContentText t)) = IsContent t     pc (EventContent (ContentEntity e)) = IsError $ "Unknown entity: " ++ show e@@ -622,10 +628,10 @@     takeContents front = do         x <- CL.peek         case pc' x of-            Ignore -> CL.drop 1 >> takeContents front+            Ignore      -> CL.drop 1 >> takeContents front             IsContent t -> CL.drop 1 >> takeContents (front . (:) t)-            IsError e -> lift $ monadThrow $ XmlException e x-            NotContent -> return $ T.concat $ front []+            IsError e   -> lift $ monadThrow $ InvalidEntity e x+            NotContent  -> return $ T.concat $ front []  -- | Grabs the next piece of content. If none if available, returns 'T.empty'. -- This is simply a wrapper around 'contentMaybe'.@@ -636,6 +642,8 @@ -- this is the correct tag name, an 'AttrParser' for handling attributes, and -- then a parser for dealing with content. --+-- 'Events' are consumed if and only if the predicate holds.+-- -- This function automatically absorbs its balancing closing tag, and will -- throw an exception if not all of the attributes or child elements are -- consumed. If you want to allow extra attributes, see 'ignoreAttrs'.@@ -664,7 +672,7 @@                             case a of                                 Just (EventEndElement name')                                     | name == name' -> return (Just z')-                                _ -> lift $ monadThrow $ XmlException ("Expected end tag for: " ++ show name) a+                                _ -> lift $ monadThrow $ InvalidEndElement name a                 Nothing -> return Nothing         _ -> return Nothing @@ -674,39 +682,33 @@         Nothing -> mapM_ leftover leftovers         -- Parse succeeded, discard all of those whitespace events and the         -- first parsed event-        Just _ -> return ()+        Just _  -> return ()      return res   where+    isWhitespace EventBeginDocument             = True+    isWhitespace EventEndDocument               = True+    isWhitespace EventBeginDoctype{}            = True+    isWhitespace EventEndDoctype                = True+    isWhitespace EventInstruction{}             = True+    isWhitespace (EventContent (ContentText t)) = T.all isSpace t+    isWhitespace EventComment{}                 = True+    isWhitespace _                              = False+     -- 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-                    Just EventEndDocument -> True-                    Just EventBeginDoctype{} -> True-                    Just EventEndDoctype -> True-                    Just EventInstruction{} -> True-                    Just EventBeginElement{} -> False-                    Just EventEndElement{} -> False-                    Just (EventContent (ContentText t))-                        | T.all isSpace t -> True-                        | otherwise -> False-                    Just (EventContent ContentEntity{}) -> False-                    Just EventComment{} -> True-                    Just EventCDATA{} -> False-                    Nothing -> False-            leftovers' = maybe id (:) x leftovers-        if isWS-            then dropWS leftovers'-            else return (x, leftovers')+        let leftovers' = maybe id (:) x leftovers++        case isWhitespace <$> x of+          Just True -> dropWS leftovers'+          _         -> return (x, leftovers')     runAttrParser' p as =         case runAttrParser p as of-            Left e -> Left e-            Right ([], x) -> Right x+            Left e          -> Left e+            Right ([], x)   -> Right x             Right (attr, _) -> Left $ toException $ UnparsedAttributes attr  -- | A simplified version of 'tag' which matches against boolean predicates.@@ -729,7 +731,7 @@ -- to match the tag @c@ in the XML namespace @http://a/b@ tagName :: MonadThrow m      => Name -- ^ The tag name this parser matches to (includes namespaces)-     -> AttrParser a -- ^ The attribute parser to be used for tags matching the predicate +     -> AttrParser a -- ^ The attribute parser to be used for tags matching the predicate      -> (a -> CI.ConduitM Event o m b) -- ^ Handler function to handle the attributes and children                                        --   of a tag, given the value return from the @AttrParser@      -> CI.ConduitM Event o m (Maybe b)@@ -791,7 +793,7 @@           => (Name -> Bool) -- ^ The predicate name to match to           -> ConduitM Event o m (Maybe ()) ignoreTree namePred =-    tagPredicateIgnoreAttrs namePred (const () <$> many ignoreAllTreesContent)+    tagPredicateIgnoreAttrs namePred (void $ many ignoreAllTreesContent)  -- | Like 'ignoreTagName', but also ignores non-empty tabs ignoreTreeName :: MonadThrow m@@ -822,9 +824,8 @@ orE :: Monad m     => Consumer Event m (Maybe a) -- ^ The first (preferred) parser     -> Consumer Event m (Maybe a) -- ^ The second parser, only executed if the first parser fails-    -> Consumer Event m (Maybe a) -orE a b =-    a >>= \x -> maybe b (const $ return x) x+    -> Consumer Event m (Maybe a)+orE a b = a >>= \x -> maybe b (const $ return x) x  -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return 'Just'), this function returns 'Nothing'.@@ -832,9 +833,8 @@        => [ConduitM Event o m (Maybe a)] -- ^ List of parsers that will be tried in order.        -> ConduitM Event o m (Maybe a)   -- ^ Result of the first parser to succeed, or @Nothing@                                          --   if no parser succeeded-choose [] = return Nothing-choose (i:is) =-    i >>= maybe (choose is) (return . Just)+choose []     = return Nothing+choose (i:is) = i >>= maybe (choose is) (return . Just)  -- | Force an optional parser into a required parser. All of the 'tag' -- functions, 'attr', 'choose' and 'many' deal with 'Maybe' parsers. Use this when you@@ -863,21 +863,33 @@  data XmlException = XmlException     { xmlErrorMessage :: String-    , xmlBadInput :: Maybe Event+    , xmlBadInput     :: Maybe Event     }-                  | InvalidEndElement Name-                  | InvalidEntity Text+                  | InvalidEndElement Name (Maybe Event)+                  | InvalidEntity String (Maybe Event)+                  | MissingAttribute String                   | UnparsedAttributes [(Name, [Content])]     deriving (Show, Typeable)-instance Exception XmlException +instance Exception XmlException where+#if MIN_VERSION_base(4, 8, 0)+  displayException (XmlException msg (Just event)) = "Error while parsing XML event " ++ show event ++ ": " ++ msg+  displayException (XmlException msg _) = "Error while parsing XML: " ++ msg+  displayException (InvalidEndElement name (Just event)) = "Error while parsing XML event: expected </" ++ TS.unpack (nameLocalName name) ++ ">, got " ++ show event+  displayException (InvalidEndElement name _) = "Error while parsing XML event: expected </" ++ show name ++ ">, got nothing"+  displayException (InvalidEntity msg (Just event)) = "Error while parsing XML entity " ++ show event ++ ": " ++ msg+  displayException (InvalidEntity msg _) = "Error while parsing XML entity: " ++ msg+  displayException (MissingAttribute msg) = "Missing required attribute: " ++ msg+  displayException (UnparsedAttributes attrs) = show (length attrs) ++ " remaining unparsed attributes: \n" ++ unlines (show <$> attrs)+#endif+ -- | A monad for parsing attributes. By default, it requires you to deal with -- all attributes present on an element, and will throw an exception if there--- are unhandled attributes. Use the 'requireAttr', 'optionalAttr' et al+-- are unhandled attributes. Use the 'requireAttr', 'attr' et al -- functions for handling an attribute, and 'ignoreAttrs' if you would like to -- skip the rest of the attributes on an element. ----- 'Alternative' instance behave like 'First' monoid. It chooses first+-- 'Alternative' instance behaves like 'First' monoid: it chooses first -- parser which doesn't fail. newtype AttrParser a = AttrParser { runAttrParser :: [(Name, [Content])] -> Either SomeException ([(Name, [Content])], a) } @@ -909,28 +921,27 @@  requireAttrRaw :: String -> ((Name, [Content]) -> Maybe b) -> AttrParser b requireAttrRaw msg f = optionalAttrRaw f >>=-    maybe (AttrParser $ const $ Left $ toException $ XmlException msg Nothing)+    maybe (AttrParser $ const $ Left $ toException $ MissingAttribute msg)           return  -- | Return the value for an attribute if present. attr :: Name -> AttrParser (Maybe Text)-attr = optionalAttr+attr n = optionalAttrRaw+    (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)  -- | Shortcut composition of 'force' and 'attr'. requireAttr :: Name -> AttrParser Text requireAttr n = force ("Missing attribute: " ++ show n) $ attr n + {-# DEPRECATED optionalAttr "Please use 'attr'." #-} optionalAttr :: Name -> AttrParser (Maybe Text)-optionalAttr n = optionalAttrRaw-    (\(x, y) -> if x == n then Just (contentsToText y) else Nothing)+optionalAttr = attr  contentsToText :: [Content] -> Text-contentsToText =-    T.concat . map toText-  where-    toText (ContentText t) = t-    toText (ContentEntity e) = T.concat ["&", e, ";"]+contentsToText = T.concat . map toText where+  toText (ContentText t)   = t+  toText (ContentEntity e) = T.concat ["&", e, ";"]  -- | Skip the remaining attributes on an element. Since this will clear the -- list of attributes, you must call this /after/ any calls to 'requireAttr',@@ -942,12 +953,7 @@ many :: Monad m      => Consumer Event m (Maybe a)      -> Consumer Event m [a]-many i =-    go id-  where-    go front = i >>=-        maybe (return $ front [])-              (\y -> go $ front . (:) y)+many i = manyIgnore i $ return Nothing  -- | Keep parsing elements as long as the parser returns 'Just' --   or the ignore parser returns 'Just'.@@ -967,38 +973,80 @@ -- | 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]+      => 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+--   to downstream conduits without waiting for 'manyYield' to finish 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)+manyYield consumer = fix $ \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+--   to downstream conduits without waiting for 'manyYield' to finish 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)+manyIgnoreYield consumer ignoreParser = fix $ \loop ->+  consumer >>= maybe (onFail loop) (\x -> yield x >> loop)+  where onFail loop = 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+--   to downstream conduits without waiting for 'manyYield' to finish manyYield' :: MonadThrow m            => ConduitM Event b m (Maybe b)            -> Conduit Event m b manyYield' consumer = manyIgnoreYield consumer ignoreAllTreesContent+++-- | Like 'ignoreAllTreesContent', but stream the corresponding 'Event's rather than ignoring them.+-- Incomplete elements (without a closing-tag) will trigger an 'XmlException'.+--+-- >>> runResourceT $ parseLBS def "text<a></a>" $$ takeAllTreesContent =$= consume+-- Just [ EventContent (ContentText "text"), EventBeginElement "a" [], EventEndElement "a"]+--+-- >>> runResourceT $ parseLBS def "</a><b></b>" $$ takeAllTreesContent =$= consume+-- Just [ ]+--+-- >>> runResourceT $ parseLBS def "<b><c></c></b></a>text" $$ takeAllTreesContent =$= consume+-- Just [ EventBeginElement "b" [], EventBeginElement "c" [], EventEndElement "c", EventEndElement "b" ]+--+-- Since 1.4.0+takeAllTreesContent :: MonadThrow m => Conduit Event m Event+takeAllTreesContent = do+  event <- await+  case event of+    Just e@EventBeginDoctype{} -> do+      yield e+      takeAllTreesContent+      endEvent <- await+      case endEvent of+        Just e@EventEndDoctype -> yield e >> takeAllTreesContent+        _ -> lift $ monadThrow $ XmlException "Expected end of doctype" endEvent+    Just e@EventBeginDocument -> do+      yield e+      takeAllTreesContent+      endEvent <- await+      case endEvent of+        Just e@EventEndDocument -> yield e >> takeAllTreesContent+        _ -> lift $ monadThrow $ XmlException "Expected end of document" endEvent+    Just e@(EventBeginElement name _) -> do+      yield e+      takeAllTreesContent+      endEvent <- await+      case endEvent of+        Just e@(EventEndElement name') | name == name' -> yield e >> takeAllTreesContent+        _ -> lift $ monadThrow $ InvalidEndElement name endEvent+    Just e@EventComment{} -> yield e >> takeAllTreesContent+    Just e@EventContent{} -> yield e >> takeAllTreesContent+    Just e@EventInstruction{} -> yield e >> takeAllTreesContent+    Just e -> leftover e+    _ -> return ()+  type DecodeEntities = Text -> Content 

@@ -29,6 +29,7 @@     ) where  import           Blaze.ByteString.Builder+import           Control.Applicative          ((<$>)) import           Control.Monad.Trans.Resource (MonadThrow) import           Data.ByteString              (ByteString) import           Data.Conduit@@ -108,7 +109,7 @@   where     order elt attrMap =       let initialAttrs = fromMaybe [] $ lookup elt orderSpec-          mkPair attr = fmap ((,) attr) $ Map.lookup attr attrMap+          mkPair attr = (,) attr <$> Map.lookup attr attrMap           otherAttrMap =             Map.filterWithKey (const . not . (`elem` initialAttrs)) attrMap       in mapMaybe mkPair initialAttrs ++ Map.toAscList otherAttrMap@@ -138,7 +139,7 @@     renderEvent' = renderEvent yield' settings  renderEvent :: Monad m => (Flush Builder -> Producer m o) -> RenderSettings -> Conduit (Flush Event) m o-renderEvent yield' RenderSettings { rsPretty = isPretty, rsNamespaces = namespaces0, rsUseCDATA = useCDATA } = do+renderEvent yield' RenderSettings { rsPretty = isPretty, rsNamespaces = namespaces0, rsUseCDATA = useCDATA } =     loop []   where     loop nslevels = await >>= maybe (return ()) (go nslevels)@@ -178,8 +179,8 @@     (tokenToBuilder $ TokenEndElement $ nameToTName sl name, s')   where     (sl:s') = s-eventToToken s useCDATA (EventContent c) -    | useCDATA c = +eventToToken s useCDATA (EventContent c)+    | useCDATA c =         case c of           ContentText txt -> (tokenToBuilder $ TokenCDATA txt, s)           ContentEntity txt -> (tokenToBuilder $ TokenCDATA txt, s)

@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE RankNTypes         #-} -- | DOM-based XML parsing and rendering. -- -- In this module, attribute values and content nodes can contain either raw@@ -43,31 +43,31 @@     , R.rsNamespaces     ) where -import Prelude hiding (writeFile, readFile)-import Data.XML.Types-import Control.Exception (Exception, SomeException)-import Data.Typeable (Typeable)-import Blaze.ByteString.Builder (Builder)-import qualified Text.XML.Stream.Render as R-import qualified Text.XML.Stream.Parse as P-import Text.XML.Stream.Parse (ParseSettings)-import Data.ByteString (ByteString)-import Data.Text (Text)-import Control.Applicative ((<$>), (<*>))-import Control.Monad       (when)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import Data.Char (isSpace)-import qualified Data.ByteString.Lazy as L-import System.IO.Unsafe (unsafePerformIO)-import Data.Conduit-import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Binary as CB-import Control.Exception (throw)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Resource (MonadThrow, monadThrow, runExceptionT, runResourceT)-import Control.Monad.ST (runST)-import Data.Conduit.Lazy (lazyConsume)+import           Blaze.ByteString.Builder     (Builder)+import           Control.Applicative          ((<$>), (<*>))+import           Control.Exception            (Exception, SomeException, throw)+import           Control.Monad                (when)+import           Control.Monad.ST             (runST)+import           Control.Monad.Trans.Class    (lift)+import           Control.Monad.Trans.Resource (MonadThrow, monadThrow,+                                               runExceptionT, runResourceT)+import           Data.ByteString              (ByteString)+import qualified Data.ByteString.Lazy         as L+import           Data.Char                    (isSpace)+import           Data.Conduit+import qualified Data.Conduit.Binary          as CB+import           Data.Conduit.Lazy            (lazyConsume)+import qualified Data.Conduit.List            as CL+import           Data.Text                    (Text)+import qualified Data.Text                    as T+import qualified Data.Text.Lazy               as TL+import           Data.Typeable                (Typeable)+import           Data.XML.Types+import           Prelude                      hiding (readFile, writeFile)+import           System.IO.Unsafe             (unsafePerformIO)+import           Text.XML.Stream.Parse        (ParseSettings)+import qualified Text.XML.Stream.Parse        as P+import qualified Text.XML.Stream.Render       as R  readFile :: P.ParseSettings -> FilePath -> IO Document readFile ps fp = runResourceT $ CB.sourceFile fp $$ sinkDoc ps@@ -114,7 +114,7 @@     show UnterminatedInlineDoctype = "Unterminated doctype declaration"  mShowPos :: Maybe P.PositionRange -> String-mShowPos Nothing = ""+mShowPos Nothing    = "" mShowPos (Just pos) = show pos ++ ": "  prettyShowE :: Event -> String@@ -140,7 +140,7 @@         x <- f         case x of             Nothing -> return $ front []-            Just y -> go (front . (:) y)+            Just y  -> go (front . (:) y)  dropReturn :: Monad m => a -> ConduitM i o m a dropReturn x = CL.drop 1 >> return x@@ -211,7 +211,7 @@         x <- CL.peek         case x of             Just (_, EventBeginElement n as) -> Just <$> goE' n as-            _ -> return Nothing+            _                                -> return Nothing     goE' n as = do         CL.drop 1         ns <- manyTries goN@@ -237,11 +237,11 @@   where     goP (Prologue before doctype after) =         goM before . maybe id goD doctype . goM after-    goM [] = id-    goM [x] = (goM' x :)+    goM []     = id+    goM [x]    = (goM' x :)     goM (x:xs) = (goM' x :) . goM xs     goM' (MiscInstruction i) = EventInstruction i-    goM' (MiscComment t) = EventComment t+    goM' (MiscComment t)     = EventComment t     goD (Doctype name meid) =         (:) (EventBeginDoctype name meid)       . (:) EventEndDoctype@@ -259,13 +259,13 @@           (EventBeginElement name as :)         . goN ns         . (EventEndElement name :)-    goN [] = id-    goN [x] = goN' x+    goN []     = id+    goN [x]    = goN' x     goN (x:xs) = goN' x . goN xs-    goN' (NodeElement e) = goE e+    goN' (NodeElement e)     = goE e     goN' (NodeInstruction i) = (EventInstruction i :)-    goN' (NodeContent c) = (EventContent c :)-    goN' (NodeComment t) = (EventComment t :)+    goN' (NodeContent c)     = (EventContent c :)+    goN' (NodeComment t)     = (EventComment t :)  compressNodes :: [Node] -> [Node] compressNodes [] = []

@@ -1,9 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} -import           Control.Exception            (Exception)+import           Control.Exception            (Exception, toException) import           Control.Monad.IO.Class       (liftIO) import           Data.Typeable                (Typeable) import           Data.XML.Types@@ -24,9 +22,10 @@ import Control.Monad.Trans.Class (lift) import qualified Data.Text as T import qualified Data.Set as Set-import Control.Exception (toException) +import Data.Conduit ((=$=)) import qualified Data.Conduit as C+import Control.Monad.Trans.Resource (runResourceT) import qualified Control.Monad.Trans.Resource as C import qualified Data.Conduit.List as CL import qualified Data.Map as Map@@ -42,6 +41,7 @@         it "has working many function" testMany         it "has working many' function" testMany'         it "has working manyYield function" testManyYield+        it "has working takeAllTreesContent function" testTakeAllTreesContent         it "has working orE" testOrE         it "is idempotent to parse and pretty render a document" documentParsePrettyRender         it "ignores the BOM" parseIgnoreBOM@@ -94,7 +94,7 @@     it "parsing CDATA" caseParseCdata     it "retains namespaces when asked" caseRetainNamespaces     it "handles iso-8859-1" caseIso8859_1-    it "renders CDATA when asked" caseRenderCDATA +    it "renders CDATA when asked" caseRenderCDATA     it "escapes CDATA closing tag in CDATA" caseEscapesCDATA  documentParseRender :: IO ()@@ -134,7 +134,7 @@         ]  combinators :: Assertion-combinators = C.runResourceT $ P.parseLBS def input C.$$ do+combinators = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagName "hello" (P.requireAttr "world") $ \world -> do         liftIO $ world @?= "true"         P.force "need child1" $ P.tagNoAttr "{mynamespace}child1" $ return ()@@ -181,7 +181,7 @@         testChooseElemOrTextIsChunkedText2  testChooseElemOrTextIsText :: Assertion-testChooseElemOrTextIsText = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseElemOrTextIsText = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "failure" $ return "boom"@@ -198,7 +198,7 @@         ]  testChooseElemOrTextIsEncoded :: Assertion-testChooseElemOrTextIsEncoded = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseElemOrTextIsEncoded = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "failure" $ return "boom"@@ -215,7 +215,7 @@         ]  testChooseElemOrTextIsEncodedNBSP :: Assertion-testChooseElemOrTextIsEncodedNBSP = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseElemOrTextIsEncodedNBSP = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "failure" $ return "boom"@@ -233,7 +233,7 @@   testChooseElemOrTextIsWhiteSpace :: Assertion-testChooseElemOrTextIsWhiteSpace = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseElemOrTextIsWhiteSpace = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "failure" $ return "boom"@@ -248,7 +248,7 @@         ]  testChooseTextOrElemIsWhiteSpace :: Assertion-testChooseTextOrElemIsWhiteSpace = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseTextOrElemIsWhiteSpace = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.contentMaybe@@ -263,7 +263,7 @@         ]  testChooseElemOrTextIsChunkedText :: Assertion-testChooseElemOrTextIsChunkedText = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseElemOrTextIsChunkedText = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "failure" $ return "boom"@@ -278,7 +278,7 @@         ]  testChooseElemOrTextIsChunkedText2 :: Assertion-testChooseElemOrTextIsChunkedText2 = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseElemOrTextIsChunkedText2 = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "failure" $ return "boom"@@ -293,7 +293,7 @@         ]  testChooseElemOrTextIsElem :: Assertion-testChooseElemOrTextIsElem = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseElemOrTextIsElem = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "success" $ return "success"@@ -310,7 +310,7 @@         ]  testChooseTextOrElemIsText :: Assertion-testChooseTextOrElemIsText = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseTextOrElemIsText = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.contentMaybe@@ -327,7 +327,7 @@         ]  testChooseTextOrElemIsElem :: Assertion-testChooseTextOrElemIsElem = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseTextOrElemIsElem = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.contentMaybe@@ -344,7 +344,7 @@         ]  testChooseEitherElem :: Assertion-testChooseEitherElem = C.runResourceT $ P.parseLBS def input C.$$ do+testChooseEitherElem = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.choose             [ P.tagNoAttr "failure" $ return 1@@ -363,9 +363,9 @@ testManyYield :: Assertion testManyYield = do     -- Basically the same as testMany, but consume the streamed result-    result <- C.runResourceT $+    result <- runResourceT $         P.parseLBS def input C.$$ helloParser-        C.$= CL.consume+        =$= CL.consume     length result @?= 5   where     helloParser = void $ P.tagNoAttr "hello" $ P.manyYield successParser@@ -382,8 +382,32 @@         , "</hello>"         ] +testTakeAllTreesContent :: Assertion+testTakeAllTreesContent = do+    result <- runResourceT $ P.parseLBS def input C.$$ rootParser+    result @?= Just+      [ EventBeginElement "b" []+      , EventContent (ContentText "Hello ")+      , EventBeginElement "em" []+      , EventContent (ContentText "world")+      , EventEndElement "em"+      , EventContent (ContentText " !")+      , EventEndElement "b"+      , EventContent (ContentText " Welcome !")+      ]+  where+    rootParser = P.tagNoAttr "root" $ P.takeAllTreesContent =$= CL.consume+    input = L.concat+        [ "<?xml version='1.0'?>"+        , "<!DOCTYPE foo []>\n"+        , "<root>"+        , "<b>Hello <em>world</em> !</b> Welcome !"+        , "</root>"+        ]++ testMany :: Assertion-testMany = C.runResourceT $ P.parseLBS def input C.$$ do+testMany = 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@@ -401,7 +425,7 @@         ]  testMany' :: Assertion-testMany' = C.runResourceT $ P.parseLBS def input C.$$ do+testMany' = 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@@ -421,7 +445,7 @@         ]  testOrE :: IO ()-testOrE = C.runResourceT $ P.parseLBS def input C.$$ do+testOrE = runResourceT $ P.parseLBS def input C.$$ do     P.force "need hello" $ P.tagNoAttr "hello" $ do         x <- P.tagNoAttr "failure" (return 1) `P.orE`              P.tagNoAttr "success" (return 2)@@ -436,10 +460,10 @@         ]  testConduitParser :: Assertion-testConduitParser = C.runResourceT $ do+testConduitParser = runResourceT $ do     x <- P.parseLBS def input-        C.$= (P.force "need hello" $ P.tagNoAttr "hello" f)-        C.$$ CL.consume+        C.$$ (P.force "need hello" $ P.tagNoAttr "hello" f)+        =$= CL.consume     liftIO $ x @?= [1, 1, 1]   where     input = L.concat

@@ -1,5 +1,5 @@ name:            xml-conduit-version:         1.3.5+version:         1.4.0 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com>