13 files changed, 92 insertions(+), 92 deletions(-)

M examples/echo.hs
M lib/Network/Protocol/XMPP/Client.hs
M lib/Network/Protocol/XMPP/Client/Authentication.hs
M lib/Network/Protocol/XMPP/Client/Features.hs
M lib/Network/Protocol/XMPP/Component.hs
M lib/Network/Protocol/XMPP/Connections.hs
M lib/Network/Protocol/XMPP/Handle.hs
M lib/Network/Protocol/XMPP/JID.hs
M lib/Network/Protocol/XMPP/Monad.hs
M lib/Network/Protocol/XMPP/Stanza.hs
A lib/Network/Protocol/XMPP/String.hs
M lib/Network/Protocol/XMPP/XML.hs
M network-protocol-xmpp.cabal

@@ 21,7 21,6 @@
 -- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 -- OTHER DEALINGS IN THE SOFTWARE.
 
-{-# LANGUAGE OverloadedStrings #-}
 module Main where
 
 -- XMPP imports


@@ 30,6 29,7 @@ import Network.Protocol.XMPP
 import Data.XML.Types
 
 -- other imports
+import Data.String (fromString)
 import Control.Concurrent
 import Control.Monad
 import Control.Monad.IO.Class


@@ 147,7 147,7 @@ sendPings seconds s = forever send where
 		}
 
 pingName :: Name
-pingName = Name "ping" (Just "urn:xmpp:ping") Nothing
+pingName = fromString "{urn:xmpp:ping}ping"
 
 main :: IO ()
 main = do

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 
 -- This program is free software: you can redistribute it and/or modify


@@ 37,6 35,7 @@ import qualified Network.Protocol.XMPP.Monad as M
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.ErrorT
 import           Network.Protocol.XMPP.Stanza
+import           Network.Protocol.XMPP.String (s)
 
 runClient :: C.Server
           -> J.JID -- ^ Client JID


@@ 52,7 51,7 @@ runClient server jid username password xmpp = do
 	let handle = H.PlainHandle rawHandle
 
 	-- Open the initial stream and authenticate
-	M.startXMPP handle "jabber:client" $ do
+	M.startXMPP handle (s"jabber:client") $ do
 		features <- newStream sjid
 		tryTLS sjid features $ \tlsFeatures -> do
 			let mechanisms = authenticationMechanisms tlsFeatures


@@ 61,7 60,7 @@ runClient server jid username password xmpp = do
 
 newStream :: J.JID -> M.XMPP [F.Feature]
 newStream jid = do
-	M.putBytes (C.xmlHeader "jabber:client" jid)
+	M.putBytes (C.xmlHeader (s"jabber:client") jid)
 	void (M.readEvents C.startOfStream)
 	F.parseFeatures `fmap` M.getElement
 


@@ 96,7 95,7 @@ bindJID jid = do
 	bindResult <- M.getStanza
 	let getJID =
 		X.elementChildren
-		>=> X.isNamed "{urn:ietf:params:xml:ns:xmpp-bind}jid"
+		>=> X.isNamed (s"{urn:ietf:params:xml:ns:xmpp-bind}jid")
 		>=> X.elementNodes
 		>=> X.isContent
 		>=> return . X.contentText


@@ 126,14 125,14 @@ bindJID jid = do
 
 bindStanza :: Maybe J.Resource -> IQ
 bindStanza resource = (emptyIQ IQSet) { iqPayload = Just payload } where
-	payload = X.element "{urn:ietf:params:xml:ns:xmpp-bind}bind" [] requested
+	payload = X.element (s"{urn:ietf:params:xml:ns:xmpp-bind}bind") [] requested
 	requested = case fmap J.strResource resource of
 		Nothing -> []
-		Just x -> [X.NodeElement (X.element "resource" [] [X.NodeContent (X.ContentText x)])]
+		Just x -> [X.NodeElement (X.element (s"resource") [] [X.NodeContent (X.ContentText x)])]
 
 sessionStanza :: IQ
 sessionStanza = (emptyIQ IQSet) { iqPayload = Just payload } where
