From 5e7ebb132d0a2ca0251649410813994c28ab6a8c Mon Sep 17 00:00:00 2001 From: Martin Hoppenheit Date: Wed, 12 Nov 2025 23:10:54 +0100 Subject: [PATCH 1/5] Add Stream.Render.xmlDeclaration function --- xml-conduit/src/Text/XML/Stream/Render.hs | 1 + xml-conduit/src/Text/XML/Stream/Render/Internal.hs | 14 +++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/xml-conduit/src/Text/XML/Stream/Render.hs b/xml-conduit/src/Text/XML/Stream/Render.hs index a146fe1..e95cf68 100644 --- a/xml-conduit/src/Text/XML/Stream/Render.hs +++ b/xml-conduit/src/Text/XML/Stream/Render.hs @@ -19,6 +19,7 @@ module Text.XML.Stream.Render ( orderAttrs, -- * Event rendering + xmlDeclaration, tag, content, diff --git a/xml-conduit/src/Text/XML/Stream/Render/Internal.hs b/xml-conduit/src/Text/XML/Stream/Render/Internal.hs index 1fff667..1b92f43 100644 --- a/xml-conduit/src/Text/XML/Stream/Render/Internal.hs +++ b/xml-conduit/src/Text/XML/Stream/Render/Internal.hs @@ -21,6 +21,7 @@ module Text.XML.Stream.Render.Internal , rsXMLDeclaration , orderAttrs -- * Event rendering + , xmlDeclaration , tag , content -- * Attribute rendering @@ -82,7 +83,12 @@ data RenderSettings = RenderSettings -- -- @since 1.3.3 , rsXMLDeclaration :: Bool - -- ^ Determines whether the XML declaration will be output. + -- ^ Determines whether the XML declaration will be output. Note that when + -- using the streaming API the XML declaration will be output only if this + -- is set to true /and/ the stream includes an 'EventBeginDocument' event. + -- This can be achieved with the 'xmlDeclaration' function. + -- + -- See . -- -- Default: @True@ -- @@ -391,6 +397,12 @@ nubAttrs orig = | k `Set.member` used = (dlist, used) | otherwise = (dlist . ((k, v):), Set.insert k used) +-- | Generate an 'EventBeginDocument' which results in an XML declaration being +-- output when rendered. +-- +-- @since TODO +xmlDeclaration :: (Monad m) => ConduitT i Event m () +xmlDeclaration = yield EventBeginDocument -- | Generate a complete XML 'Element'. tag :: (Monad m) => Name -> Attributes -> ConduitT i Event m () -- ^ 'Element''s subnodes. From 5eb936a404242e65038418a66f6e9acfda7dcd93 Mon Sep 17 00:00:00 2001 From: Martin Hoppenheit Date: Wed, 19 Nov 2025 22:46:41 +0100 Subject: [PATCH 2/5] Replace 'xmlDeclaration' by 'document' function --- xml-conduit/src/Text/XML/Stream/Render.hs | 2 +- .../src/Text/XML/Stream/Render/Internal.hs | 17 +++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/xml-conduit/src/Text/XML/Stream/Render.hs b/xml-conduit/src/Text/XML/Stream/Render.hs index e95cf68..75a9308 100644 --- a/xml-conduit/src/Text/XML/Stream/Render.hs +++ b/xml-conduit/src/Text/XML/Stream/Render.hs @@ -19,7 +19,7 @@ module Text.XML.Stream.Render ( orderAttrs, -- * Event rendering - xmlDeclaration, + document, tag, content, diff --git a/xml-conduit/src/Text/XML/Stream/Render/Internal.hs b/xml-conduit/src/Text/XML/Stream/Render/Internal.hs index 1b92f43..f7eb4d7 100644 --- a/xml-conduit/src/Text/XML/Stream/Render/Internal.hs +++ b/xml-conduit/src/Text/XML/Stream/Render/Internal.hs @@ -21,7 +21,7 @@ module Text.XML.Stream.Render.Internal , rsXMLDeclaration , orderAttrs -- * Event rendering - , xmlDeclaration + , document , tag , content -- * Attribute rendering @@ -86,9 +86,8 @@ data RenderSettings = RenderSettings -- ^ Determines whether the XML declaration will be output. Note that when -- using the streaming API the XML declaration will be output only if this -- is set to true /and/ the stream includes an 'EventBeginDocument' event. - -- This can be achieved with the 'xmlDeclaration' function. - -- - -- See . + -- Apart from yielding it explicitly, this can be achieved by wrapping the + -- stream in the 'document' function. -- -- Default: @True@ -- @@ -397,12 +396,14 @@ nubAttrs orig = | k `Set.member` used = (dlist, used) | otherwise = (dlist . ((k, v):), Set.insert k used) --- | Generate an 'EventBeginDocument' which results in an XML declaration being --- output when rendered. +-- | Wrap the given stream in an 'EventBeginDocument'/'EventEndDocument' pair. -- -- @since TODO -xmlDeclaration :: (Monad m) => ConduitT i Event m () -xmlDeclaration = yield EventBeginDocument +document :: (Monad m) => ConduitT i Event m () -> ConduitT i Event m () +document content' = do + yield EventBeginDocument + content' + yield EventEndDocument -- | Generate a complete XML 'Element'. tag :: (Monad m) => Name -> Attributes -> ConduitT i Event m () -- ^ 'Element''s subnodes. From a55effe9fac16a41bf3feeb305114d157345231d Mon Sep 17 00:00:00 2001 From: Martin Hoppenheit Date: Thu, 20 Nov 2025 22:50:14 +0100 Subject: [PATCH 3/5] Add some unit tests for the streaming renderer --- xml-conduit/test/unit.hs | 47 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/xml-conduit/test/unit.hs b/xml-conduit/test/unit.hs index a2284e3..cabdfd9 100644 --- a/xml-conduit/test/unit.hs +++ b/xml-conduit/test/unit.hs @@ -25,6 +25,7 @@ import Text.XML.Cursor (($.//), ($/), ($//), ($|), (&.//), (&/), (&//)) import qualified Control.Monad.Trans.Resource as C +import Conduit (foldC, sinkList, yieldMany) import Data.Conduit ((.|), runConduit, runConduitRes, ConduitT) import Data.Conduit.Attoparsec (ParseError(..)) @@ -60,6 +61,8 @@ main = hspec $ do it "normalizes line endings" crlfToLfConversion it "normalizes \\r at the end of a content" crlfToLfConversionCrAtEnd it "normalizes multiple \\rs and \\r\\ns" crlfToLfConversionCrCrCr + context "generates events for rendering in a stream" streamRenderGenerateEvents + it "renders events from a stream" streamRender describe "XML Cursors" $ do it "has correct parent" cursorParent it "has correct ancestor" cursorAncestor @@ -1108,3 +1111,47 @@ crlfToLfConversionCrCrCr = (elementContent $ documentRoot doc) `shouldBe` conten where doc = D.parseLBS_ def "\r\r\r\n\r\r\r" content = [ContentText "\n\n\n\n\n\n"] + +streamRenderGenerateEvents :: Spec +streamRenderGenerateEvents = do + it "generates events for a document" $ do + emptyDoc <- runConduit $ R.document mempty .| sinkList + emptyDoc @?= [EventBeginDocument, EventEndDocument] + nonEmptyDoc <- runConduit $ + R.document (R.tag "foo" mempty $ R.content "...") .| sinkList + nonEmptyDoc @?= + [ EventBeginDocument + , EventBeginElement "foo" [] + , EventContent "..." + , EventEndElement "foo" + , EventEndDocument + ] + it "generates events for a tag" $ do + emptyTag <- runConduit $ R.tag "foo" mempty mempty .| sinkList + emptyTag @?= [EventBeginElement "foo" [], EventEndElement "foo"] + nonEmptyTag <- runConduit $ + R.tag "foo" (R.attr "bar" "baz") (R.content "...") .| sinkList + nonEmptyTag @?= + [ EventBeginElement "foo" [("bar", ["baz"])] + , EventContent "..." + , EventEndElement "foo" + ] + +streamRender :: Assertion +streamRender = do + x <- runConduit $ input .| R.renderBytes def .| foldC + x @?= output + where + input = yieldMany + [ EventBeginDocument + , EventBeginElement "foo" [("bar", ["baz"])] + , EventContent "..." + , EventEndElement "foo" + , EventEndDocument + ] + output = S.concat + [ "" + , "" + , "..." + , "" + ] From 096025b50e226eed0114b2482a32ad8bf8627599 Mon Sep 17 00:00:00 2001 From: Martin Hoppenheit Date: Fri, 21 Nov 2025 18:15:29 +0100 Subject: [PATCH 4/5] Fix unit tests for xml-types < 0.3.7 --- xml-conduit/test/unit.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/xml-conduit/test/unit.hs b/xml-conduit/test/unit.hs index cabdfd9..7979fc9 100644 --- a/xml-conduit/test/unit.hs +++ b/xml-conduit/test/unit.hs @@ -1122,7 +1122,7 @@ streamRenderGenerateEvents = do nonEmptyDoc @?= [ EventBeginDocument , EventBeginElement "foo" [] - , EventContent "..." + , EventContent $ ContentText "..." , EventEndElement "foo" , EventEndDocument ] @@ -1133,7 +1133,7 @@ streamRenderGenerateEvents = do R.tag "foo" (R.attr "bar" "baz") (R.content "...") .| sinkList nonEmptyTag @?= [ EventBeginElement "foo" [("bar", ["baz"])] - , EventContent "..." + , EventContent $ ContentText "..." , EventEndElement "foo" ] @@ -1144,8 +1144,8 @@ streamRender = do where input = yieldMany [ EventBeginDocument - , EventBeginElement "foo" [("bar", ["baz"])] - , EventContent "..." + , EventBeginElement "foo" [("bar", [ContentText "baz"])] + , EventContent $ ContentText "..." , EventEndElement "foo" , EventEndDocument ] From f64c8de105432ef84490a17023ed72ac8e54f98a Mon Sep 17 00:00:00 2001 From: Martin Hoppenheit Date: Sun, 23 Nov 2025 01:08:01 +0100 Subject: [PATCH 5/5] Fix unit tests for xml-types < 0.3.7, continued --- xml-conduit/test/unit.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/xml-conduit/test/unit.hs b/xml-conduit/test/unit.hs index 7979fc9..8dee4bd 100644 --- a/xml-conduit/test/unit.hs +++ b/xml-conduit/test/unit.hs @@ -1132,7 +1132,7 @@ streamRenderGenerateEvents = do nonEmptyTag <- runConduit $ R.tag "foo" (R.attr "bar" "baz") (R.content "...") .| sinkList nonEmptyTag @?= - [ EventBeginElement "foo" [("bar", ["baz"])] + [ EventBeginElement "foo" [("bar", [ContentText "baz"])] , EventContent $ ContentText "..." , EventEndElement "foo" ]