1 files changed, 43 insertions, 0 deletions

diff --git a/Presence/NestingXML.hs b/Presence/NestingXML.hs
new file mode 100644
index 00000000..220e82a0
--- /dev/null
+++ b/Presence/NestingXML.hs
@@ -0,0 +1,43 @@
+module NestingXML where
+
+import Data.Conduit
+import Data.XML.Types
+import Control.Monad.Reader
+
+type NestingXML o m a = ReaderT Int (ConduitM Event o m) a
+
+runNestingXML :: NestingXML o m a -> Int -> ConduitM Event o m a
+runNestingXML = runReaderT
+
+nesting :: Monad m => NestingXML o m Int
+nesting = ask
+
+awaitXML :: Monad m => NestingXML o m (Maybe Event)
+awaitXML = do
+    xml <- lift await
+    let f = case xml of
+              Just (EventBeginElement _ _) -> (+1)
+              Just (EventEndElement _)     -> (subtract 1)
+              _                            -> id 
+    local f (return xml)
+
+
+awaitCloser :: Monad m => Int -> NestingXML o m ()
+awaitCloser lvl = do
+    fix $ \loop -> do
+        awaitXML
+        lvl' <- nesting
+        when (lvl' >= lvl) loop
+
+nextElement :: Monad m => NestingXML o m (Maybe Event)
+nextElement = do
+    lvl <- nesting
+    fix $ \loop  -> do
+        xml <- awaitXML
+        case xml of
+            Nothing                      -> return Nothing
+            Just (EventBeginElement _ _) -> return xml
+            Just _ -> do
+                lvl' <- nesting
+                if (lvl'>=lvl) then loop 
+                               else return Nothing