From c02f18b99786a03a3bb1e3079aff720964d25b42 Mon Sep 17 00:00:00 2001
From: Jon Kristensen <jonkri@localhost.localdomain>
Date: Thu, 30 May 2013 20:47:06 +0200
Subject: [PATCH] Add Read and Show instances for Jid

Here's a hack with `Read' and `Show' instances for Jid, as discussed.
I didn't have the time or patience to make it elegant, but at least it
does the job.

I'm calling it `jid' instead of `toJid' for the time-being since
`toJid' is already used in the stream configuration record.

Fixes #24.
---
 source/Network/Xmpp.hs       |  1 +
 source/Network/Xmpp/Types.hs | 34 +++++++++++++++++++++++++++++-----
 2 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs
index 0968b96..de6cf16 100644
--- a/source/Network/Xmpp.hs
+++ b/source/Network/Xmpp.hs
@@ -48,6 +48,7 @@ module Network.Xmpp
   , isFull
   , jidFromText
   , jidFromTexts
+  , toJid
   , 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 d93bb70..469c7b2 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -888,15 +888,39 @@ data Jid = Jid { -- | The @localpart@ of a JID is an optional identifier placed
                , resourcepart :: !(Maybe Text)
                } deriving (Eq, Ord)
 
+-- Produces a Jid value in the format "jid \"<jid>\"".
 instance Show Jid where
   show (Jid nd dmn res) =
-      maybe "" ((++ "@") . Text.unpack) nd ++ Text.unpack dmn ++
-          maybe "" (('/' :) . Text.unpack) res
+      "jid \"" ++ maybe "" ((++ "@") . Text.unpack) nd ++ Text.unpack dmn ++
+          maybe "" (('/' :) . Text.unpack) res ++ "\""
 
+-- The string must be in the format "jid \"<jid>\"".
+-- 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 _ x = case jidFromText (Text.pack x) of
-      Nothing -> []
-      Just j -> [(j,"")]
+    readsPrec _ s = do
+        -- Verifies that the first word is "jid", 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 `jid \"<jid>\"'"
+                          [("jid", r')] -> case lex r' of
+                                              [] -> error "Expected `jid \"<jid>\"'"
+                                              [(s', r)] -> (s', r)
+                                              _ -> error "Expected `jid \"<jid>\"'"
+                          _ -> error "Expected `jid \"<jid>\"'"
+        -- Read the JID string (removes the quotes), validate, and return.
+        [(jid (read s' :: String), r)] -- May fail with "Prelude.read: no parse"
+                                       -- or the `jid' 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.
+jid :: String -> Jid
+jid 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