-	payload = X.element "{urn:ietf:params:xml:ns:xmpp-session}session" [] []
+	payload = X.element (s"{urn:ietf:params:xml:ns:xmpp-session}session") [] []
 
 streamSupportsTLS :: [F.Feature] -> Bool
 streamSupportsTLS = any isStartTLS where


@@ 141,7 140,7 @@ streamSupportsTLS = any isStartTLS where
 	isStartTLS _                     = False
 
 xmlStartTLS :: X.Element
-xmlStartTLS = X.element "{urn:ietf:params:xml:ns:xmpp-tls}starttls" [] []
+xmlStartTLS = X.element (s"{urn:ietf:params:xml:ns:xmpp-tls}starttls") [] []
 
 void :: Monad m => m a -> m ()
 void m = m >> return ()

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2009-2011 John Millikin <jmillikin@gmail.com>
 -- 
 -- This program is free software: you can redistribute it and/or modify


@@ 34,6 32,7 @@ import qualified Network.Protocol.SASL.GNU as SASL
 import qualified Network.Protocol.XMPP.Monad as M
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID, formatJID, jidResource)
+import           Network.Protocol.XMPP.String (s)
 
 data Result = Success | Failure X.Element
 	deriving (Show, Eq)


@@ 73,12 72,12 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 			SASL.setProperty SASL.PropertyAuthzID (encodeUtf8 authz)
 			SASL.setProperty SASL.PropertyAuthID (encodeUtf8 username)
 			SASL.setProperty SASL.PropertyPassword (encodeUtf8 password)
-			SASL.setProperty SASL.PropertyService "xmpp"
+			SASL.setProperty SASL.PropertyService (s"xmpp")
 			SASL.setProperty SASL.PropertyHostname (encodeUtf8 hostname)
 
-			(b64text, rc) <- SASL.step64 ""
-			putElement ctx $ X.element "{urn:ietf:params:xml:ns:xmpp-sasl}auth"
-				[("mechanism", Data.Text.pack (Data.ByteString.Char8.unpack mechBytes))]
+			(b64text, rc) <- SASL.step64 Data.ByteString.Char8.empty
+			putElement ctx $ X.element (s"{urn:ietf:params:xml:ns:xmpp-sasl}auth")
+				[(s"mechanism", Data.Text.pack (Data.ByteString.Char8.unpack mechBytes))]
 				[X.NodeContent (X.ContentText (Data.Text.pack (Data.ByteString.Char8.unpack b64text)))]
 
 			case rc of


@@ 96,11 95,11 @@ saslLoop ctx = do
 	let challenge = concatMap Data.Text.unpack challengeTexts
 	case X.elementName e of
 		-- The server needs more data before it can authenticate this client.
-		n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}challenge" -> do
+		n | n == s"{urn:ietf:params:xml:ns:xmpp-sasl}challenge" -> do
 			when (null challenge) (saslError "Received empty challenge")
 			(b64text, rc) <- SASL.step64 (Data.ByteString.Char8.pack challenge)
 			putElement ctx (X.element
-				"{urn:ietf:params:xml:ns:xmpp-sasl}response"
+				(s"{urn:ietf:params:xml:ns:xmpp-sasl}response")
 				[]
 				[X.NodeContent (X.ContentText (Data.Text.pack (Data.ByteString.Char8.unpack b64text)))])
 			case rc of


@@ 109,7 108,7 @@ saslLoop ctx = do
 
 		-- The server has authenticated this client, but the client-side
 		-- SASL protocol wants more data from the server.
-		n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}success" -> do
+		n | n == s"{urn:ietf:params:xml:ns:xmpp-sasl}success" -> do
 			when (null challenge) (saslError "Received empty challenge")
 			(_, rc) <- SASL.step64 (Data.ByteString.Char8.pack challenge)
 			case rc of


@@ 117,14 116,14 @@ saslLoop ctx = do
 				SASL.NeedsMore -> saslError "Server didn't provide enough SASL data."
 
 		-- The server has rejected this client's credentials.
