diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 78a5ced..0238254 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -49,7 +49,7 @@ Library , stm -any , xml-types -any , xml-conduit >= 1.0 - , xml-picklers >= 0.2 + , xml-picklers >= 0.2.2 , data-default -any , stringprep >= 0.1.5 Exposed-modules: Network.Xmpp diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index d3924ac..7c7ee8b 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -144,6 +144,7 @@ module Network.Xmpp , fork , forkSession -- * Misc + , LangTag(..) , exampleParams ) where diff --git a/source/Network/Xmpp/IM/Message.hs b/source/Network/Xmpp/IM/Message.hs index 45b5193..770e59c 100644 --- a/source/Network/Xmpp/IM/Message.hs +++ b/source/Network/Xmpp/IM/Message.hs @@ -19,19 +19,19 @@ data MessageThread = MessageThread data MessageSubject = MessageSubject (Maybe LangTag) Text xpMessageSubject :: PU [Element] MessageSubject -xpMessageSubject = xpElems . +xpMessageSubject = xpUnliftElems . xpWrap (\(l, s) -> MessageSubject l s) (\(MessageSubject l s) -> (l,s)) $ xpElem "{jabber:client}subject" xpLangTag $ xpContent xpId xpMessageBody :: PU [Element] MessageBody -xpMessageBody = xpElems . +xpMessageBody = xpUnliftElems . xpWrap (\(l, s) -> MessageBody l s) (\(MessageBody l s) -> (l,s)) $ xpElem "{jabber:client}body" xpLangTag $ xpContent xpId xpMessageThread :: PU [Element] MessageThread -xpMessageThread = xpElems +xpMessageThread = xpUnliftElems . xpWrap (\(t, p) -> MessageThread p t) (\(MessageThread p t) -> (t,p)) $ xpElem "{jabber:client}thread" diff --git a/source/Network/Xmpp/Monad.hs b/source/Network/Xmpp/Monad.hs index 5d01f74..97fcbe5 100644 --- a/source/Network/Xmpp/Monad.hs +++ b/source/Network/Xmpp/Monad.hs @@ -90,7 +90,7 @@ pullPickle :: PU [Node] a -> XmppConMonad a pullPickle p = do res <- unpickleElem p <$> pullElement case res of - Left e -> liftIO . Ex.throwIO $ StreamXMLError e + Left e -> liftIO . Ex.throwIO $ StreamXMLError (show e) Right r -> return r -- Pulls a stanza (or stream error) from the stream. Throws an error on a stream diff --git a/source/Network/Xmpp/Pickle.hs b/source/Network/Xmpp/Pickle.hs index 9937e72..04d5eee 100644 --- a/source/Network/Xmpp/Pickle.hs +++ b/source/Network/Xmpp/Pickle.hs @@ -70,11 +70,11 @@ right (Right r) = r unpickleElem' :: PU [Node] c -> Element -> c unpickleElem' p x = case unpickle (xpNodeElem p) x of - Left l -> error $ l ++ "\n saw: " ++ ppElement x + Left l -> error $ (show l) ++ "\n saw: " ++ ppElement x Right r -> r -- Given a pickler and an element, produces an object. -unpickleElem :: PU [Node] a -> Element -> Either String a +unpickleElem :: PU [Node] a -> Element -> Either UnpickleError a unpickleElem p x = unpickle (xpNodeElem p) x -- Given a pickler and an object, produces an Element. diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index a51114f..b91088e 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -33,7 +33,7 @@ streamUnpickleElem :: PU [Node] a -> StreamSink a streamUnpickleElem p x = do case unpickleElem p x of - Left l -> throwError $ StreamXMLError l + Left l -> throwError $ StreamXMLError (show l) Right r -> return r -- This is the conduit sink that handles the stream XML events. We extend it