From 8e2d91e99079ac224a2df5b212f171d0d248c98e Mon Sep 17 00:00:00 2001 From: John Millikin Date: Tue, 16 Jun 2009 04:57:53 +0000 Subject: [PATCH] Use ``getTree`` to parse the element. --- Network/Protocol/XMPP/Stream.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/Network/Protocol/XMPP/Stream.hs b/Network/Protocol/XMPP/Stream.hs index 6344715..3a3d9ef 100644 --- a/Network/Protocol/XMPP/Stream.hs +++ b/Network/Protocol/XMPP/Stream.hs @@ -94,15 +94,16 @@ beginStream jid host handle = do " xmlns:stream='http://etherx.jabber.org/streams'>" IO.hFlush handle - events <- readEventsUntil endOfFeatures handle parser 1000 - return $ beginStream' handle parser events + [startStreamEvent] <- readEventsUntil startOfStream handle parser 1000 + featureTree <- getTree' handle parser + return $ beginStream' handle parser startStreamEvent featureTree where - featuresName = QN.mkNsName "features" "http://etherx.jabber.org/streams" - endOfFeatures depth event = case (depth, event) of - (1, (XML.EndElement featuresName)) -> True + streamName = QN.mkNsName "stream" "http://etherx.jabber.org/streams" + startOfStream depth event = case (depth, event) of + (1, (XML.BeginElement streamName _)) -> True otherwise -> False -beginStream' handle parser (streamStart:events) = let +beginStream' handle parser streamStart featureTree = let -- TODO: parse from streamStart host = "localhost" language = XMLLanguage "en" @@ -110,10 +111,9 @@ beginStream' handle parser (streamStart:events) = let featuresName = QN.mkNsName "features" "http://etherx.jabber.org/streams" - eventTree = eventsToTree events featureRoots = A.runLA ( A.getChildren - >>> A.hasQName featuresName) eventTree + >>> A.hasQName featuresName) featureTree features = case featureRoots of [] -> [] (t:_) -> map parseFeature (A.runLA A.getChildren t) @@ -148,8 +148,11 @@ parseFeatureSASL t = let ------------------------------------------------------------------------------- getTree :: Stream -> IO XmlTree -getTree s = do - events <- readEventsUntil finished (streamHandle s) (streamParser s) 1000 +getTree s = getTree' (streamHandle s) (streamParser s) + +getTree' :: IO.Handle -> XML.Parser -> IO XmlTree +getTree' h p = do + events <- readEventsUntil finished h p 1000 return $ eventsToTree events where finished 0 (XML.EndElement _) = True -- 2.45.2