-		n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}failure" -> return (Failure e)
+		n | n == s"{urn:ietf:params:xml:ns:xmpp-sasl}failure" -> return (Failure e)
 
 		_ -> saslError "Server sent unexpected element during authentication."
 
 saslFinish :: M.Session -> SASL.Session Result
 saslFinish ctx = do
 	elemt <- getElement ctx
-	return $ if X.elementName elemt == "{urn:ietf:params:xml:ns:xmpp-sasl}success"
+	return $ if X.elementName elemt == s"{urn:ietf:params:xml:ns:xmpp-sasl}success"
 		then Success
 		else Failure elemt
 

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 
 -- This program is free software: you can redistribute it and/or modify


@@ 21,12 19,12 @@ module Network.Protocol.XMPP.Client.Features
 	, parseFeature
 	) where
 
-import           Data.Maybe (fromMaybe)
 import           Control.Arrow ((&&&))
 import qualified Data.ByteString.Char8
 import           Data.ByteString (ByteString)
 import qualified Data.Text
 import qualified Network.Protocol.XMPP.XML as X
+import           Network.Protocol.XMPP.String (s)
 
 data Feature =
 	  FeatureStartTLS Bool


@@ 44,7 42,8 @@ parseFeatures e =
 
 parseFeature :: X.Element -> Feature
 parseFeature elemt = feature where
-	unpackName = (fromMaybe "" . X.nameNamespace) &&& X.nameLocalName
+	unpackName = (maybe "" Data.Text.unpack . X.nameNamespace) &&&
+		(Data.Text.unpack . X.nameLocalName)
 	feature = case unpackName (X.elementName elemt) of
 		("urn:ietf:params:xml:ns:xmpp-tls", "starttls") -> parseFeatureTLS elemt
 		("urn:ietf:params:xml:ns:xmpp-sasl", "mechanisms") -> parseFeatureSASL elemt


@@ 65,7 64,7 @@ parseFeatureSASL e = FeatureSASL $
 	>>= X.isContent
 
 nameMechanism :: X.Name
-nameMechanism = "{urn:ietf:params:xml:ns:xmpp-sasl}mechanism"
+nameMechanism = s"{urn:ietf:params:xml:ns:xmpp-sasl}mechanism"
 
 nameFeatures :: X.Name
-nameFeatures = "{http://etherx.jabber.org/streams}features"
+nameFeatures = s"{http://etherx.jabber.org/streams}features"

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2010 Stephan Maka <stephan@spaceboyz.net>
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 


@@ 39,6 37,7 @@ import qualified Network.Protocol.XMPP.Handle as H
 import qualified Network.Protocol.XMPP.Monad as M
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID)
+import           Network.Protocol.XMPP.String (s)
 
 runComponent :: C.Server
              -> Text -- ^ Server secret


@@ 49,14 48,14 @@ runComponent server password xmpp = do
 	rawHandle <- connectTo host port
 	IO.hSetBuffering rawHandle IO.NoBuffering
 	let handle = H.PlainHandle rawHandle
-	M.startXMPP handle "jabber:component:accept" $ do
+	M.startXMPP handle (s"jabber:component:accept") $ do
 		streamID <- beginStream jid
 		authenticate streamID password
 		xmpp
 
 beginStream :: JID -> M.XMPP Text
 beginStream jid = do
-	M.putBytes $ C.xmlHeader "jabber:component:accept" jid
+	M.putBytes $ C.xmlHeader (s"jabber:component:accept") jid
 	events <- M.readEvents C.startOfStream
 	case parseStreamID $ last events of
 		Nothing -> throwError M.NoComponentStreamID


@@ 66,17 65,17 @@ parseStreamID :: X.Event -> Maybe Text
 parseStreamID (X.EventBeginElement name attrs) = withNS <|> withoutNS
 	where
 	-- Hack to allow for global namespace without implementing full handling
