From e1ff362e707f9e0d47b8a919d35f16828c1b73fe Mon Sep 17 00:00:00 2001
From: Jon Kristensen <info@jonkri.com>
Date: Mon, 18 Feb 2013 02:15:32 +0100
Subject: [PATCH] Remove Pickle helpers from Network.Xmpp.Internal

---
 source/Network/Xmpp/Internal.hs             |  3 ---
 source/Network/Xmpp/Xep/ServiceDiscovery.hs | 24 +++++++++++++++++++++
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/source/Network/Xmpp/Internal.hs b/source/Network/Xmpp/Internal.hs
index be4246d..fbc0145 100644
--- a/source/Network/Xmpp/Internal.hs
+++ b/source/Network/Xmpp/Internal.hs
@@ -28,9 +28,6 @@ module Network.Xmpp.Internal
   , pushStanza
   , pullStanza
   , pushIQ
-  , pickleElem
-  , unpickleElem
-  , xpLangTag
   , SaslHandler(..)
   , prepCredentials
   , saslInit
diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs
index 4560729..be654ff 100644
--- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs
+++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs
@@ -163,3 +163,27 @@ queryItems to node session = do
                 Right r -> Right r
   where
     queryBody = pickleElem xpQueryItems (node, [])
+
+-- Given a pickler and an object, produces an Element.
+pickleElem :: PU [Node] a -> a -> Element
+pickleElem p = pickle $ xpNodeElem p
+
+-- Given a pickler and an element, produces an object.
+unpickleElem :: PU [Node] a -> Element -> Either UnpickleError a
+unpickleElem p x = unpickle (xpNodeElem p) x
+
+xpNodeElem :: PU [Node] a -> PU Element a
+xpNodeElem xp = PU { pickleTree = \x -> Prelude.head $ (pickleTree xp x) >>= \y ->
+                      case y of
+                        NodeElement e -> [e]
+                        _ -> []
+             , unpickleTree = \x -> case unpickleTree xp $ [NodeElement x] of
+                        Left l -> Left l
+                        Right (a,(_,c)) -> Right (a,(Nothing,c))
+                   }
+
+xpLangTag :: PU [Attribute] (Maybe LangTag)
+xpLangTag = xpAttrImplied xmlLang xpPrim
+
+xmlLang :: Name
+xmlLang = Name "lang" (Just "http://www.w3.org/XML/1998/namespace") (Just "xml")