more xmppServer work

1 files changed, 10 insertions, 0 deletions

diff --git a/Presence/NestingXML.hs b/Presence/NestingXML.hs
index bf12c9ae..c26e3d5c 100644
--- a/Presence/NestingXML.hs
+++ b/Presence/NestingXML.hs
@@ -79,6 +79,16 @@ awaitCloser lvl = do
         withXML $ \xml -> do
             loop
 
+doUntilCloser :: Monad m 
+               => Int -> (Event -> NestingXML o m ()) -> NestingXML o m ()
+doUntilCloser lvl thunk = do
+    fix $ \loop -> do
+        lvl' <- nesting
+        when (lvl' >= lvl) $ do
+        withXML $ \xml -> do
+            thunk xml
+            loop
+
 nextElement :: Monad m => NestingXML o m (Maybe Event)
 nextElement = do
     lvl <- nesting