-	withoutNS = X.attributeText "id" (X.Element name attrs [])
-	withNS = X.attributeText "{jabber:component:accept}id" (X.Element name attrs [])
+	withoutNS = X.attributeText (s"id") (X.Element name attrs [])
+	withNS = X.attributeText (s"{jabber:component:accept}id") (X.Element name attrs [])
 parseStreamID _ = Nothing
 
 authenticate :: Text -> Text -> M.XMPP ()
 authenticate streamID password = do
 	let bytes = buildSecret streamID password
 	let digest = showDigest (sha1 bytes)
-	M.putElement (X.element "handshake" [] [X.NodeContent (X.ContentText digest)])
+	M.putElement (X.element (s"handshake") [] [X.NodeContent (X.ContentText digest)])
 	result <- M.getElement
-	let nameHandshake = "{jabber:component:accept}handshake"
+	let nameHandshake = s"{jabber:component:accept}handshake"
 	when (null (X.isNamed nameHandshake result)) (throwError (M.AuthenticationFailure result))
 
 buildSecret :: Text -> Text -> ByteString

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 
 -- This program is free software: you can redistribute it and/or modify


@@ 30,6 28,7 @@ import           Data.Text.Encoding (encodeUtf8)
 
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID, formatJID)
+import           Network.Protocol.XMPP.String (s)
 
 data Server = Server
 	{ serverJID      :: JID


@@ 42,13 41,13 @@ data Server = Server
 -- attributes.
 xmlHeader :: Text -> JID -> ByteString
 xmlHeader ns jid = encodeUtf8 header where
-	attr x = Data.Text.concat ["\"", X.escape x, "\""]
+	attr x = Data.Text.concat [s"\"", X.escape x, s"\""]
 	header = Data.Text.concat
-		[ "<?xml version='1.0'?>\n"
-		, "<stream:stream xmlns=" , attr ns
-		, " to=", attr (formatJID jid)
-		, " version=\"1.0\""
-		, " xmlns:stream=\"http://etherx.jabber.org/streams\">"
+		[ s"<?xml version='1.0'?>\n"
+		, s"<stream:stream xmlns=" , attr ns
+		, s" to=", attr (formatJID jid)
+		, s" version=\"1.0\""
+		, s" xmlns:stream=\"http://etherx.jabber.org/streams\">"
 		]
 
 startOfStream :: Integer -> X.Event -> Bool


@@ 57,4 56,4 @@ startOfStream depth event = case (depth, event) of
 	_ -> False
 
 qnameStream :: X.Name
-qnameStream = "{http://etherx.jabber.org/streams}stream"
+qnameStream = s"{http://etherx.jabber.org/streams}stream"

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 
 -- This program is free software: you can redistribute it and/or modify


@@ 34,13 32,14 @@ import           Data.Text (Text)
 import qualified System.IO as IO
 import qualified Network.Protocol.TLS.GNU as TLS
 import           Network.Protocol.XMPP.ErrorT
+import           Network.Protocol.XMPP.String (s)
 
 data Handle =
 	  PlainHandle IO.Handle
 	| SecureHandle IO.Handle TLS.Session
 
 liftTLS :: TLS.Session -> TLS.TLS a -> ErrorT Text IO a
-liftTLS s = liftTLS' . TLS.runTLS s
+liftTLS session = liftTLS' . TLS.runTLS session
 
 liftTLS' :: IO (Either TLS.Error a) -> ErrorT Text IO a
 liftTLS' io = do


@@ 50,7 49,7 @@ liftTLS' io = do
 		Right x -> return x
 
 startTLS :: Handle -> ErrorT Text IO Handle
-startTLS (SecureHandle _ _) = E.throwError "Can't start TLS on a secure handle"
+startTLS (SecureHandle _ _) = E.throwError $ s"Can't start TLS on a secure handle"
 startTLS (PlainHandle h) = liftTLS' $ TLS.runClient (TLS.handleTransport h) $ do
 	TLS.setCredentials =<< TLS.certificateCredentials
 	TLS.handshake


@@ 58,12 57,12 @@ startTLS (PlainHandle h) = liftTLS' $ TLS.runClient (TLS.handleTransport h) $ do
 
 hPutBytes :: Handle -> ByteString -> ErrorT Text IO ()
 hPutBytes (PlainHandle h)  = liftIO . Data.ByteString.hPut h
-hPutBytes (SecureHandle _ s) = liftTLS s . TLS.putBytes . toLazy where
+hPutBytes (SecureHandle _ session) = liftTLS session . TLS.putBytes . toLazy where
 	toLazy bytes = Data.ByteString.Lazy.fromChunks [bytes]
 
 hGetBytes :: Handle -> Integer -> ErrorT Text IO ByteString
 hGetBytes (PlainHandle h) n = liftIO (Data.ByteString.hGet h (fromInteger n))
-hGetBytes (SecureHandle h s) n = liftTLS s $ do
+hGetBytes (SecureHandle h session) n = liftTLS session $ do
 	pending <- TLS.checkPending
 	let wait = void $ IO.hWaitForInput h (- 1)
 	when (pending == 0) (liftIO wait)

@@ 1,4 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
 
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>


@@ 76,11 75,11 @@ parseJID :: Text -> Maybe JID
 parseJID str = maybeJID where
 	(node, postNode) = case textSpanBy (/= '@') str of
 		(x, y) -> if Data.Text.null y
-			then ("", x)
+			then (Data.Text.empty, x)
 			else (x, Data.Text.drop 1 y)
 	(domain, resource) = case textSpanBy (/= '/') postNode of
 		(x, y) -> if Data.Text.null y
-			then (x, "")
+			then (x, Data.Text.empty)
 			else (x, Data.Text.drop 1 y)
 	nullable x f = if Data.Text.null x
 		then Just Nothing


@@ 103,8 102,8 @@ parseJID_ = fromMaybe (error "Malformed JID") . parseJID
 formatJID :: JID -> Text
 formatJID (JID node (Domain domain) resource) = formatted where
 	formatted = Data.Text.concat [node', domain, resource']
-	node' = maybe "" (\(Node x) -> Data.Text.append x "@") node
-	resource' = maybe "" (\(Resource x) -> Data.Text.append "/" x) resource
+	node' = maybe Data.Text.empty (\(Node x) -> Data.Text.snoc x '@') node
+	resource' = maybe Data.Text.empty (\(Resource x) -> Data.Text.cons '/' x) resource
 
 -- Similar to 'comparing'
 equaling :: Eq a => (b -> a) -> b -> b -> Bool

@@ 1,5 1,4 @@
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 


@@ 55,6 54,7 @@ import           Network.Protocol.XMPP.ErrorT
 import qualified Network.Protocol.XMPP.Handle as H
 import qualified Network.Protocol.XMPP.Stanza as S
 import qualified Network.Protocol.XMPP.XML as X
+import           Network.Protocol.XMPP.String (s)
 
 data Error
 	-- | The remote host refused the specified authentication credentials.


@@ 115,7 115,7 @@ instance MonadFix XMPP where
 	mfix f = XMPP (mfix (unXMPP . f))
 
 runXMPP :: Session -> XMPP a -> IO (Either Error a)
-runXMPP s xmpp = R.runReaderT (runErrorT (unXMPP xmpp)) s
+runXMPP session xmpp = R.runReaderT (runErrorT (unXMPP xmpp)) session
 
 startXMPP :: H.Handle -> Text -> XMPP a -> IO (Either Error a)
 startXMPP h ns xmpp = do


@@ 128,14 128,14 @@ restartXMPP :: Maybe H.Handle -> XMPP a -> XMPP a
 restartXMPP newH xmpp = do
 	Session oldH ns _ readLock writeLock <- getSession
 	sax <- liftIO X.newParser
-	let s = Session (fromMaybe oldH newH) ns sax readLock writeLock
-	XMPP (R.local (const s) (unXMPP xmpp))
+	let session = Session (fromMaybe oldH newH) ns sax readLock writeLock
+	XMPP (R.local (const session) (unXMPP xmpp))
 
 withLock :: (Session -> M.MVar ()) -> XMPP a -> XMPP a
 withLock getLock xmpp = do
-	s <- getSession
-	let mvar = getLock s
-	res <- liftIO (M.withMVar mvar (\_ -> runXMPP s xmpp))
+	session <- getSession
+	let mvar = getLock session
+	res <- liftIO (M.withMVar mvar (const $ runXMPP session xmpp))
 	case res of
 		Left err -> E.throwError err
 		Right x -> return x


@@ 187,7 187,7 @@ getElement = xmpp where
 		events <- readEvents endOfTree
 		case X.eventsToElement events of
 			Just x -> return x
-			Nothing -> E.throwError (TransportError "getElement: invalid event list")
+			Nothing -> E.throwError (TransportError $ s"getElement: invalid event list")
 
 	endOfTree 0 (X.EventEndElement _) = True
 	endOfTree _ _ = False

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 
 -- This program is free software: you can redistribute it and/or modify


@@ 33,12 31,14 @@ module Network.Protocol.XMPP.Stanza
 	, elementToStanza
 	) where
 
+import           Data.String (fromString)
 import           Data.Maybe (listToMaybe)
 import           Control.Monad (when)
 import qualified Data.Text
 import           Data.Text (Text)
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID, parseJID, formatJID)
+import           Network.Protocol.XMPP.String (s)
 
 class Stanza a where
 	stanzaTo        :: a -> Maybe JID


