5 files changed, 21 insertions(+), 22 deletions(-)

M Network/Protocol/XMPP/Client/Features.hs
M Network/Protocol/XMPP/Component.hs
M Network/Protocol/XMPP/Handle.hs
M Network/Protocol/XMPP/JID.hs
M Network/Protocol/XMPP/XML.hs

@@ 19,7 19,7 @@ module Network.Protocol.XMPP.Client.Features
 	, parseFeature
 	) where
 import qualified Data.ByteString.Char8 as B
-import Text.XML.HXT.Arrow ((>>>))
+import Text.XML.HXT.Arrow ((>>>), (&&&))
 import qualified Text.XML.HXT.Arrow as A
 import qualified Text.XML.HXT.DOM.Interface as DOM
 import qualified Text.XML.HXT.DOM.XmlNode as XN


@@ 35,15 35,15 @@ data Feature =
 	deriving (Show, Eq)
 
 parseFeatures :: DOM.XmlTree -> [Feature]
-parseFeatures t =
-	A.runLA (A.getChildren
-		>>> A.hasQName qnameFeatures
-		>>> A.getChildren
-		>>> A.arrL (\t' -> [parseFeature t'])) t
+parseFeatures = A.runLA $
+	A.getChildren
+	>>> A.hasQName qnameFeatures
+	>>> A.getChildren
+	>>> A.arrL (\t' -> [parseFeature t'])
 
 parseFeature :: DOM.XmlTree -> Feature
 parseFeature t = feature where
-	mkPair = maybe ("", "") $ \n -> (DOM.namespaceUri n, DOM.localPart n)
+	mkPair = maybe ("", "") $ DOM.namespaceUri &&& DOM.localPart
 	feature = case mkPair (XN.getName t) of
 		("urn:ietf:params:xml:ns:xmpp-tls", "starttls") -> parseFeatureTLS t
 		("urn:ietf:params:xml:ns:xmpp-sasl", "mechanisms") -> parseFeatureSASL t


@@ 56,12 56,12 @@ parseFeatureTLS :: DOM.XmlTree -> Feature
 parseFeatureTLS t = FeatureStartTLS True -- TODO: detect whether or not required
 
 parseFeatureSASL :: DOM.XmlTree -> Feature
-parseFeatureSASL t = FeatureSASL $ A.runLA (
+parseFeatureSASL = FeatureSASL . A.runLA (
 	A.getChildren
 	>>> A.hasQName qnameMechanism
 	>>> A.getChildren
 	>>> A.getText
-	>>> A.arr B.pack) t
+	>>> A.arr B.pack)
 
 qnameMechanism :: DOM.QName
 qnameMechanism = qname "urn:ietf:params:xml:ns:xmpp-sasl" "mechanism"

@@ 21,6 21,7 @@ module Network.Protocol.XMPP.Component
 	, componentStreamID
 	, connectComponent
 	) where
+import Control.Monad (when)
 import Data.Bits (shiftR, (.&.))
 import Data.Char (intToDigit)
 import qualified Data.ByteString as B


@@ 100,9 101,8 @@ authenticate stream password = do
 	let accepted = A.runLA $
 		A.getChildren
 		>>> A.hasQName (qname "jabber:component:accept" "handshake")
-	if null (accepted result)
-		then error "Component handshake failed" -- TODO: throwIO
-		else return ()
+	when (null (accepted result)) $
+		error "Component handshake failed" -- TODO: throwIO
 
 buildSecret :: T.Text -> T.Text -> B.ByteString
 buildSecret sid password = bytes where

@@ 20,6 20,7 @@ module Network.Protocol.XMPP.Handle
 	, hGetChar
 	) where
 
+import Control.Monad (when)
 import qualified System.IO as IO
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Unsafe as B


@@ 46,7 47,7 @@ startTLS (PlainHandle h) = do
 hPutBytes :: Handle -> B.ByteString -> IO ()
 hPutBytes (PlainHandle h)          bytes = B.hPut h bytes
 hPutBytes (SecureHandle _ session) bytes = useLoop where
-	useLoop = B.unsafeUseAsCStringLen bytes $ \(ptr, len) -> loop ptr len
+	useLoop = B.unsafeUseAsCStringLen bytes $ uncurry loop
 	loop ptr len = do
 		r <- GnuTLS.tlsSend session ptr len
 		case len - r of


@@ 57,11 58,9 @@ hGetChar :: Handle -> IO Char
 hGetChar (PlainHandle h) = IO.hGetChar h
 hGetChar (SecureHandle h session) = allocaBytes 1 $ \ptr -> do
 	pending <- GnuTLS.tlsCheckPending session
-	if pending == 0
-		then do
-			IO.hWaitForInput h (-1)
-			return ()
-		else return ()
+	when (pending == 0) $ do
+		IO.hWaitForInput h (-1)
+		return ()
 	
 	len <- GnuTLS.tlsRecv session ptr 1
 	[char] <- peekCAStringLen (ptr, len)

@@ 73,7 73,7 @@ parseJID str = maybeJID where
 	(domain, resource) = case T.spanBy (/= '/') postNode of
 		(x, y) -> if T.null y
 			then (x, "")
-			else (x, T.drop 1 $ y)
+			else (x, T.drop 1 y)
 	mNode = if T.null node then Nothing else Just (Node node)
 	mResource = if T.null resource then Nothing else Just (Resource resource)
 	maybeJID = do


@@ 94,7 94,7 @@ nodePrep = SP.Profile
 	, SP.shouldNormalize = True
 	, SP.prohibited = [ SP.c11, SP.c12, SP.c21, SP.c22
 	                  , SP.c3, SP.c4, SP.c5, SP.c6, SP.c7, SP.c8, SP.c9
-	                  , map single $ "\"&'/:<>@"
+	                  , map single "\"&'/:<>@"
 	                  ]
 	, SP.shouldCheckBidi = True
 	}

@@ 77,10 77,10 @@ readEventsStep done (e:es) depth accum = let
 
 -- This function assumes the input list is valid. No validation is performed.
 eventsToTree :: [SAX.Event] -> DOM.XmlTree
-eventsToTree es = XN.mkRoot [] (eventsToTrees es)
+eventsToTree = XN.mkRoot [] . eventsToTrees
 
 eventsToTrees :: [SAX.Event] -> [DOM.XmlTree]
-eventsToTrees es = concatMap blockToTrees (splitBlocks es)
+eventsToTrees = concatMap blockToTrees . splitBlocks
 
 -- Split event list into a sequence of "blocks", which are the events including
 -- and between a pair of tags. <start><start2/></start> and <start/> are both