Hello community, here is the log from the commit of package ghc-xml-conduit for openSUSE:Factory checked in at 2016-05-17 17:16:05 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-xml-conduit (Old) and /work/SRC/openSUSE:Factory/.ghc-xml-conduit.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-xml-conduit" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-xml-conduit/ghc-xml-conduit.changes 2016-04-28 17:02:16.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-xml-conduit.new/ghc-xml-conduit.changes 2016-05-17 17:16:06.000000000 +0200 @@ -1,0 +2,6 @@ +Thu May 12 13:39:32 UTC 2016 - mimi...@gmail.com + +- update to 1.3.5 +* Improvements for using xml-conduit for streaming XML protocols + +------------------------------------------------------------------- Old: ---- xml-conduit-1.3.4.2.tar.gz New: ---- xml-conduit-1.3.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-xml-conduit.spec ++++++ --- /var/tmp/diff_new_pack.CBEq97/_old 2016-05-17 17:16:07.000000000 +0200 +++ /var/tmp/diff_new_pack.CBEq97/_new 2016-05-17 17:16:07.000000000 +0200 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-xml-conduit -Version: 1.3.4.2 +Version: 1.3.5 Release: 0 Summary: Pure-Haskell utilities for dealing with XML with the conduit package License: BSD-2-Clause ++++++ xml-conduit-1.3.4.2.tar.gz -> xml-conduit-1.3.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.3.4.2/ChangeLog.md new/xml-conduit-1.3.5/ChangeLog.md --- old/xml-conduit-1.3.4.2/ChangeLog.md 2016-04-18 08:57:08.000000000 +0200 +++ new/xml-conduit-1.3.5/ChangeLog.md 2016-05-11 13:03:26.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.3.4.2/Text/XML/Stream/Render.hs new/xml-conduit-1.3.5/Text/XML/Stream/Render.hs --- old/xml-conduit-1.3.4.2/Text/XML/Stream/Render.hs 2016-04-18 08:57:08.000000000 +0200 +++ new/xml-conduit-1.3.5/Text/XML/Stream/Render.hs 2016-05-11 13:03:26.000000000 +0200 @@ -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 + +-- | 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 -renderBuilder' :: Monad m => [(Text, Text)] -> Bool -> (Content -> Bool) -> Conduit Event m Builder -renderBuilder' namespaces0 isPretty useCDATA = do +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 [] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.3.4.2/Text/XML/Unresolved.hs new/xml-conduit-1.3.5/Text/XML/Unresolved.hs --- old/xml-conduit-1.3.4.2/Text/XML/Unresolved.hs 2016-04-18 08:57:08.000000000 +0200 +++ new/xml-conduit-1.3.5/Text/XML/Unresolved.hs 2016-05-11 13:03:26.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xml-conduit-1.3.4.2/xml-conduit.cabal new/xml-conduit-1.3.5/xml-conduit.cabal --- old/xml-conduit-1.3.4.2/xml-conduit.cabal 2016-04-18 08:57:08.000000000 +0200 +++ new/xml-conduit-1.3.5/xml-conduit.cabal 2016-05-11 13:03:26.000000000 +0200 @@ -1,5 +1,5 @@ name: xml-conduit -version: 1.3.4.2 +version: 1.3.5 license: MIT license-file: LICENSE author: Michael Snoyman <mich...@snoyman.com>, Aristid Breitkreuz <arist...@googlemail.com>