@@ 186,19 186,19 @@ emptyIQ t = IQ
 	, iqPayload = Nothing
 	}
 
-stanzaToElement' :: Stanza a => a -> X.Name -> Text -> X.Element
-stanzaToElement' stanza name typeStr = X.element name attrs payloads where
+stanzaToElement' :: Stanza a => a -> String -> String -> X.Element
+stanzaToElement' stanza name typeStr = X.element (fromString name) attrs payloads where
 	payloads = map X.NodeElement (stanzaPayloads stanza)
 	attrs = concat
 		[ mattr "to" (fmap formatJID . stanzaTo)
 		, mattr "from" (fmap formatJID . stanzaFrom)
 		, mattr "id" stanzaID
 		, mattr "xml:lang" stanzaLang
-		, if Data.Text.null typeStr then [] else [("type", typeStr)]
+		, mattr "type" (const $ fromString <$> if null typeStr then Nothing else Just typeStr)
 		]
 	mattr label f = case f stanza of
 		Nothing -> []
-		Just text -> [(label, text)]
+		Just text -> [(fromString label, text)]
 
 elementToStanza :: Text -> X.Element -> Maybe ReceivedStanza
 elementToStanza ns elemt = do


@@ 206,27 206,27 @@ elementToStanza ns elemt = do
 	when (elemNS /= Just ns) Nothing
 
 	let elemName = X.nameLocalName (X.elementName elemt)
