xml-conduit 1.3.4.2 → 1.3.5
raw patch · 4 files changed
+104/−50 lines, 4 files
Files
- ChangeLog.md +4/−0
- Text/XML/Stream/Render.hs +61/−36
- Text/XML/Unresolved.hs +38/−13
- xml-conduit.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.3.5++* Improvements for using xml-conduit for streaming XML protocols [#85](https://github.com/snoyberg/xml/pull/85)+ ## 1.3.4.2 * transformers dep bump
Text/XML/Stream/Render.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} -- | 'Enumeratee's to render XML 'Event's. Unlike libxml-enumerator and -- expat-enumerator, this module does not provide IO and ST variants, since the -- underlying rendering operations are pure functions. module Text.XML.Stream.Render ( -- * Rendering XML files renderBuilder+ , renderBuilderFlush , renderBytes , renderText , prettify@@ -115,31 +117,49 @@ -- the blaze-builder package, and allow the create of optimally sized -- 'ByteString's with minimal buffer copying. renderBuilder :: Monad m => RenderSettings -> Conduit Event m Builder-renderBuilder RenderSettings { rsPretty = True, rsNamespaces = n, rsUseCDATA = useCDATA } = prettify =$= renderBuilder' n True useCDATA-renderBuilder RenderSettings { rsPretty = False, rsNamespaces = n, rsUseCDATA = useCDATA } = renderBuilder' n False useCDATA+renderBuilder settings = CL.map Chunk =$= renderBuilder' yield' settings+ where+ yield' Flush = return ()+ yield' (Chunk bs) = yield bs -renderBuilder' :: Monad m => [(Text, Text)] -> Bool -> (Content -> Bool) -> Conduit Event m Builder-renderBuilder' namespaces0 isPretty useCDATA = do+-- | Same as 'renderBuilder' but allows you to flush XML stream to ensure that all+-- events at needed point are rendered.+--+-- @since 1.3.5+renderBuilderFlush :: Monad m => RenderSettings -> Conduit (Flush Event) m (Flush Builder)+renderBuilderFlush = renderBuilder' yield++renderBuilder' :: Monad m => (Flush Builder -> Producer m o) -> RenderSettings -> Conduit (Flush Event) m o+renderBuilder' yield' settings =+ if rsPretty settings+ then prettify =$= renderEvent'+ else renderEvent'+ where+ 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 loop [] where loop nslevels = await >>= maybe (return ()) (go nslevels) - go nslevels e =+ go nslevels Flush = yield' Flush >> loop nslevels+ go nslevels (Chunk e) = case e of EventBeginElement n1 as -> do mnext <- CL.peek isClosed <- case mnext of- Just (EventEndElement n2) | n1 == n2 -> do+ Just (Chunk (EventEndElement n2)) | n1 == n2 -> do CL.drop 1 return True _ -> return False let (token, nslevels') = mkBeginToken isPretty isClosed namespaces0 nslevels n1 as- yield token+ yield' $ Chunk token loop nslevels' _ -> do let (token, nslevels') = eventToToken nslevels useCDATA e- yield token+ yield' $ Chunk token loop nslevels' eventToToken :: Stack -> (Content -> Bool) -> Event -> (Builder, [NSLevel])@@ -260,35 +280,40 @@ -- | 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 => Conduit Event m Event+prettify :: Monad m => Conduit (Flush Event) m (Flush Event) prettify = prettify' 0 -prettify' :: Monad m => Int -> Conduit Event m Event+prettify' :: Monad m => Int -> Conduit (Flush Event) m (Flush Event) prettify' level =- await >>= maybe (return ()) go+ await >>= maybe (return ()) goC where+ yield' = yield . Chunk++ goC Flush = yield Flush >> prettify' level+ goC (Chunk e) = go e+ go e@EventBeginDocument = do- yield e- yield $ EventContent $ ContentText "\n"+ yield' e+ yield' $ EventContent $ ContentText "\n" prettify' level go e@EventBeginElement{} = do- yield before- yield e+ yield' before+ yield' e mnext <- CL.peek case mnext of- Just next@EventEndElement{} -> do+ Just (Chunk next@EventEndElement{}) -> do CL.drop 1- yield next- yield after+ yield' next+ yield' after prettify' level _ -> do- yield after+ yield' after prettify' $ level + 1 go e@EventEndElement{} = do let level' = max 0 $ level - 1- yield $ before' level'- yield e- yield after+ yield' $ before' level'+ yield' e+ yield' after prettify' level' go (EventContent c) = do cs <- takeContents (c:)@@ -296,37 +321,37 @@ case cs' of [] -> return () _ -> do- yield before- mapM_ (yield . EventContent) cs'- yield after+ yield' before+ mapM_ (yield' . EventContent) cs'+ yield' after prettify' level go (EventCDATA t) = go $ EventContent $ ContentText t go e@EventInstruction{} = do- yield before- yield e- yield after+ yield' before+ yield' e+ yield' after prettify' level go (EventComment t) = do- yield before- yield $ EventComment $ T.concat+ yield' before+ yield' $ EventComment $ T.concat [ " " , T.unwords $ T.words t , " " ]- yield after+ 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+ 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 case me of- Just (EventContent c) -> do+ Just (Chunk (EventContent c)) -> do CL.drop 1 takeContents $ front . (c:)- Just (EventCDATA t) -> do+ Just (Chunk (EventCDATA t)) -> do CL.drop 1 takeContents $ front . (ContentText t:) _ -> return $ front []
Text/XML/Unresolved.hs view
@@ -23,7 +23,9 @@ , sinkDoc -- * Streaming functions , toEvents+ , elementToEvents , fromEvents+ , elementFromEvents , renderBuilder , renderBytes , renderText@@ -130,10 +132,24 @@ --renderText :: (MonadThrow m, MonadUnsafeIO m) => R.RenderSettings -> Document -> Producer m Text renderText rs doc = CL.sourceList (toEvents doc) =$= R.renderText rs +manyTries :: Monad m => m (Maybe a) -> m [a]+manyTries f =+ go id+ where+ go front = do+ x <- f+ case x of+ Nothing -> return $ front []+ Just y -> go (front . (:) y)++dropReturn :: Monad m => a -> ConduitM i o m a+dropReturn x = CL.drop 1 >> return x++-- | Parse a document from a stream of events. fromEvents :: MonadThrow m => Consumer P.EventPos m Document fromEvents = do skip EventBeginDocument- d <- Document <$> goP <*> require goE <*> goM+ d <- Document <$> goP <*> require elementFromEvents <*> goM skip EventEndDocument y <- CL.head case y of@@ -145,15 +161,6 @@ skip e = do x <- CL.peek when (fmap snd x == Just e) (CL.drop 1)- many f =- go id- where- go front = do- x <- f- case x of- Nothing -> return $ front []- Just y -> go (front . (:) y)- dropReturn x = CL.drop 1 >> return x require f = do x <- f case x of@@ -165,7 +172,7 @@ Just (_, EventEndDocument) -> lift $ monadThrow MissingRootElement Just y -> lift $ monadThrow $ ContentAfterRoot y goP = Prologue <$> goM <*> goD <*> goM- goM = many goM'+ goM = manyTries goM' goM' = do x <- CL.peek case x of@@ -193,6 +200,13 @@ Just (_, EventEndDoctype) -> return () Just epos -> lift $ monadThrow $ InvalidInlineDoctype epos Nothing -> lift $ monadThrow UnterminatedInlineDoctype++-- | Try to parse a document element (as defined in XML) from a stream of events.+--+-- @since 1.3.5+elementFromEvents :: MonadThrow m => Consumer P.EventPos m (Maybe Element)+elementFromEvents = goE+ where goE = do x <- CL.peek case x of@@ -200,7 +214,7 @@ _ -> return Nothing goE' n as = do CL.drop 1- ns <- many goN+ ns <- manyTries goN y <- CL.head if fmap snd y == Just (EventEndElement n) then return $ Element n as $ compressNodes ns@@ -215,10 +229,11 @@ Just (_, EventCDATA t) -> dropReturn $ Just $ NodeContent $ ContentText t _ -> return Nothing +-- | Render a document into events. toEvents :: Document -> [Event] toEvents (Document prol root epi) = (EventBeginDocument :)- . goP prol . goE root . goM epi $ [EventEndDocument]+ . goP prol . elementToEvents' root . goM epi $ [EventEndDocument] where goP (Prologue before doctype after) = goM before . maybe id goD doctype . goM after@@ -230,6 +245,16 @@ goD (Doctype name meid) = (:) (EventBeginDoctype name meid) . (:) EventEndDoctype++-- | Render a document element into events.+--+-- @since 1.3.5+elementToEvents :: Element -> [Event]+elementToEvents e = elementToEvents' e []++elementToEvents' :: Element -> [Event] -> [Event]+elementToEvents' = goE+ where goE (Element name as ns) = (EventBeginElement name as :) . goN ns
xml-conduit.cabal view
@@ -1,5 +1,5 @@ name: xml-conduit-version: 1.3.4.2+version: 1.3.5 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Aristid Breitkreuz <aristidb@googlemail.com>