1 files changed, 64 insertions, 0 deletions

diff --git a/Presence/XMLToByteStrings.hs b/Presence/XMLToByteStrings.hs
new file mode 100644
index 00000000..d8d2e965
--- /dev/null
+++ b/Presence/XMLToByteStrings.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE CPP #-}
+module XMLToByteStrings (xmlToByteStrings) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Maybe
+import Control.Monad.Fix
+import Control.Monad (when)
+import           Data.Conduit
+import qualified Data.Conduit.List as CL
+import Data.XML.Types as XML (Event)
+import qualified Data.ByteString as S (ByteString)
+#ifdef RENDERFLUSH
+import Data.Conduit.Blaze (builderToByteStringFlush)
+import Text.XML.Stream.Render (def,renderBuilderFlush)
+#else
+import Text.XML.Stream.Render (def,renderBytes)
+#endif
+
+fixMaybeT f = (>> return ()) . runMaybeT . fix $ f
+mawait :: Monad m => MaybeT (ConduitM i o m) i
+mawait = MaybeT await
+
+
+xmlToByteStrings ::
+  ( MonadUnsafeIO m
+  , MonadIO m) =>
+                 Source m [XML.Event] -> Sink S.ByteString m b -> m b
+xmlToByteStrings xmlSource snk
+#ifdef RENDERFLUSH
+    = xmlSource 
+        $$  flushList
+        =$= renderBuilderFlush def 
+        =$= builderToByteStringFlush 
+        =$= discardFlush 
+        =$ snk
+#else
+    = xmlSource $$ renderChunks =$ snk
+#endif
+
+#ifdef RENDERFLUSH
+flushList :: Monad m => ConduitM [a] (Flush a) m ()
+flushList = fixMaybeT $ \loop -> do
+    xs <- mawait
+    lift ( CL.sourceList xs $$ CL.mapM_ (yield . Chunk) )
+    lift ( yield Flush )
+    loop
+
+discardFlush :: Monad m => ConduitM (Flush a) a m ()
+discardFlush = fixMaybeT $ \loop -> do
+    x <- mawait
+    let unchunk (Chunk a) = a
+        ischunk (Chunk _) = True
+        ischunk _         = False
+    lift . when (ischunk x) $ yield (unchunk x)
+    loop
+#else
+renderChunks :: (MonadUnsafeIO m, MonadIO m) => ConduitM [Event] S.ByteString m ()
+renderChunks = fixMaybeT $  \loop -> do
+    xs <- mawait
+    lift . when (not . null $ xs) $ ( CL.sourceList xs $= renderBytes def $$ CL.mapM_ yield )
+    loop
+#endif
+