-	case elemName of
+	case Data.Text.unpack elemName of
 		"message" -> ReceivedMessage `fmap` parseMessage elemt
 		"presence" -> ReceivedPresence `fmap` parsePresence elemt
 		"iq" -> ReceivedIQ `fmap` parseIQ elemt
 		_ -> Nothing
 
 parseStanzaCommon ::
-	   (Maybe Text -> Maybe t)
+	   (Maybe String -> Maybe t)
 	-> (t -> Maybe JID -> Maybe JID -> Maybe Text -> Maybe Text -> [X.Element] -> s)
 	-> X.Element
 	-> Maybe s
 parseStanzaCommon parseType mk elemt = do
-	to <- xmlJID "to" elemt
-	from <- xmlJID "from" elemt
-	typ <- parseType $ X.attributeText "type" elemt
+	to <- xmlJID (s"to") elemt
+	from <- xmlJID (s"from") elemt
+	typ <- parseType $ Data.Text.unpack <$> X.attributeText (s"type") elemt
 	return $ mk
 		typ
 		to
 		from
-		(X.attributeText "id" elemt)
-		(X.attributeText "lang" elemt)
+		(X.attributeText (s"id") elemt)
+		(X.attributeText (s"lang") elemt)
 		(X.elementChildren elemt)
 
 parseMessage :: X.Element -> Maybe Message

