xml-conduit 0.7.0.3 → 1.0.0

raw patch · 7 files changed

+429/−235 lines, 7 filesdep +blaze-htmldep +blaze-markupdep ~attoparsec-conduitdep ~blaze-builder-conduitdep ~conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-html, blaze-markup

Dependency ranges changed: attoparsec-conduit, blaze-builder-conduit, conduit, data-default

API changes (from Hackage documentation)

Files

• Text/XML.hs +82/−18
• Text/XML/Cursor.hs +5/−4
• Text/XML/Stream/Parse.hs +67/−65
• Text/XML/Stream/Render.hs +101/−92
• Text/XML/Unresolved.hs +68/−43
• test/main.hs +98/−8
• xml-conduit.cabal +8/−5

@@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-} -- | DOM-based parsing and rendering. -- -- This module requires that all entities be resolved at parsing. If you need@@ -55,6 +57,7 @@       -- ** Rendering     , R.RenderSettings     , R.rsPretty+    , R.rsNamespaces       -- * Conversion     , toXMLDocument     , fromXMLDocument@@ -88,19 +91,29 @@ 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 qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE-import qualified Data.Conduit as C+import Data.Conduit hiding (Source, Sink, 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 (MonadUnsafeIO, runExceptionT)+import Control.Monad.Trans.Resource (runExceptionT) import Control.Monad.Trans.Class (lift) import Data.Conduit.Lazy (lazyConsume) +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)+ data Document = Document     { documentPrologue :: Prologue     , documentRoot :: Element@@ -117,7 +130,7 @@  data Element = Element     { elementName :: Name-    , elementAttributes :: [(Name, Text)]+    , elementAttributes :: Map.Map Name Text     , elementNodes :: [Node]     }   deriving (Show, Eq, Ord, Typeable)@@ -134,7 +147,7 @@ toXMLElement (Element name as nodes) =     X.Element name as' nodes'   where-    as' = map (\(x, y) -> (x, [X.ContentText y])) as+    as' = map (\(x, y) -> (x, [X.ContentText y])) $ Map.toList as     nodes' = map toXMLNode nodes  toXMLNode :: Node -> X.Node@@ -160,7 +173,8 @@     enodes = map fromXMLNode nodes     (lnodes, rnodes) = partitionEithers enodes     eas = map go as-    (las, ras) = partitionEithers eas+    (las, ras') = partitionEithers eas+    ras = Map.fromList ras'     go (x, y) =         case go' [] id y of             Left es -> Left es@@ -181,7 +195,7 @@ readFile :: ParseSettings -> FilePath -> IO Document readFile ps fp = handle     (throwIO . InvalidXMLFile fp)-    (C.runResourceT $ CB.sourceFile (encodeString fp) C.$$ sinkDoc ps)+    (runResourceT $ CB.sourceFile (encodeString fp) $$ sinkDoc ps)  data XMLException = InvalidXMLFile FilePath SomeException     deriving Typeable@@ -199,45 +213,45 @@ parseLBS ps lbs = runST                 $ runExceptionT                 $ CL.sourceList (L.toChunks lbs)-           C.$$ sinkDoc ps+           $$ sinkDoc ps  parseLBS_ :: ParseSettings -> L.ByteString -> Document parseLBS_ ps = either throw id . parseLBS ps -sinkDoc :: C.MonadThrow m+sinkDoc :: MonadThrow m         => ParseSettings-        -> C.Sink ByteString m Document-sinkDoc ps = P.parseBytes ps C.=$ fromEvents+        -> Pipe l ByteString o u m Document+sinkDoc ps = P.parseBytesPos ps >+> fromEvents  parseText :: ParseSettings -> TL.Text -> Either SomeException Document parseText ps tl = runST                 $ runExceptionT                 $ CL.sourceList (TL.toChunks tl)-           C.$$ sinkTextDoc ps+           $$ sinkTextDoc ps  parseText_ :: ParseSettings -> TL.Text -> Document parseText_ ps = either throw id . parseText ps -sinkTextDoc :: C.MonadThrow m+sinkTextDoc :: MonadThrow m             => ParseSettings-            -> C.Sink Text m Document-sinkTextDoc ps = P.parseText ps C.=$ fromEvents+            -> Pipe l Text o u m Document+sinkTextDoc ps = P.parseText ps >+> fromEvents -fromEvents :: C.MonadThrow m => C.Sink X.Event m Document+fromEvents :: MonadThrow m => Pipe l P.EventPos o u m Document fromEvents = do     d <- D.fromEvents-    either (lift . C.monadThrow . UnresolvedEntityException) return $ fromXMLDocument d+    either (lift . monadThrow . UnresolvedEntityException) return $ fromXMLDocument d  data UnresolvedEntityException = UnresolvedEntityException (Set Text)     deriving (Show, Typeable) instance Exception UnresolvedEntityException -renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> C.Source m ByteString+renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> Pipe l i ByteString u m () renderBytes rs doc = D.renderBytes rs $ toXMLDocument doc  writeFile :: R.RenderSettings -> FilePath -> Document -> IO () writeFile rs fp doc =-    C.runResourceT $ renderBytes rs doc C.$$ CB.sinkFile (encodeString fp)+    runResourceT $ renderBytes rs doc $$ CB.sinkFile (encodeString fp)  renderLBS :: R.RenderSettings -> Document -> L.ByteString renderLBS rs doc =@@ -250,3 +264,53 @@  renderText :: R.RenderSettings -> Document -> TL.Text renderText rs = TLE.decodeUtf8 . renderLBS rs++instance B.ToMarkup Document where+    toMarkup (Document _ root _) = B5.docType >> B.toMarkup root++-- | Note that the special element name+-- @{http://www.snoyman.com/xml2html}ie-cond@ with the single attribute @cond@+-- is used to indicate an IE conditional comment.+instance B.ToMarkup Element where+    toMarkup (Element "{http://www.snoyman.com/xml2html}ie-cond" attrs children)+      | [("cond", cond)] <- Map.toList attrs =+        B.preEscapedToMarkup ("<!--[if " :: T.Text)+        `mappend` B.preEscapedToMarkup cond+        `mappend` B.preEscapedToMarkup ("]>" :: T.Text)+        `mappend` mapM_ B.toMarkup children+        `mappend` B.preEscapedToMarkup ("<![endif]-->" :: T.Text)++    toMarkup (Element name' attrs children) =+        if isVoid+            then foldl' (B.!) leaf attrs'+            else foldl' (B.!) parent attrs' childrenHtml+      where+        childrenHtml :: B.Html+        childrenHtml =+            case (name `elem` ["style", "script"], children) of+                (True, [NodeContent t]) -> B.preEscapedToMarkup t+                _ -> mapM_ B.toMarkup children++        isVoid = nameLocalName name' `Set.member` voidElems++        parent :: B.Html -> B.Html+        parent = BI.Parent tag open close+        leaf :: B.Html+        leaf = BI.Leaf tag open (fromString " />")++        name = T.unpack $ nameLocalName name'+        tag = fromString name+        open = fromString $ '<' : name+        close = fromString $ concat ["</", name, ">"]++        attrs' :: [B.Attribute]+        attrs' = map goAttr $ map (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++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"

@@ -63,6 +63,7 @@ import           Text.XML import qualified Control.Failure              as F import qualified Data.Text                    as T+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)@@ -181,7 +182,7 @@ attribute :: Name -> Cursor -> [T.Text] attribute n c =     case node c of-        NodeElement e -> maybeToList $ lookup n $ elementAttributes e+        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:@@ -195,7 +196,7 @@ laxAttribute n c =     case node c of         NodeElement e -> do-            (n', v) <- elementAttributes e+            (n', v) <- Map.toList $ elementAttributes e             guard $ (on (==) T.toCaseFold) n (nameLocalName n')             return v         _ -> []@@ -204,14 +205,14 @@ hasAttribute :: Name -> Axis hasAttribute n c =     case node c of-        NodeElement (Element _ as _) -> maybe [] (const [c]) $ lookup n as+        NodeElement (Element _ as _) -> maybe [] (const [c]) $ Map.lookup n as         _ -> []  -- | Select only those element nodes containing the given attribute key/value pair. attributeIs :: Name -> T.Text -> Axis attributeIs n v c =     case node c of-        NodeElement (Element _ as _) -> if Just v == lookup n as then [c] else []+        NodeElement (Element _ as _) -> if Just v == Map.lookup n as then [c] else []         _ -> []  force :: F.Failure e f => e -> [a] -> f a

@@ -48,6 +48,7 @@ module Text.XML.Stream.Parse     ( -- * Parsing XML files       parseBytes+    , parseBytesPos     , parseText     , detectUtf     , parseFile@@ -81,13 +82,16 @@     , force       -- * Exceptions     , XmlException (..)+      -- * Other types+    , PositionRange+    , EventPos     ) where import Data.Attoparsec.Text     ( char, Parser, takeWhile1, skipWhile, string     , manyTill, takeWhile, try, anyChar     ) import qualified Control.Applicative as A-import Data.Conduit.Attoparsec (sinkParser)+import Data.Conduit.Attoparsec (conduitParser, PositionRange) import Data.XML.Types     ( Name (..), Event (..), Content (..)     , Instruction (..), ExternalID (..)@@ -108,7 +112,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Map as Map-import qualified Data.Conduit as C+import Data.Conduit hiding (Source, Sink, Conduit) import qualified Data.Conduit.Text as CT import qualified Data.Conduit.List as CL import Control.Monad (ap, liftM)@@ -119,7 +123,6 @@ import Data.Conduit.Binary (sourceFile) import Data.Char (isSpace) import Data.Default (Default (..))-import Control.Monad.Trans.Resource (MonadResource, monadThrow) import Control.Monad.Trans.Class (lift)  type Ents = [(Text, Text)]@@ -180,17 +183,16 @@ -- first checks for BOMs, removing them as necessary, and then check for the -- equivalent of <?xml for each of UTF-8, UTF-16LE/BE, and UTF-32LE/BE. It -- defaults to assuming UTF-8.-detectUtf :: C.MonadThrow m => C.Conduit S.ByteString m TS.Text+detectUtf :: MonadThrow m => Pipe l S.ByteString TS.Text r m r detectUtf =-    conduit id+    injectLeftovers $ conduit id   where-    conduit front = C.NeedInput (push front) (return ())+    conduit front = awaitE >>= either return (push front)      push front bss =         case getEncoding front bss of             Left x -> conduit x-            Right (bss', C.NeedInput decode _) -> decode bss'-            Right _ -> error "detectUtf: Unexpecting decode constructor"+            Right (bss', continue) -> leftover bss' >> continue      getEncoding front bs'         | S.length bs < 4 =@@ -215,6 +217,8 @@                 [0x3C, 0x00, 0x3F, 0x00] -> (0, CT.utf16_le)                 _                        -> (0, CT.utf8) -- Assuming UTF-8 +type EventPos = (Maybe PositionRange, Event)+ -- | Parses a byte stream into 'Event's. This function is implemented fully in -- Haskell using attoparsec-text for parsing. The produced error messages do -- not give line/column information, so you may prefer to stick with the parser@@ -223,13 +227,17 @@ -- -- This relies on 'detectUtf' to determine character encoding, and 'parseText' -- to do the actual parsing.-parseBytes :: C.MonadThrow m-           => ParseSettings -> C.Conduit S.ByteString m Event-parseBytes ps = detectUtf C.=$= parseText ps+parseBytes :: MonadThrow m+           => ParseSettings -> Pipe l S.ByteString Event r m r+parseBytes = mapOutput snd . parseBytesPos -dropBOM :: Monad m => C.Conduit TS.Text m TS.Text+parseBytesPos :: MonadThrow m+           => ParseSettings -> Pipe l S.ByteString EventPos r m r+parseBytesPos ps = detectUtf >+> parseText ps++dropBOM :: Monad m => Pipe l TS.Text TS.Text r m r dropBOM =-    C.NeedInput push (return ())+    awaitE >>= either return push   where     push t =         case T.uncons t of@@ -238,47 +246,41 @@                 let output                         | c == '\xfeef' = cs                         | otherwise = t-                 in C.HaveOutput idConduit (return ()) output-    idConduit = C.NeedInput-        (\x -> C.HaveOutput idConduit (return ()) x)-        (return ())+                 in yield output >> idConduit+    idConduit = awaitE >>= either return (\x -> yield x >> idConduit)  -- | Parses a character stream into 'Event's. This function is implemented -- fully in Haskell using attoparsec-text for parsing. The produced error -- messages do not give line/column information, so you may prefer to stick -- with the parser provided by libxml-enumerator. However, this has the -- advantage of not relying on any C libraries.-parseText :: C.MonadThrow m+parseText :: MonadThrow m           => ParseSettings-          -> C.Conduit TS.Text m Event+          -> Pipe l TS.Text EventPos r m r parseText de =     dropBOM-        C.=$= tokenize-        C.=$= toEventC-        C.=$= addBeginEnd+        >+> tokenize+        >+> toEventC+        >+> addBeginEnd   where-    tokenize = C.sequence $ sinkToken de-    addBeginEnd = C.HaveOutput addEnd (return ()) EventBeginDocument-    addEnd = C.NeedInput-        (\e -> C.HaveOutput addEnd (return ()) e)-        (C.HaveOutput (C.Done Nothing ()) (return ()) EventEndDocument)+    tokenize = injectLeftovers $ conduitToken de+    addBeginEnd = yield (Nothing, EventBeginDocument) >> addEnd+    addEnd = awaitE >>= either+        (\u -> yield (Nothing, EventEndDocument) >> return u)+        (\e -> yield e >> addEnd) -toEventC :: Monad m => C.Conduit Token m Event+toEventC :: Monad m => Pipe l (PositionRange, Token) EventPos r m r toEventC =     go [] []   where     go es levels =-        C.NeedInput push close+        awaitE >>= either return push       where-        push token =-            send events $ go es' levels'+        push (position, token) =+            mapM_ (yield . ((,) (Just position))) events >> go es' levels'           where             (es', levels', events) = tokenToEvent es levels token-        close = C.Done Nothing () -    send [] c = c-    send (e:es) c = C.HaveOutput (send es c) (return ()) e- data ParseSettings = ParseSettings     { psDecodeEntities :: DecodeEntities     }@@ -288,8 +290,8 @@         { psDecodeEntities = decodeXmlEntities         } -sinkToken :: C.MonadThrow m => ParseSettings -> C.Sink TS.Text m Token-sinkToken = sinkParser . parseToken . psDecodeEntities+conduitToken :: MonadThrow m => ParseSettings -> Pipe TS.Text TS.Text (PositionRange, Token) r m r+conduitToken = conduitParser . parseToken . psDecodeEntities  parseToken :: DecodeEntities -> Parser Token parseToken de = (char '<' >> parseLt) <|> TokenContent <$> parseContent de False False@@ -461,13 +463,13 @@ -- | Grabs the next piece of content if available. This function skips over any -- comments and instructions and concatenates all content until the next start -- or end tag.-contentMaybe :: C.MonadThrow m => C.Sink Event m (Maybe Text)+contentMaybe :: MonadThrow m => Pipe Event Event o u m (Maybe Text) contentMaybe = do     x <- CL.peek     case pc' x of         Ignore -> CL.drop 1 >> contentMaybe         IsContent t -> CL.drop 1 >> fmap Just (takeContents (t:))-        IsError e -> lift $ C.monadThrow $ XmlException e x+        IsError e -> lift $ monadThrow $ XmlException e x         NotContent -> return Nothing   where     pc' Nothing = NotContent@@ -488,12 +490,12 @@         case pc' x of             Ignore -> CL.drop 1 >> takeContents front             IsContent t -> CL.drop 1 >> takeContents (front . (:) t)-            IsError e -> lift $ C.monadThrow $ XmlException e x+            IsError e -> lift $ monadThrow $ XmlException 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'.-content :: C.MonadThrow m => C.Sink Event m Text+content :: MonadThrow m => Pipe Event Event o u m Text content = do     x <- contentMaybe     case x of@@ -509,11 +511,11 @@ -- consumed. If you want to allow extra attributes, see 'ignoreAttrs'. -- -- This function automatically ignores comments, instructions and whitespace.-tag :: C.MonadThrow m+tag :: MonadThrow m     => (Name -> Maybe a)     -> (a -> AttrParser b)-    -> (b -> C.Sink Event m c)-    -> C.Sink Event m (Maybe c)+    -> (b -> Pipe Event Event o u m c)+    -> Pipe Event Event o u m (Maybe c) tag checkName attrParser f = do     x <- dropWS     case x of@@ -521,7 +523,7 @@             case checkName name of                 Just y ->                     case runAttrParser' (attrParser y) as of-                        Left e -> lift $ C.monadThrow e+                        Left e -> lift $ monadThrow e                         Right z -> do                             CL.drop 1                             z' <- f z@@ -529,7 +531,7 @@                             case a of                                 Just (EventEndElement name')                                     | name == name' -> CL.drop 1 >> return (Just z')-                                _ -> lift $ C.monadThrow $ XmlException ("Expected end tag for: " ++ show name) a+                                _ -> lift $ monadThrow $ XmlException ("Expected end tag for: " ++ show name) a                 Nothing -> return Nothing         _ -> return Nothing   where@@ -559,33 +561,33 @@             Right (attr, _) -> Left $ UnparsedAttributes attr  -- | A simplified version of 'tag' which matches against boolean predicates.-tagPredicate :: C.MonadThrow m+tagPredicate :: MonadThrow m              => (Name -> Bool)              -> AttrParser a-             -> (a -> C.Sink Event m b)-             -> C.Sink Event m (Maybe b)+             -> (a -> Pipe Event Event o u m b)+             -> Pipe Event Event o u m (Maybe b) tagPredicate p attrParser = tag (\x -> if p x then Just () else Nothing) (const attrParser)  -- | A simplified version of 'tag' which matches for specific tag names instead -- of taking a predicate function. This is often sufficient, and when combined -- with OverloadedStrings and the IsString instance of 'Name', can prove to be -- very concise.-tagName :: C.MonadThrow m+tagName :: MonadThrow m      => Name      -> AttrParser a-     -> (a -> C.Sink Event m b)-     -> C.Sink Event m (Maybe b)+     -> (a -> Pipe Event Event o u m b)+     -> Pipe Event Event o u m (Maybe b) tagName name = tagPredicate (== name)  -- | A further simplified tag parser, which requires that no attributes exist.-tagNoAttr :: C.MonadThrow m => Name -> C.Sink Event m a -> C.Sink Event m (Maybe a)+tagNoAttr :: MonadThrow m => Name -> Pipe Event Event o u m a -> Pipe Event Event o u m (Maybe a) tagNoAttr name f = tagName name (return ()) $ const f  -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return 'Just'), this function returns 'Nothing'. -- -- > orE a b = choose [a, b]-orE :: Monad m => C.Sink Event m (Maybe a) -> C.Sink Event m (Maybe a) -> C.Sink Event m (Maybe a)+orE :: Monad m => Pipe l Event o u m (Maybe a) -> Pipe l Event o u m (Maybe a) -> Pipe l Event o u m (Maybe a) orE a b = do   x <- a   case x of@@ -595,8 +597,8 @@ -- | Get the value of the first parser which returns 'Just'. If no parsers -- succeed (i.e., return 'Just'), this function returns 'Nothing'. choose :: Monad m-       => [C.Sink Event m (Maybe a)]-       -> C.Sink Event m (Maybe a)+       => [Pipe l Event o u m (Maybe a)]+       -> Pipe l Event o u m (Maybe a) choose [] = return Nothing choose (i:is) = do     x <- i@@ -607,10 +609,10 @@ -- | Force an optional parser into a required parser. All of the 'tag' -- functions, 'choose' and 'many' deal with 'Maybe' parsers. Use this when you -- want to finally force something to happen.-force :: C.MonadThrow m+force :: MonadThrow m       => String -- ^ Error message-      -> C.Sink Event m (Maybe a)-      -> C.Sink Event m a+      -> Pipe l Event o u m (Maybe a)+      -> Pipe l Event o u m a force msg i = do     x <- i     case x of@@ -623,15 +625,15 @@ parseFile :: MonadResource m           => ParseSettings           -> FilePath-          -> C.Source m Event-parseFile ps fp = sourceFile (encodeString fp) C.$= parseBytes ps+          -> Pipe l i Event u m ()+parseFile ps fp = sourceFile (encodeString fp) >+> parseBytes ps  -- | Parse an event stream from a lazy 'L.ByteString'.-parseLBS :: C.MonadThrow m+parseLBS :: MonadThrow m          => ParseSettings          -> L.ByteString-         -> C.Source m Event-parseLBS ps lbs = CL.sourceList (L.toChunks lbs) C.$= parseBytes ps+         -> Pipe l i Event u m ()+parseLBS ps lbs = CL.sourceList (L.toChunks lbs) >+> parseBytes ps  data XmlException = XmlException     { xmlErrorMessage :: String@@ -713,7 +715,7 @@ ignoreAttrs = AttrParser $ \_ -> Right ([], ())  -- | Keep parsing elements as long as the parser returns 'Just'.-many :: Monad m => C.Sink Event m (Maybe a) -> C.Sink Event m [a]+many :: Monad m => Pipe l Event o u m (Maybe a) -> Pipe l Event o u m [a] many i =     go id   where

@@ -10,6 +10,7 @@     , RenderSettings     , def     , rsPretty+    , rsNamespaces     , prettify     ) where @@ -26,96 +27,90 @@ import Data.Default (Default (def)) import qualified Data.Set as Set import Data.List (foldl')-import qualified Data.Conduit as C-import Data.Conduit.Internal (sinkToPipe)+import Data.Conduit hiding (Source, Sink, Conduit) import qualified Data.Conduit.List as CL import qualified Data.Conduit.Text as CT-import Control.Monad.Trans.Resource (MonadUnsafeIO)+import Data.Monoid (mempty)  -- | Render a stream of 'Event's into a stream of 'ByteString's. This function -- wraps around 'renderBuilder' and 'builderToByteString', so it produces -- optimally sized 'ByteString's with minimal buffer copying. -- -- The output is UTF8 encoded.-renderBytes :: MonadUnsafeIO m => RenderSettings -> C.Conduit Event m ByteString-renderBytes rs = renderBuilder rs C.=$= builderToByteString+renderBytes :: MonadUnsafeIO m => RenderSettings -> Pipe l Event ByteString r m r+renderBytes rs = renderBuilder rs >+> builderToByteString  -- | Render a stream of 'Event's into a stream of 'ByteString's. This function -- wraps around 'renderBuilder', 'builderToByteString' and 'renderBytes', so it -- produces optimally sized 'ByteString's with minimal buffer copying.-renderText :: (C.MonadThrow m, MonadUnsafeIO m)-           => RenderSettings -> C.Conduit Event m Text-renderText rs = renderBytes rs C.=$= CT.decode CT.utf8+renderText :: (MonadThrow m, MonadUnsafeIO m)+           => RenderSettings -> Pipe l Event Text r m r+renderText rs = renderBytes rs >+> CT.decode CT.utf8  data RenderSettings = RenderSettings     { rsPretty :: Bool+    , rsNamespaces :: [(Text, Text)]+      -- ^ Defines some top level namespace definitions to be used, in the form+      -- of (prefix, namespace). This has absolutely no impact on the meaning+      -- of your documents, but can increase readability by moving commonly+      -- used namespace declarations to the top level.     }  instance Default RenderSettings where     def = RenderSettings         { rsPretty = False+        , rsNamespaces = []         }  -- | Render a stream of 'Event's into a stream of 'Builder's. Builders are from -- the blaze-builder package, and allow the create of optimally sized -- 'ByteString's with minimal buffer copying.-renderBuilder :: Monad m => RenderSettings -> C.Conduit Event m Builder-renderBuilder RenderSettings { rsPretty = True } = prettify C.=$= renderBuilder' True-renderBuilder RenderSettings { rsPretty = False } = renderBuilder' False+renderBuilder :: Monad m => RenderSettings -> Pipe l Event Builder r m r+renderBuilder RenderSettings { rsPretty = True, rsNamespaces = n } = prettify >+> renderBuilder' n True+renderBuilder RenderSettings { rsPretty = False, rsNamespaces = n } = renderBuilder' n False -renderBuilder' :: Monad m => Bool -> C.Conduit Event m Builder-renderBuilder' isPretty = C.conduitState-    (id, [])-    push-    close+renderBuilder' :: Monad m => [(Text, Text)] -> Bool -> Pipe l Event Builder r m r+renderBuilder' namespaces0 isPretty = do+    injectLeftovers $ loop []   where-    go' front = map tokenToBuilder $ front []-    go stack _ [] front = (stack, id, go' front)-    -- we want to wait and see if the next event is the matching end-    go stack False [e@EventBeginElement{}] front =-        (stack, (e:), go' front)-    go stack atEnd-        ( EventBeginElement n1 as-        : EventEndElement n2-        : rest-        ) front | n1 == n2 =-            let (token, stack') = mkBeginToken isPretty True stack n1 as-             in go stack' atEnd rest (front . token)-    go stack atEnd (EventBeginElement name as:rest) front =-        let (token, stack') = mkBeginToken isPretty False stack name as-         in go stack' atEnd rest (front . token)-    go stack atEnd (e:rest) front =-        let (token, stack') = eventToToken stack e-         in go stack' atEnd rest (front . token)--    push (front, stack) es =-        return $ C.StateProducing (leftover, stack') ts-      where-        (stack', leftover, ts) = go stack False (front [es]) id+    loop nslevels = awaitE >>= either return (go nslevels) -    close (front, stack) =-        return ts-      where-        (_, _leftover, ts) = go stack True (front []) id+    go nslevels e =+        case e of+            EventBeginElement n1 as -> do+                mnext <- CL.peek+                isClosed <-+                    case mnext of+                        Just (EventEndElement n2) | n1 == n2 -> do+                            CL.drop 1+                            return True+                        _ -> return False+                let (token, nslevels') = mkBeginToken isPretty isClosed namespaces0 nslevels n1 as+                yield token+                loop nslevels'+            _ -> do+                let (token, nslevels') = eventToToken nslevels e+                yield token+                loop nslevels' -eventToToken :: Stack -> Event -> ([Token] -> [Token], [NSLevel])+eventToToken :: Stack -> Event -> (Builder, [NSLevel]) eventToToken s EventBeginDocument =-    ((:) (TokenBeginDocument+    (tokenToBuilder $ TokenBeginDocument             [ ("version", [ContentText "1.0"])             , ("encoding", [ContentText "UTF-8"])-            ])+            ]      , s)-eventToToken s EventEndDocument = (id, s)-eventToToken s (EventInstruction i) = ((:) (TokenInstruction i), s)-eventToToken s (EventBeginDoctype n meid) = ((:) (TokenDoctype n meid []), s)-eventToToken s EventEndDoctype = (id, s)-eventToToken s (EventCDATA t) = ((:) (TokenCDATA t), s)+eventToToken s EventEndDocument = (mempty, s)+eventToToken s (EventInstruction i) = (tokenToBuilder $ TokenInstruction i, s)+eventToToken s (EventBeginDoctype n meid) = (tokenToBuilder $ TokenDoctype n meid [], s)+eventToToken s EventEndDoctype = (mempty, s)+eventToToken s (EventCDATA t) = (tokenToBuilder $ TokenCDATA t, s) eventToToken s (EventEndElement name) =-    ((:) (TokenEndElement $ nameToTName sl name), s')+    (tokenToBuilder $ TokenEndElement $ nameToTName sl name, s')   where     (sl:s') = s-eventToToken s (EventContent c) = ((:) (TokenContent c), s)-eventToToken s (EventComment t) = ((:) (TokenComment t), s)+eventToToken s (EventContent c) = (tokenToBuilder $ TokenContent c, s)+eventToToken s (EventComment t) = (tokenToBuilder $ TokenComment t, s) eventToToken _ EventBeginElement{} = error "eventToToken on EventBeginElement" -- mkBeginToken False s name attrs  type Stack = [NSLevel]@@ -132,11 +127,15 @@             Just pref -> TName (Just pref) name  mkBeginToken :: Bool -- ^ pretty print attributes?-             -> Bool -> Stack -> Name -> [(Name, [Content])]-             -> ([Token] -> [Token], Stack)-mkBeginToken isPretty isClosed s name attrs =-    ((:) (TokenBeginElement tname tattrs2 isClosed indent),-     if isClosed then s else sl2 : s)+             -> Bool -- ^ self closing?+             -> [(Text, Text)] -- ^ namespaces to apply to top-level+             -> Stack+             -> Name+             -> [(Name, [Content])]+             -> (Builder, Stack)+mkBeginToken isPretty isClosed namespaces0 s name attrs =+    (tokenToBuilder $ TokenBeginElement tname tattrs3 isClosed indent,+     if isClosed then s else sl3 : s)   where     indent = if isPretty then 2 + 4 * length s else 0     prevsl = case s of@@ -144,7 +143,20 @@                 sl':_ -> sl'     (sl1, tname, tattrs1) = newElemStack prevsl name     (sl2, tattrs2) = foldr newAttrStack (sl1, tattrs1) $ nubAttrs attrs+    (sl3, tattrs3) =+        case s of+            [] -> (sl2 { prefixes = Map.union (prefixes sl2) $ Map.fromList namespaceSL }, namespaceAttrs ++ tattrs2)+            _ -> (sl2, tattrs2) +    (namespaceSL, namespaceAttrs) = unzip $ mapMaybe unused namespaces0+    unused (k, v) =+        case lookup k' tattrs2 of+            Just{} -> Nothing+            Nothing -> Just ((v, k), (k', v'))+      where+        k' = TName (Just "xmlns") k+        v' = [ContentText v]+ newElemStack :: NSLevel -> Name -> (NSLevel, TName, [TAttribute]) newElemStack nsl@(NSLevel def' _) (Name local ns _)     | def' == ns = (nsl, TName Nothing local, [])@@ -194,68 +206,65 @@  -- | Convert a stream of 'Event's into a prettified one, adding extra -- whitespace. Note that this can change the meaning of your XML.-prettify :: Monad m => C.Conduit Event m Event-prettify = prettify' 0+prettify :: Monad m => Pipe l Event Event r m r+prettify = injectLeftovers $ prettify' 0 -prettify' :: Monad m => Int -> C.Conduit Event m Event-prettify' level = do-    me <- C.await-    case me of-        Nothing -> return ()-        Just e -> go e+prettify' :: Monad m => Int -> Pipe Event Event Event r m r+prettify' level =+    awaitE >>= either return go   where     go e@EventBeginDocument = do-        C.yield e-        C.yield $ EventContent $ ContentText "\n"+        yield e+        yield $ EventContent $ ContentText "\n"         prettify' level     go e@EventBeginElement{} = do-        C.yield before-        C.yield e-        mnext <- sinkToPipe CL.peek+        yield before+        yield e+        mnext <- CL.peek         case mnext of             Just next@EventEndElement{} -> do-                sinkToPipe $ CL.drop 1-                C.yield next-                C.yield after+                CL.drop 1+                yield next+                yield after                 prettify' level             _ -> do-                C.yield after+                yield after                 prettify' $ level + 1     go e@EventEndElement{} = do         let level' = max 0 $ level - 1-        C.yield $ before' level'-        C.yield e-        C.yield after+        yield $ before' level'+        yield e+        yield after         prettify' level'     go (EventContent c) = do-        cs <- sinkToPipe $ takeContents (c:)+        cs <- takeContents (c:)         let cs' = mapMaybe normalize cs         case cs' of             [] -> return ()             _ -> do-                C.yield before-                mapM_ (C.yield . EventContent) cs'-                C.yield after+                yield before+                mapM_ (yield . EventContent) cs'+                yield after         prettify' level     go (EventCDATA t) = go $ EventContent $ ContentText t     go e@EventInstruction{} = do-        C.yield before-        C.yield e-        C.yield after+        yield before+        yield e+        yield after         prettify' level     go (EventComment t) = do-        C.yield before-        C.yield $ EventComment $ T.concat+        yield before+        yield $ EventComment $ T.concat             [ " "             , T.unwords $ T.words t             , " "             ]-        C.yield after+        yield after         prettify' level -    go e@EventEndDocument = C.yield e >> prettify' level-    go e@EventBeginDoctype{} = C.yield e >> prettify' level-    go e@EventEndDoctype{} = C.yield e >> C.yield after >> prettify' level+    go e@EventEndDocument = yield e >> prettify' level+    go e@EventBeginDoctype{} = yield e >> prettify' level+    go e@EventEndDoctype{} = yield e >> yield after >> prettify' level      takeContents front = do         me <- CL.peek

@@ -27,7 +27,7 @@     , renderBytes     , renderText       -- * Exceptions-    , InvalidEventStream (InvalidEventStream)+    , InvalidEventStream (..)       -- * Settings     , P.def       -- ** Parse@@ -36,6 +36,7 @@       -- ** Render     , R.RenderSettings     , R.rsPretty+    , R.rsNamespaces     ) where  import Prelude hiding (writeFile, readFile, FilePath)@@ -56,25 +57,26 @@ import Data.Char (isSpace) import qualified Data.ByteString.Lazy as L import System.IO.Unsafe (unsafePerformIO)-import qualified Data.Conduit as C+import Data.Conduit hiding (Source, Sink, 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 (MonadUnsafeIO, runExceptionT)+import Control.Monad.Trans.Resource (runExceptionT) import Control.Monad.ST (runST) import Data.Conduit.Lazy (lazyConsume)  readFile :: P.ParseSettings -> FilePath -> IO Document-readFile ps fp = C.runResourceT $ P.parseFile ps fp C.$$ fromEvents+readFile ps fp = runResourceT $ CB.sourceFile (encodeString fp) $$ sinkDoc ps -sinkDoc :: C.MonadThrow m-        => P.ParseSettings -> C.Sink ByteString m Document-sinkDoc ps = P.parseBytes ps C.=$ fromEvents+sinkDoc :: MonadThrow m+        => P.ParseSettings+        -> Pipe l ByteString o u m Document+sinkDoc ps = P.parseBytesPos ps >+> fromEvents  writeFile :: R.RenderSettings -> FilePath -> Document -> IO () writeFile rs fp doc =-    C.runResourceT $ renderBytes rs doc C.$$ CB.sinkFile (encodeString fp)+    runResourceT $ renderBytes rs doc $$ CB.sinkFile (encodeString fp)  renderLBS :: R.RenderSettings -> Document -> L.ByteString renderLBS rs doc =@@ -88,37 +90,57 @@ parseLBS :: P.ParseSettings -> L.ByteString -> Either SomeException Document parseLBS ps lbs =     runST $ runExceptionT-          $ CL.sourceList (L.toChunks lbs) C.$$ sinkDoc ps+          $ CL.sourceList (L.toChunks lbs) $$ sinkDoc ps  parseLBS_ :: P.ParseSettings -> L.ByteString -> Document parseLBS_ ps lbs = either throw id $ parseLBS ps lbs -data InvalidEventStream = InvalidEventStream String-    deriving (Show, Typeable)+data InvalidEventStream = ContentAfterRoot P.EventPos+                        | InvalidInlineDoctype P.EventPos+                        | MissingEndElement Name (Maybe P.EventPos)+                        | UnterminatedInlineDoctype+    deriving Typeable instance Exception InvalidEventStream+instance Show InvalidEventStream where+    show (ContentAfterRoot (pos, e)) = mShowPos pos ++ "Found content after root element: " ++ prettyShowE e+    show (InvalidInlineDoctype (pos, e)) = mShowPos pos ++ "Invalid content inside doctype: " ++ prettyShowE e+    show (MissingEndElement name Nothing) = "Documented ended while expected end element for: " ++ prettyShowName name+    show (MissingEndElement name (Just (pos, e))) = mShowPos pos ++ "Expected end element for: " ++ prettyShowName name ++ ", but received: " ++ prettyShowE e+    show UnterminatedInlineDoctype = "Unterminated doctype declaration" -renderBuilder :: Monad m => R.RenderSettings -> Document -> C.Source m Builder-renderBuilder rs doc = CL.sourceList (toEvents doc) C.$= R.renderBuilder rs+mShowPos :: Maybe P.PositionRange -> String+mShowPos Nothing = ""+mShowPos (Just pos) = show pos ++ ": " -renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> C.Source m ByteString-renderBytes rs doc = CL.sourceList (toEvents doc) C.$= R.renderBytes rs+prettyShowE :: Event -> String+prettyShowE = show -- FIXME -renderText :: (C.MonadThrow m, MonadUnsafeIO m) => R.RenderSettings -> Document -> C.Source m Text-renderText rs doc = CL.sourceList (toEvents doc) C.$= R.renderText rs+prettyShowName :: Name -> String+prettyShowName = show -- FIXME -fromEvents :: C.MonadThrow m => C.Sink Event m Document-fromEvents = do+renderBuilder :: Monad m => R.RenderSettings -> Document -> Pipe l i Builder u m ()+renderBuilder rs doc = CL.sourceList (toEvents doc) >+> R.renderBuilder rs++renderBytes :: MonadUnsafeIO m => R.RenderSettings -> Document -> Pipe l i ByteString u m ()+renderBytes rs doc = CL.sourceList (toEvents doc) >+> R.renderBytes rs++renderText :: (MonadThrow m, MonadUnsafeIO m) => R.RenderSettings -> Document -> Pipe l i Text u m ()+renderText rs doc = CL.sourceList (toEvents doc) >+> R.renderText rs++fromEvents :: MonadThrow m => Pipe l P.EventPos o u m Document+fromEvents = injectLeftovers $ do     skip EventBeginDocument     d <- Document <$> goP <*> require goE <*> goM     skip EventEndDocument     y <- CL.head-    if y == Nothing-        then return d-        else lift $ C.monadThrow $ InvalidEventStream $ "Trailing matter after epilogue: " ++ show y+    case y of+        Nothing -> return d+        Just z ->+            lift $ monadThrow $ ContentAfterRoot z   where     skip e = do         x <- CL.peek-        when (x == Just e) (CL.drop 1)+        when (fmap snd x == Just e) (CL.drop 1)     many f =         go id       where@@ -133,22 +155,24 @@         case x of             Just y -> return y             Nothing -> do-                y <- CL.head-                lift $ C.monadThrow $ InvalidEventStream $ "Document must have a single root element, got: " ++ show y+                my <- CL.head+                case my of+                    Nothing -> error "Text.XML.Unresolved:impossible"+                    Just y -> lift $ monadThrow $ ContentAfterRoot y     goP = Prologue <$> goM <*> goD <*> goM     goM = many goM'     goM' = do         x <- CL.peek         case x of-            Just (EventInstruction i) -> dropReturn $ Just $ MiscInstruction i-            Just (EventComment t) -> dropReturn $ Just $ MiscComment t-            Just (EventContent (ContentText t))+            Just (_, EventInstruction i) -> dropReturn $ Just $ MiscInstruction i+            Just (_, EventComment t) -> dropReturn $ Just $ MiscComment t+            Just (_, EventContent (ContentText t))                 | T.all isSpace t -> CL.drop 1 >> goM'             _ -> return Nothing     goD = do         x <- CL.peek         case x of-            Just (EventBeginDoctype name meid) -> do+            Just (_, EventBeginDoctype name meid) -> do                 CL.drop 1                 dropTillDoctype                 return (Just $ Doctype name meid)@@ -161,28 +185,29 @@             -- be expanded again to support some form of EventDeclaration             --             -- Just (EventDeclaration _) -> dropTillDoctype-            Just EventEndDoctype -> return ()-            _ -> lift $ C.monadThrow $ InvalidEventStream $ "Invalid event during doctype, got: " ++ show x+            Just (_, EventEndDoctype) -> return ()+            Just epos -> lift $ monadThrow $ InvalidInlineDoctype epos+            Nothing -> lift $ monadThrow UnterminatedInlineDoctype     goE = do         x <- CL.peek         case x of-            Just (EventBeginElement n as) -> Just <$> goE' n as+            Just (_, EventBeginElement n as) -> Just <$> goE' n as             _ -> return Nothing     goE' n as = do         CL.drop 1         ns <- many goN         y <- CL.head-        if y == Just (EventEndElement n)+        if fmap snd y == Just (EventEndElement n)             then return $ Element n as $ compressNodes ns-            else lift $ C.monadThrow $ InvalidEventStream $ "Missing end element for " ++ show n ++ ", got: " ++ show y+            else lift $ monadThrow $ MissingEndElement n y     goN = do         x <- CL.peek         case x of-            Just (EventBeginElement n as) -> (Just . NodeElement) <$> goE' n as-            Just (EventInstruction i) -> dropReturn $ Just $ NodeInstruction i-            Just (EventContent c) -> dropReturn $ Just $ NodeContent c-            Just (EventComment t) -> dropReturn $ Just $ NodeComment t-            Just (EventCDATA t) -> dropReturn $ Just $ NodeContent $ ContentText t+            Just (_, EventBeginElement n as) -> (Just . NodeElement) <$> goE' n as+            Just (_, EventInstruction i) -> dropReturn $ Just $ NodeInstruction i+            Just (_, EventContent c) -> dropReturn $ Just $ NodeContent c+            Just (_, EventComment t) -> dropReturn $ Just $ NodeComment t+            Just (_, EventCDATA t) -> dropReturn $ Just $ NodeContent $ ContentText t             _ -> return Nothing  toEvents :: Document -> [Event]@@ -223,12 +248,12 @@ parseText ps tl = runST                 $ runExceptionT                 $ CL.sourceList (TL.toChunks tl)-           C.$$ sinkTextDoc ps+           $$ sinkTextDoc ps  parseText_ :: ParseSettings -> TL.Text -> Document parseText_ ps = either throw id . parseText ps -sinkTextDoc :: C.MonadThrow m+sinkTextDoc :: MonadThrow m             => ParseSettings-            -> C.Sink Text m Document-sinkTextDoc ps = P.parseText ps C.=$ fromEvents+            -> Pipe l Text o u m Document+sinkTextDoc ps = P.parseText ps >+> fromEvents

@@ -23,9 +23,12 @@ import Test.Hspec.HUnit ()  import qualified Data.Conduit as C+import qualified Data.Map as Map+import Text.Blaze (toMarkup)+import Text.Blaze.Renderer.String (renderMarkup)  main :: IO ()-main = hspecX $ do+main = hspec $ do     describe "XML parsing and rendering" $ do         it "is idempotent to parse and render a document" documentParseRender         it "has valid parser combinators" combinators@@ -69,6 +72,12 @@         it "understands inline entity declarations" resolvedInline     describe "pretty" $ do         it "works" casePretty+    describe "top level namespaces" $ do+        it "works" caseTopLevelNamespace+        it "works with prefix" caseTopLevelNamespacePrefix+        it "handles conflicts" caseTLNConflict+    describe "blaze-html instances" $ do+        it "works" caseBlazeHtml  documentParseRender :: IO () documentParseRender =@@ -296,7 +305,7 @@  resolvedMergeContent =     Res.documentRoot (Res.parseLBS_ def xml) @=?-    Res.Element "foo" [] [Res.NodeContent "bar&baz"]+    Res.Element "foo" Map.empty [Res.NodeContent "bar&baz"]   where     xml = "<foo>bar&amp;baz</foo>" @@ -324,9 +333,9 @@ resolvedInline :: Assertion resolvedInline = do     Res.Document _ root _ <- return $ Res.parseLBS_ Res.def "<!DOCTYPE foo [<!ENTITY bar \"baz\">]><foo>&bar;</foo>"-    root @?= Res.Element "foo" [] [Res.NodeContent "baz"]+    root @?= Res.Element "foo" Map.empty [Res.NodeContent "baz"]     Res.Document _ root2 _ <- return $ Res.parseLBS_ Res.def "<!DOCTYPE foo [<!ENTITY bar \"baz\">]><foo bar='&bar;'/>"-    root2 @?= Res.Element "foo" [("bar", "baz")] []+    root2 @?= Res.Element "foo" (Map.singleton "bar" "baz") []  casePretty :: Assertion casePretty = do@@ -350,14 +359,95 @@             ]         doctype = Res.Doctype "foo" Nothing         doc = Res.Document (Res.Prologue [] (Just doctype) []) root []-        root = Res.Element "foo" [("bar", "bar"), ("baz", "baz")]-                [ Res.NodeElement $ Res.Element "foo" [("bar", "bar"), ("baz", "baz"), ("bin", "bin")]+        root = Res.Element "foo" (Map.fromList [("bar", "bar"), ("baz", "baz")])+                [ Res.NodeElement $ Res.Element "foo" (Map.fromList [("bar", "bar"), ("baz", "baz"), ("bin", "bin")])                     [ Res.NodeContent "  Hello World\n\n"                     , Res.NodeContent "  "                     ]-                , Res.NodeElement $ Res.Element "foo" [] []+                , Res.NodeElement $ Res.Element "foo" Map.empty []                 , Res.NodeInstruction $ Res.Instruction "foo" "bar"                 , Res.NodeComment "foo bar\n\r\nbaz    \tbin "-                , Res.NodeElement $ Res.Element "bar" [] [Res.NodeContent "bar content"]+                , Res.NodeElement $ Res.Element "bar" Map.empty [Res.NodeContent "bar content"]                 ]     pretty @=? S.concat (L.toChunks $ Res.renderLBS def { D.rsPretty = True } doc)++caseTopLevelNamespace :: Assertion+caseTopLevelNamespace = do+    let lbs = S.concat+            [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"+            , "<foo xmlns:bar=\"baz\">"+            , "<subfoo bar:bin=\"\"/>"+            , "</foo>"+            ]+        rs = def { D.rsNamespaces = [("bar", "baz")] }+        doc = Res.Document (Res.Prologue [] Nothing [])+                (Res.Element "foo" Map.empty+                    [ Res.NodeElement+                        $ Res.Element "subfoo" (Map.singleton "{baz}bin" "") []+                    ])+                []+    lbs @=? S.concat (L.toChunks $ Res.renderLBS rs doc)++caseTopLevelNamespacePrefix :: Assertion+caseTopLevelNamespacePrefix = do+    let lbs = S.concat+            [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"+            , "<foo xmlns:bar=\"baz\">"+            , "<subfoo bar:bin=\"\"/>"+            , "</foo>"+            ]+        rs = def { D.rsNamespaces = [("bar", "baz")] }+        doc = Res.Document (Res.Prologue [] Nothing [])+                (Res.Element "foo" Map.empty+                    [ Res.NodeElement+                        $ Res.Element "subfoo" (Map.fromList [(Name "bin" (Just "baz") (Just "bar"), "")]) []+                    ])+                []+    lbs @=? S.concat (L.toChunks $ Res.renderLBS rs doc)++caseTLNConflict :: Assertion+caseTLNConflict = do+    let lbs = S.concat+            [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"+            , "<foo xmlns:bar=\"something\" bar:x=\"y\">"+            , "<subfoo xmlns:bar_=\"baz\" bar_:bin=\"\"/>"+            , "</foo>"+            ]+        rs = def { D.rsNamespaces = [("bar", "baz")] }+        doc = Res.Document (Res.Prologue [] Nothing [])+                (Res.Element "foo" (Map.fromList [(Name "x" (Just "something") (Just "bar"), "y")])+                    [ Res.NodeElement+                        $ Res.Element "subfoo" (Map.fromList [(Name "bin" (Just "baz") (Just "bar"), "")]) []+                    ])+                []+    lbs @=? S.concat (L.toChunks $ Res.renderLBS rs doc)++caseBlazeHtml :: Assertion+caseBlazeHtml =+    expected @=? str+  where+    str = renderMarkup $ toMarkup $ Res.Document (Res.Prologue [] Nothing []) root []+    root :: Res.Element+    root = Res.Element "html" Map.empty+        [ Res.NodeElement $ Res.Element "head" Map.empty+            [ Res.NodeElement $ Res.Element "title" Map.empty [Res.NodeContent "Test"]+            , Res.NodeElement $ Res.Element "script" Map.empty+                [Res.NodeContent "if (5 < 6 || 8 > 9) alert('Hello World!');"]+            , Res.NodeElement $ Res.Element "{http://www.snoyman.com/xml2html}ie-cond" (Map.singleton "cond" "lt IE 7")+                [Res.NodeElement $ Res.Element "link" (Map.singleton "href" "ie6.css") []]+            , Res.NodeElement $ Res.Element "style" Map.empty+                [Res.NodeContent "body > h1 { color: red }"]+            ]+        , Res.NodeElement $ Res.Element "body" Map.empty+            [ Res.NodeElement $ Res.Element "h1" Map.empty [Res.NodeContent "Hello World!"]+            ]+        ]+    expected :: String+    expected = concat+        [ "<!DOCTYPE HTML>\n"+        , "<html><head><title>Test</title><script>if (5 < 6 || 8 > 9) alert('Hello World!');</script>"+        , "<!--[if lt IE 7]><link href=\"ie6.css\" /><![endif]-->"+        , "<style>body > h1 { color: red }</style>"+        , "</head>"+        , "<body><h1>Hello World!</h1></body></html>"+        ]

@@ -1,5 +1,5 @@ name:            xml-conduit-version:         0.7.0.3+version:         1.0.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michaels@suite-sol.com>, Aristid Breitkreuz <aristidb@googlemail.com>@@ -28,10 +28,10 @@  library     build-depends:   base                      >= 4        && < 5-                   , conduit                   >= 0.4      && < 0.5+                   , conduit                   >= 0.5      && < 0.6                    , resourcet                 >= 0.3      && < 0.4-                   , attoparsec-conduit        >= 0.4      && < 0.5-                   , blaze-builder-conduit     >= 0.4      && < 0.5+                   , attoparsec-conduit        >= 0.5      && < 0.6+                   , blaze-builder-conduit     >= 0.5      && < 0.6                    , bytestring                >= 0.9      && < 0.10                    , text                      >= 0.7      && < 0.12                    , containers                >= 0.2@@ -40,9 +40,11 @@                    , blaze-builder             >= 0.2      && < 0.4                    , transformers              >= 0.2      && < 0.4                    , failure                   >= 0.1      && < 0.3-                   , data-default              >= 0.2      && < 0.5+                   , data-default                    , system-filepath           >= 0.4      && < 0.5                    , monad-control             >= 0.3      && < 0.4+                   , blaze-markup              >= 0.5      && < 0.6+                   , blaze-html                >= 0.5      && < 0.6     exposed-modules: Text.XML.Stream.Parse                      Text.XML.Stream.Render                      Text.XML.Unresolved@@ -66,6 +68,7 @@                           , HUnit                           , xml-types >= 0.3.1                           , conduit+                          , blaze-markup  source-repository head   type:     git