5 files changed, 30 insertions(+), 23 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,9 93,9 @@ bindJID jid = do
 	bindResult <- M.getStanza
 	let getJID e =
 		X.elementChildren e
-		>>= X.hasName (X.Name "jid" (Just "urn:ietf:params:xml:ns:xmpp-bind") Nothing)
+		>>= X.named (X.Name "jid" (Just "urn:ietf:params:xml:ns:xmpp-bind") Nothing)
 		>>= X.elementNodes
-		>>= X.getText
+		>>= X.isText
 	
 	let maybeJID = do
 		iq <- case bindResult of

@@ 94,9 94,9 @@ saslLoop ctx = do
 	elemt <- getElement ctx
 	let challengeText =
 		return elemt
-		>>= X.hasName (X.Name "challenge" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing)
+		>>= X.named (X.Name "challenge" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing)
 		>>= X.elementNodes
-		>>= X.getText
+		>>= X.isText
 	when (null challengeText) $ saslError "Received empty challenge"
 	
 	(b64text, rc) <- SASL.step64 . B.pack . concatMap TL.unpack $ challengeText


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

@@ 34,8 34,8 @@ data Feature =
 	deriving (Show, Eq)
 
 parseFeatures :: X.Element -> [Feature]
-parseFeatures elemt =
-	X.hasName nameFeatures elemt
+parseFeatures e =
+	X.named nameFeatures e
 	>>= X.elementChildren
 	>>= return . parseFeature
 


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

@@ 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.hasName nameHandshake result)) $
+	when (null (X.named nameHandshake result)) $
 		throwError M.AuthenticationFailure
 
 buildSecret :: T.Text -> T.Text -> B.ByteString

@@ 16,42 16,49 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Network.Protocol.XMPP.XML
 	( module Data.XML.Types
+	-- * Filters
+	, isElement
+	, isText
 	, elementChildren
-	, hasName
+	, named
 	, getattr
-	, getText
+	
+	-- * Constructors
 	, name
 	, nsname
 	, element
 	, nselement
+	
+	-- * Misc
 	, 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
 
-elementChildren :: Element -> [Element]
-elementChildren = concatMap isElement . elementNodes
-
-hasName :: Name -> Element -> [Element]
-hasName n e = [e | elementName e == n]
-
 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 attrname elemt = case filter ((attrname ==) . attributeName) $ elementAttributes elemt of
+getattr n e = case elementAttributes e >>= named n of
 	[] -> Nothing
 	attr:_ -> Just $ attributeValue attr
 
-getText :: Node -> [T.Text]
-getText (NodeText t) = [t]
-getText _ = []
-
 name :: T.Text -> Name
 name t = Name t Nothing Nothing