@@ 0,0 1,6 @@
+module Network.Protocol.XMPP.String (s) where
+
+import Data.String (IsString, fromString)
+
+s :: (IsString s) => String -> s
+s = fromString

@@ 1,5 1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- Copyright (C) 2010-2011 John Millikin <jmillikin@gmail.com>
 -- 
 -- This program is free software: you can redistribute it and/or modify


@@ 43,23 41,25 @@ import           Data.XML.Types
 import           Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import qualified Text.XML.LibXML.SAX as SAX
 
+import Network.Protocol.XMPP.String (s)
+
 contentText :: Content -> Text
 contentText (ContentText t) = t
-contentText (ContentEntity e) = Data.Text.concat ["&", e, ";"]
+contentText (ContentEntity e) = Data.Text.concat [s"&", e, s";"]
 
 escape :: Text -> Text
 escape = Data.Text.concatMap escapeChar where
 	escapeChar c = case c of
-		'&' -> "&amp;"
-		'<' -> "&lt;"
-		'>' -> "&gt;"
-		'"' -> "&quot;"
-		'\'' -> "&apos;"
+		'&' -> s"&amp;"
+		'<' -> s"&lt;"
+		'>' -> s"&gt;"
+		'"' -> s"&quot;"
+		'\'' -> s"&apos;"
 		_ -> Data.Text.singleton c
 
 escapeContent :: Content -> Text
 escapeContent (ContentText t) = escape t
-escapeContent (ContentEntity e) = Data.Text.concat ["&", escape e, ";"]
+escapeContent (ContentEntity e) = Data.Text.concat [s"&", escape e, s";"]
 
 element :: Name -> [(Name, Text)] -> [Node] -> Element
 element name attrs = Element name (map mkattr attrs)


@@ 72,20 72,20 @@ mkattr (n, val) = (n, [ContentText val])
 -- TODO: better namespace / prefix handling
 serialiseElement :: Element -> Text
 serialiseElement e = text where
-	text = Data.Text.concat ["<", eName, " ", attrs, ">", contents, "</", eName, ">"]
+	text = Data.Text.concat [s"<", eName, s" ", attrs, s">", contents, s"</", eName, s">"]
 	eName = formatName (elementName e)
 	formatName = escape . nameLocalName
-	attrs = Data.Text.intercalate " " (map attr (elementAttributes e ++ nsattr))
-	attr (n, c) = Data.Text.concat ([formatName n, "=\""] ++ map escapeContent c ++ ["\""])
+	attrs = Data.Text.intercalate (s" ") (map attr (elementAttributes e ++ nsattr))
+	attr (n, c) = Data.Text.concat ([formatName n, s"=\""] ++ map escapeContent c ++ [s"\""])
 	nsattr = case nameNamespace $ elementName e of
 		Nothing -> []
-		Just ns -> [mkattr ("xmlns", ns)]
+		Just ns -> [mkattr (s"xmlns", ns)]
 	contents = Data.Text.concat (map serialiseNode (elementNodes e))
 
 	serialiseNode (NodeElement e') = serialiseElement e'
 	serialiseNode (NodeContent c) = escape (contentText c)
-	serialiseNode (NodeComment _) = ""
-	serialiseNode (NodeInstruction _) = ""
+	serialiseNode (NodeComment _) = Data.Text.empty
+	serialiseNode (NodeInstruction _) = Data.Text.empty
 
 -- quick-and-dirty imitation of libxml-sax-0.4 API; later, this should
 -- probably be rewritten to use ST and discard the list parsing

@@ 57,3 57,4 @@ library
     Network.Protocol.XMPP.Monad
     Network.Protocol.XMPP.Stanza
     Network.Protocol.XMPP.XML
+    Network.Protocol.XMPP.String