5 files changed, 11 insertions(+), 35 deletions(-)

M Network/Protocol/XMPP/Client.hs
M Network/Protocol/XMPP/Client/Authentication.hs
M Network/Protocol/XMPP/Client/Features.hs
M Network/Protocol/XMPP/Component.hs
M Network/Protocol/XMPP/XML.hs

@@ 93,7 93,7 @@ bindJID jid = do
 	bindResult <- M.getStanza
 	let getJID e =
 		X.elementChildren e
-		>>= X.named (X.Name "jid" (Just "urn:ietf:params:xml:ns:xmpp-bind") Nothing)
+		>>= X.isNamed (X.Name "jid" (Just "urn:ietf:params:xml:ns:xmpp-bind") Nothing)
 		>>= X.elementNodes
 		>>= X.isText
 	

@@ 20,7 20,7 @@ module Network.Protocol.XMPP.Client.Authentication
 	, authenticate
 	) where
 import qualified Control.Exception as Exc
-import Control.Monad (when)
+import Control.Monad (when, (>=>))
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import qualified Control.Monad.Error as E
 import qualified Data.ByteString.Char8 as B


@@ 92,11 92,8 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 saslLoop :: M.Context -> SASL.Session Result
 saslLoop ctx = do
 	elemt <- getElement ctx
-	let challengeText =
-		return elemt
-		>>= X.named (X.Name "challenge" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing)
-		>>= X.elementNodes
-		>>= X.isText
+	let name = X.Name "challenge" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing
+	let challengeText = X.isNamed name >=> X.elementNodes >=> X.isText $ elemt
 	when (null challengeText) $ saslError "Received empty challenge"
 	
 	(b64text, rc) <- SASL.step64 . B.pack . concatMap TL.unpack $ challengeText


@@ 109,9 106,8 @@ saslLoop ctx = do
 saslFinish :: M.Context -> SASL.Session Result
 saslFinish ctx = do
 	elemt <- getElement ctx
-	let success =
-		return elemt
-		>>= X.named (X.Name "success" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing)
+	let name = X.Name "success" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing
+	let success = X.isNamed name elemt
 	return $ if null success then Failure else Success
 
 putElement :: M.Context -> X.Element -> SASL.Session ()

@@ 35,7 35,7 @@ data Feature =
 
 parseFeatures :: X.Element -> [Feature]
 parseFeatures e =
-	X.named nameFeatures e
+	X.isNamed nameFeatures e
 	>>= X.elementChildren
 	>>= return . parseFeature
 


@@ 56,7 56,7 @@ parseFeatureTLS _ = FeatureStartTLS True -- TODO: detect whether or not required
 parseFeatureSASL :: X.Element -> Feature
 parseFeatureSASL e = FeatureSASL $
 	X.elementChildren e
-	>>= X.named nameMechanism
+	>>= X.isNamed nameMechanism
 	>>= X.elementNodes
 	>>= X.isText
 	>>= return . B.pack . TL.unpack

@@ 75,7 75,7 @@ authenticate streamID password = do
 	M.putElement $ X.element "handshake" [] [X.NodeText digest]
 	result <- M.getElement
 	let nameHandshake = X.Name "handshake" (Just "jabber:component:accept") Nothing
-	when (null (X.named nameHandshake result)) $
+	when (null (X.isNamed nameHandshake result)) $
 		throwError M.AuthenticationFailure
 
 buildSecret :: T.Text -> T.Text -> B.ByteString

@@ 16,12 16,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Network.Protocol.XMPP.XML
 	( module Data.XML.Types
-	-- * Filters
-	, isElement
-	, isText
-	, elementChildren
-	, named
-	, getattr
 	
 	-- * Constructors
 	, name


@@ 30,32 24,18 @@ module Network.Protocol.XMPP.XML
 	, nselement
 	
 	-- * Misc
+	, getattr
 	, escape
 	, serialiseElement
 	, readEvents
 	, SAX.eventsToElement
 	) where
-import Control.Monad ((>=>))
 import qualified Data.Text.Lazy as T
 import Data.XML.Types
 import qualified Text.XML.LibXML.SAX as SAX
 
-isElement :: Node -> [Element]
-isElement (NodeElement e) = [e]
-isElement _ = []
-
-isText :: Node -> [T.Text]
-isText (NodeText t) = [t]
-isText _ = []
-
-elementChildren :: Element -> [Element]
-elementChildren = elementNodes >=> isElement
-
-named :: Named a => Name -> a -> [a]
-named n x = [x | getName x == n]
-
 getattr :: Name -> Element -> Maybe T.Text
-getattr n e = case elementAttributes e >>= named n of
+getattr n e = case elementAttributes e >>= isNamed n of
 	[] -> Nothing
 	attr:_ -> Just $ attributeValue attr