Add Stream.Render.document function

xml-conduit/src/Text/XML/Stream/Render.hs

@@ -19,6 +19,7 @@ module Text.XML.Stream.Render (
     orderAttrs,
 
     -- * Event rendering
+    document,
     tag,
     content,
 

xml-conduit/src/Text/XML/Stream/Render/Internal.hs

@@ -21,6 +21,7 @@ module Text.XML.Stream.Render.Internal
     , rsXMLDeclaration
     , orderAttrs
       -- * Event rendering
+    , document
     , tag
     , content
       -- * Attribute rendering
@@ -82,7 +83,11 @@ 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.
+      -- Apart from yielding it explicitly, this can be achieved by wrapping the
+      -- stream in the 'document' function.
       --
       -- Default: @True@
       --
@@ -391,6 +396,14 @@ nubAttrs orig =
         | k `Set.member` used = (dlist, used)
         | otherwise = (dlist . ((k, v):), Set.insert k used)
 
+-- | Wrap the given stream in an 'EventBeginDocument'/'EventEndDocument' pair.
+--
+-- @since TODO
+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.

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 "<crlf>\r\r\r\n\r\r\r</crlf>"
         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 $ ContentText "..."
+            , 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", [ContentText "baz"])]
+            , EventContent $ ContentText "..."
+            , EventEndElement "foo"
+            ]
+
+streamRender :: Assertion
+streamRender = do
+    x <- runConduit $ input .| R.renderBytes def .| foldC
+    x @?= output
+  where
+    input = yieldMany
+        [ EventBeginDocument
+        , EventBeginElement "foo" [("bar", [ContentText "baz"])]
+        , EventContent $ ContentText "..."
+        , EventEndElement "foo"
+        , EventEndDocument
+        ]
+    output = S.concat
+        [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+        , "<foo bar=\"baz\">"
+        , "..."
+        , "</foo>"
+        ]