diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index f6b7810..28ceb44 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -50,6 +50,7 @@ module Network.Xmpp , jidFromTexts , jidToText , jidToTexts + , parseJid , getJid -- * Stanzas -- | The basic protocol data unit in XMPP is the XML stanza. The stanza is diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index f74476e..dea21e7 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -49,6 +49,7 @@ module Network.Xmpp.Types , jidFromTexts , jidToText , jidToTexts + , parseJid , StreamEnd(..) , InvalidXmppXml(..) , SessionConfiguration(..) @@ -888,12 +889,12 @@ data Jid = Jid { -- | The @localpart@ of a JID is an optional identifier placed -- the entity associated with an XMPP localpart at a domain -- (i.e., @localpart\@domainpart/resourcepart@). , resourcepart :: !(Maybe Text) - } deriving (Eq, Ord, Show) -- A `Read' instance must validate. + } deriving (Eq, Ord) -- | Converts a JID to a Text. -jidToText :: Jid -> String +jidToText :: Jid -> Text jidToText (Jid nd dmn res) = - (maybe "" ((++ "@") . Text.unpack) nd) ++ (Text.unpack dmn) ++ + Text.pack $ (maybe "" ((++ "@") . Text.unpack) nd) ++ (Text.unpack dmn) ++ maybe "" (('/' :) . Text.unpack) res -- | Converts a JID to up to three Text values: (the optional) localpart, the @@ -901,6 +902,40 @@ jidToText (Jid nd dmn res) = jidToTexts :: Jid -> (Maybe Text, Text, Maybe Text) jidToTexts (Jid nd dmn res) = (nd, dmn, res) +-- Produces a Jid value in the format "parseJid \"\"". +instance Show Jid where + show (Jid nd dmn res) = + "parseJid \"" ++ maybe "" ((++ "@") . Text.unpack) nd ++ Text.unpack dmn ++ + maybe "" (('/' :) . Text.unpack) res ++ "\"" + +-- The string must be in the format "parseJid \"\"". +-- TODO: This function should produce its error values in a uniform way. +-- TODO: Do we need to care about precedence here? +instance Read Jid where + readsPrec _ s = do + -- Verifies that the first word is "parseJid", parses the second word and + -- the remainder, if any, and produces these two values or fails. + let (s', r) = case lex s of + [] -> error "Expected `parseJid \"\"'" + [("parseJid", r')] -> case lex r' of + [] -> error "Expected `parseJid \"\"'" + [(s', r)] -> (s', r) + _ -> error "Expected `parseJid \"\"'" + _ -> error "Expected `parseJid \"\"'" + -- Read the JID string (removes the quotes), validate, and return. + [(parseJid (read s' :: String), r)] -- May fail with "Prelude.read: no parse" + -- or the `parseJid' error message (see below) + +-- | Parses a JID string. +-- +-- Note: This function is only meant to be used to reverse @Jid@ Show +-- operations; it will produce an 'undefined' value if the JID does not +-- validate; please refer to @jidFromText@ for a safe equivalent. +parseJid :: String -> Jid +parseJid s = case jidFromText $ Text.pack s of + Just jid -> jid + Nothing -> error $ "Jid value (" ++ s ++ ") did not validate" + instance IsString Jid where fromString = fromJust . jidFromText . Text.pack