From 480217e1779fd85125d61be2d74e81a61af4e17c Mon Sep 17 00:00:00 2001
From: John Millikin <jmillikin@gmail.com>
Date: Wed, 17 Jun 2009 04:35:46 +0000
Subject: [PATCH] Moved utility functions into Util module.

---
 Network/Protocol/XMPP/Client.hs               | 13 +---------
 Network/Protocol/XMPP/Stream.hs               |  8 +++---
 .../Protocol/XMPP/{XMLBuilder.hs => Util.hs}  | 26 ++++++++++++++++++-
 3 files changed, 30 insertions(+), 17 deletions(-)
 rename Network/Protocol/XMPP/{XMLBuilder.hs => Util.hs} (69%)

diff --git a/Network/Protocol/XMPP/Client.hs b/Network/Protocol/XMPP/Client.hs
index 424ee98..305338c 100644
--- a/Network/Protocol/XMPP/Client.hs
+++ b/Network/Protocol/XMPP/Client.hs
@@ -37,6 +37,7 @@ import Network.Protocol.XMPP.JID (JID)
 import Network.Protocol.XMPP.SASL (Mechanism, bestMechanism)
 import qualified Network.Protocol.XMPP.Stream as S
 import Network.Protocol.XMPP.Stanzas (Stanza)
+import Network.Protocol.XMPP.Util (mkElement)
 
 data ConnectedClient = ConnectedClient JID S.Stream Handle
 
@@ -121,15 +122,3 @@ putTree (AuthenticatedClient _ _ s _) = S.putTree s
 getTree :: AuthenticatedClient -> IO XmlTree
 getTree (AuthenticatedClient _ _ s _) = S.getTree s
 
--- Utility function for building XML trees
-mkElement :: (String, String) -> [(String, String, String)] -> [XmlTree] -> XmlTree
-mkElement (ns, localpart) attrs children = let
-	qname = mkQname ns localpart
-	attrs' = [mkAttr ans alp text | (ans, alp, text) <- attrs]
-	in XN.mkElement qname attrs' children
-
-mkAttr ns localpart text = XN.mkAttr (mkQname ns localpart) [XN.mkText text]
-
-mkQname ns localpart = case ns of
-	"" -> QN.mkName localpart
-	otherwise -> QN.mkNsName ns localpart
diff --git a/Network/Protocol/XMPP/Stream.hs b/Network/Protocol/XMPP/Stream.hs
index d9365cf..c067e1c 100644
--- a/Network/Protocol/XMPP/Stream.hs
+++ b/Network/Protocol/XMPP/Stream.hs
@@ -46,7 +46,7 @@ import qualified Text.XML.HXT.Arrow as A
 
 import Network.Protocol.XMPP.JID (JID)
 import Network.Protocol.XMPP.SASL (Mechanism, findMechanism)
-import Network.Protocol.XMPP.XMLBuilder (eventsToTree)
+import Network.Protocol.XMPP.Util (eventsToTree, mkQName, mkElement)
 
 maxXMPPVersion = XMPPVersion 1 0
 
@@ -96,7 +96,7 @@ beginStream jid handle = do
 	featureTree <- getTree' handle parser
 	return $ beginStream' handle parser startStreamEvent featureTree
 	where
-		streamName = QN.mkNsName "stream" "http://etherx.jabber.org/streams"
+		streamName = mkQName "http://etherx.jabber.org/streams" "stream"
 		startOfStream depth event = case (depth, event) of
 			(1, (XML.BeginElement streamName _)) -> True
 			otherwise -> False
@@ -106,7 +106,7 @@ beginStream' handle parser streamStart featureTree = let
 	language = XMLLanguage "en"
 	version = XMPPVersion 1 0
 	
-	featuresName = QN.mkNsName "features" "http://etherx.jabber.org/streams"
+	featuresName = mkQName "http://etherx.jabber.org/streams" "features"
 	
 	featureRoots = A.runLA (
 		A.getChildren
@@ -133,7 +133,7 @@ parseFeatureTLS t = FeatureStartTLS True -- TODO: detect whether or not required
 
 parseFeatureSASL :: XmlTree -> StreamFeature
 parseFeatureSASL t = let
-	mechName = QN.mkNsName "mechanism" "urn:ietf:params:xml:ns:xmpp-sasl"
+	mechName = mkQName "urn:ietf:params:xml:ns:xmpp-sasl" "mechanism"
 	rawMechanisms = A.runLA (
 		A.getChildren
 		>>> A.hasQName mechName
diff --git a/Network/Protocol/XMPP/XMLBuilder.hs b/Network/Protocol/XMPP/Util.hs
similarity index 69%
rename from Network/Protocol/XMPP/XMLBuilder.hs
rename to Network/Protocol/XMPP/Util.hs
index 4c048a3..bdba3ec 100644
--- a/Network/Protocol/XMPP/XMLBuilder.hs
+++ b/Network/Protocol/XMPP/Util.hs
@@ -14,14 +14,22 @@
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-module Network.Protocol.XMPP.XMLBuilder (
+module Network.Protocol.XMPP.Util (
 	 eventsToTree
+	,mkElement
+	,mkAttr
+	,mkQName
 	) where
 
 import qualified Text.XML.HXT.DOM.XmlNode as XN
+import qualified Text.XML.HXT.DOM.QualifiedName as QN
 import Text.XML.HXT.DOM.TypeDefs (XmlTree)
 import qualified Network.Protocol.XMPP.IncrementalXML as XML
 
+-------------------------------------------------------------------------------
+-- For converting incremental XML event lists to HXT trees
+-------------------------------------------------------------------------------
+
 -- This function assumes the input list is valid. No validation is performed.
 eventsToTree :: [XML.Event] -> XmlTree
 eventsToTree es = XN.mkRoot [] (eventsToTrees es)
@@ -57,3 +65,19 @@ blockToTree (begin:rest) = let end = (last rest) in case (begin, end) of
 
 convertAttr :: XML.Attribute -> XmlTree
 convertAttr (XML.Attribute qname value) = XN.NTree (XN.mkAttrNode qname) [XN.mkText value]
+
+-------------------------------------------------------------------------------
+-- Utility function for building XML trees
+-------------------------------------------------------------------------------
+
+mkElement :: (String, String) -> [(String, String, String)] -> [XmlTree] -> XmlTree
+mkElement (ns, localpart) attrs children = let
+	qname = mkQName ns localpart
+	attrs' = [mkAttr ans alp text | (ans, alp, text) <- attrs]
+	in XN.mkElement qname attrs' children
+
+mkAttr ns localpart text = XN.mkAttr (mkQName ns localpart) [XN.mkText text]
+
+mkQName ns localpart = case ns of
+	"" -> QN.mkName localpart
+	otherwise -> QN.mkNsName ns localpart
-- 
2.45.2