Switched NestingXML to StateT

2 files changed, 22 insertions, 33 deletions

diff --git a/Presence/NestingXML.hs b/Presence/NestingXML.hs
index b90d0caa..5956b34d 100644
--- a/Presence/NestingXML.hs
+++ b/Presence/NestingXML.hs
@@ -2,28 +2,29 @@ module NestingXML where
 
 import Data.Conduit
 import Data.XML.Types
-import Control.Monad.Reader
+import Control.Monad.State
 -- import qualified Text.XML.Stream.Parse as Parse (content)
 
-type NestingXML o m a = ReaderT Int (ConduitM Event o m) a
+type NestingXML o m a = StateT Int (ConduitM Event o m) a
 
-runNestingXML :: NestingXML o m a -> Int -> ConduitM Event o m a
-runNestingXML = runReaderT
+runNestingXML :: NestingXML o m a -> Int -> ConduitM Event o m (a,Int)
+runNestingXML = runStateT
 
-doNestingXML :: NestingXML o m a -> ConduitM Event o m a
-doNestingXML = flip runNestingXML 0
+doNestingXML :: Monad m => NestingXML o m a -> ConduitM Event o m a
+doNestingXML = fmap fst . flip runNestingXML 0
 
 nesting :: Monad m => NestingXML o m Int
-nesting = ask
+nesting = get
 
 awaitXML :: Monad m => NestingXML o m (Maybe Event)
 awaitXML = do
+    lvl <- get
     xml <- lift await
-    let f = case xml of
-              Just (EventBeginElement _ _) -> (+1)
-              Just (EventEndElement _)     -> (subtract 1)
-              _                            -> id 
-    local f (return xml)
+    put $case xml of
+              Just (EventBeginElement _ _) -> lvl+1
+              Just (EventEndElement _)     -> lvl-1
+              _                            -> lvl
+    return xml
 
 withXML
   :: Monad m => (Event -> NestingXML o m ()) -> NestingXML o m ()
@@ -31,30 +32,31 @@ withXML f = do
     xml <- awaitXML
     maybe (return ()) f xml
 
+
 maybeXML
   :: Monad m => NestingXML o m a -> (Event -> NestingXML o m a) -> NestingXML o m a
 maybeXML whenNothing withJust = do
     xml <- awaitXML
     maybe whenNothing withJust xml
 
-awaitCloser :: MonadIO m => Int -> NestingXML o m ()
+
+awaitCloser :: Monad m => Int -> NestingXML o m ()
 awaitCloser lvl = do
     fix $ \loop -> do
         lvl' <- nesting
         when (lvl' >= lvl) $ do
         withXML $ \xml -> do
-            liftIO $ putStrLn $ "awaitCloser: "++show (lvl',lvl,xml)
             loop
 
-nextElement :: MonadIO m => NestingXML o m (Maybe Event)
+nextElement :: Monad m => NestingXML o m (Maybe Event)
 nextElement = do
     lvl <- nesting
     fix $ \loop  -> do
         xml <- awaitXML
-        liftIO $ putStrLn $ "nextElement: "++show xml
         case xml of
             Nothing                      -> return Nothing
-            Just (EventBeginElement _ _) -> return xml
+            Just (EventBeginElement _ _) -> do
+                return xml
             Just _ -> do
                 lvl' <- nesting
                 if (lvl'>=lvl) then loop 
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 5c5cbaef..e15b10cc 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -321,35 +321,22 @@ fromClient session cmdChan = doNestingXML $ do
     log "begin-doc"
     withXML $ \xml -> do
     withJust (elementAttrs "stream" xml) $ \stream_attrs -> do
-    log $ "stream " <++> bshow stream_attrs
+    log $ "stream atributes: " <++> bshow stream_attrs
     host <- liftIO $ do
         jid <- getJID session
         names <- getNamesForPeer (peer jid)
         return (S.decodeUtf8 . head $ names)
     send $ greet host
     
-{-
-    fix $ \loop -> do
-      xml <- mawait
-      log $ bshow xml
-      let isIQ n       = n=="{jabber:client}iq"
-      case xml of
-        _ | eventIsEndElement xml -> return ()
-        tag@(EventBeginElement name attrs) | isIQ name -> doIQ session cmdChan tag >> loop
-
-        tag@(EventBeginElement _ _) -> do
-             xs <- gatherElement tag Seq.empty
-             prettyPrint "client-in: ignoring..." (toList xs)
-             loop
-        _ -> loop
--}
     fix $ \loop -> do
         whenJust nextElement $ \stanza -> do
             stanza_lvl <- nesting
+
             let unhandledStanza = liftIO $ putStrLn ("ignoring stanza: "++show stanza)
             case () of
              _ | stanza `isIQOf` iqTypeSet -> handleIQSet session cmdChan stanza
              _ | otherwise                 -> unhandledStanza
+
             awaitCloser stanza_lvl
             loop