1 files changed, 13 insertions, 1 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 8845ea72..08e0b8c3 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -248,6 +248,18 @@ wlog s = putStrLn s >> hFlush stdout
 wlogb :: ByteString -> IO ()
 wlogb s = Strict8.putStrLn s >> hFlush stdout
 
+flushPassThrough :: Monad m => Conduit a m b -> Conduit (Flush a) m (Flush b)
+flushPassThrough c = getZipConduit $ ZipConduit (onlyChunks =$= mapOutput Chunk c) <* ZipConduit onlyFlushes
+  where
+    onlyChunks  :: Monad m => Conduit (Flush a) m a
+    onlyFlushes :: Monad m => Conduit (Flush a) m (Flush b)
+    onlyChunks           = awaitForever yieldChunk
+    onlyFlushes          = awaitForever yieldFlush
+    yieldFlush Flush     = yield Flush
+    yieldFlush _         = return ()
+    yieldChunk (Chunk x) = yield x
+    yieldChunk _         = return ()
+
 xmlStream :: ReadCommand -> WriteCommand -> ( Source IO XML.Event
                                             , Sink (Flush XML.Event) IO () )
 xmlStream conread conwrite = (xsrc,xsnk)
@@ -255,7 +267,7 @@ xmlStream conread conwrite = (xsrc,xsnk)
     xsrc = src $= XML.parseBytes XML.def
     xsnk :: Sink (Flush Event) IO ()
     xsnk = -- XML.renderBytes XML.def =$ snk
-        XML.renderBuilderFlush XML.def
+        flushPassThrough (XML.renderBuilder XML.def)
         =$= builderToByteStringFlush
         =$= discardFlush
         =$ snk