-- Picklers and unpicklers convert Haskell data to XML and XML to Haskell data,
-- respectively. By convention, pickler/unpickler ("PU") function names start
-- with "xp".

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

{-# OPTIONS_HADDOCK hide #-}

module Network.Xmpp.Marshal where

import           Data.XML.Pickle
import           Data.XML.Types

import qualified Control.Exception as Ex
import           Data.Text (Text)
import qualified Data.Text as Text

import           Network.Xmpp.Types

xpNonemptyText :: PU Text NonemptyText
xpNonemptyText :: PU Text NonemptyText
xpNonemptyText = (Text
"xpNonemptyText" , Text
"") (Text, Text) -> PU Text NonemptyText -> PU Text NonemptyText
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (Text -> NonemptyText)
-> (NonemptyText -> Text) -> PU Text Text -> PU Text NonemptyText
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Text -> NonemptyText
Nonempty NonemptyText -> Text
fromNonempty PU Text Text
xpText

xpStreamElement :: PU [Node] (Either StreamErrorInfo XmppElement)
xpStreamElement :: PU [Node] (Either StreamErrorInfo XmppElement)
xpStreamElement = PU [Node] StreamErrorInfo
-> PU [Node] XmppElement
-> PU [Node] (Either StreamErrorInfo XmppElement)
forall n t1 t2. PU n t1 -> PU n t2 -> PU n (Either t1 t2)
xpEither PU [Node] StreamErrorInfo
xpStreamError (PU [Node] XmppElement
 -> PU [Node] (Either StreamErrorInfo XmppElement))
-> PU [Node] XmppElement
-> PU [Node] (Either StreamErrorInfo XmppElement)
forall a b. (a -> b) -> a -> b
$ (XmppElement -> Int)
-> [PU [Node] XmppElement] -> PU [Node] XmppElement
forall a t. (a -> Int) -> [PU t a] -> PU t a
xpAlt XmppElement -> Int
elemSel
    [ (Stanza -> XmppElement)
-> (XmppElement -> Stanza)
-> PU [Node] Stanza
-> PU [Node] XmppElement
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Stanza -> XmppElement
XmppStanza     (\(XmppStanza     Stanza
x) -> Stanza
x) PU [Node] Stanza
xpStanza
    , (Element -> XmppElement)
-> (XmppElement -> Element)
-> PU [Node] Element
-> PU [Node] XmppElement
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Element -> XmppElement
XmppNonza      (\(XmppNonza      Element
x) -> Element
x) PU [Node] Element
xpElemVerbatim
    ]
  where
    -- Selector for which pickler to execute above.
    elemSel :: XmppElement -> Int
    elemSel :: XmppElement -> Int
elemSel (XmppStanza     Stanza
_) = Int
0
    elemSel (XmppNonza      Element
_) = Int
1

xpStreamStanza :: PU [Node] (Either StreamErrorInfo Stanza)
xpStreamStanza :: PU [Node] (Either StreamErrorInfo Stanza)
xpStreamStanza = PU [Node] StreamErrorInfo
-> PU [Node] Stanza -> PU [Node] (Either StreamErrorInfo Stanza)
forall n t1 t2. PU n t1 -> PU n t2 -> PU n (Either t1 t2)
xpEither PU [Node] StreamErrorInfo
xpStreamError PU [Node] Stanza
xpStanza

xpExtendedAttrs :: PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs :: PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs = (Text
"xpAttrVerbatim" , Text
"") (Text, Text)
-> PU [Attribute] [ExtendedAttribute]
-> PU [Attribute] [ExtendedAttribute]
forall t a. (Text, Text) -> PU t a -> PU t a
<?+>
                    ([Attribute] -> [ExtendedAttribute])
-> ([ExtendedAttribute] -> [Attribute])
-> PU [Attribute] [ExtendedAttribute]
forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso ((Attribute -> ExtendedAttribute)
-> [Attribute] -> [ExtendedAttribute]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, [Content]
cs) -> (Name
name, [Content] -> Text
flattenContents [Content]
cs)))
                          ((ExtendedAttribute -> Attribute)
-> [ExtendedAttribute] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, Text
c) -> (Name
name, [Text -> Content
ContentText Text
c])))
  where
    flattenContents :: [Content] -> Text
flattenContents = [Text] -> Text
Text.concat ([Text] -> Text) -> ([Content] -> [Text]) -> [Content] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Content] -> [Text]
filterContentText
    filterContentText :: [Content] -> [Text]
filterContentText = (Content -> Text) -> [Content] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Content
c -> case Content
c of
        ContentText Text
t -> Text
t
        ContentEntity{} -> UnresolvedEntityException -> Text
forall a e. Exception e => e -> a
Ex.throw UnresolvedEntityException
UnresolvedEntityException )

xpStanza :: PU [Node] Stanza
xpStanza :: PU [Node] Stanza
xpStanza = (Text
"xpStanza" , Text
"") (Text, Text) -> PU [Node] Stanza -> PU [Node] Stanza
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (Stanza -> Int) -> [PU [Node] Stanza] -> PU [Node] Stanza
forall a t. (a -> Int) -> [PU t a] -> PU t a
xpAlt Stanza -> Int
stanzaSel
    [ (IQRequest -> Stanza)
-> (Stanza -> IQRequest) -> PU [Node] IQRequest -> PU [Node] Stanza
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap IQRequest -> Stanza
IQRequestS     (\(IQRequestS     IQRequest
x) -> IQRequest
x) PU [Node] IQRequest
xpIQRequest
    , (IQResult -> Stanza)
-> (Stanza -> IQResult) -> PU [Node] IQResult -> PU [Node] Stanza
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap IQResult -> Stanza
IQResultS      (\(IQResultS      IQResult
x) -> IQResult
x) PU [Node] IQResult
xpIQResult
    , (IQError -> Stanza)
-> (Stanza -> IQError) -> PU [Node] IQError -> PU [Node] Stanza
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap IQError -> Stanza
IQErrorS       (\(IQErrorS       IQError
x) -> IQError
x) PU [Node] IQError
xpIQError
    , (MessageError -> Stanza)
-> (Stanza -> MessageError)
-> PU [Node] MessageError
-> PU [Node] Stanza
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap MessageError -> Stanza
MessageErrorS  (\(MessageErrorS  MessageError
x) -> MessageError
x) PU [Node] MessageError
xpMessageError
    , (Message -> Stanza)
-> (Stanza -> Message) -> PU [Node] Message -> PU [Node] Stanza
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Message -> Stanza
MessageS       (\(MessageS       Message
x) -> Message
x) PU [Node] Message
xpMessage
    , (PresenceError -> Stanza)
-> (Stanza -> PresenceError)
-> PU [Node] PresenceError
-> PU [Node] Stanza
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap PresenceError -> Stanza
PresenceErrorS (\(PresenceErrorS PresenceError
x) -> PresenceError
x) PU [Node] PresenceError
xpPresenceError
    , (Presence -> Stanza)
-> (Stanza -> Presence) -> PU [Node] Presence -> PU [Node] Stanza
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap Presence -> Stanza
PresenceS      (\(PresenceS      Presence
x) -> Presence
x) PU [Node] Presence
xpPresence
    ]
  where
    -- Selector for which pickler to execute above.
    stanzaSel :: Stanza -> Int
    stanzaSel :: Stanza -> Int
stanzaSel (IQRequestS     IQRequest
_) = Int
0
    stanzaSel (IQResultS      IQResult
_) = Int
1
    stanzaSel (IQErrorS       IQError
_) = Int
2
    stanzaSel (MessageErrorS  MessageError
_) = Int
3
    stanzaSel (MessageS       Message
_) = Int
4
    stanzaSel (PresenceErrorS PresenceError
_) = Int
5
    stanzaSel (PresenceS      Presence
_) = Int
6

xpMessage :: PU [Node] (Message)
xpMessage :: PU [Node] Message
xpMessage = (Text
"xpMessage" , Text
"") (Text, Text) -> PU [Node] Message -> PU [Node] Message
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((MessageType, Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
   [ExtendedAttribute]),
  [Element])
 -> Message)
-> (Message
    -> ((MessageType, Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
         [ExtendedAttribute]),
        [Element]))
-> PU
     [Node]
     ((MessageType, Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
       [ExtendedAttribute]),
      [Element])
-> PU [Node] Message
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((MessageType
tp, Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attrs), [Element]
ext) -> Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> MessageType
-> [Element]
-> [ExtendedAttribute]
-> Message
Message Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang MessageType
tp [Element]
ext [ExtendedAttribute]
attrs)
    (\(Message Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang MessageType
tp [Element]
ext [ExtendedAttribute]
attrs) -> ((MessageType
tp, Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attrs), [Element]
ext))
    (Name
-> PU
     [Attribute]
     (MessageType, Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
      [ExtendedAttribute])
-> PU [Node] [Element]
-> PU
     [Node]
     ((MessageType, Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
       [ExtendedAttribute]),
      [Element])
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}message"
         (PU [Attribute] MessageType
-> PU [Attribute] (Maybe Text)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe LangTag)
-> PU [Attribute] [ExtendedAttribute]
-> PU
     [Attribute]
     (MessageType, Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
      [ExtendedAttribute])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
             (MessageType
-> PU [Attribute] MessageType -> PU [Attribute] MessageType
forall a t. Eq a => a -> PU [t] a -> PU [t] a
xpDefault MessageType
Normal (PU [Attribute] MessageType -> PU [Attribute] MessageType)
-> PU [Attribute] MessageType -> PU [Attribute] MessageType
forall a b. (a -> b) -> a -> b
$ Name -> PU Text MessageType -> PU [Attribute] MessageType
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"type" PU Text MessageType
xpMessageType)
             (Name -> PU Text Text -> PU [Attribute] (Maybe Text)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   PU Text Text
forall a. PU a a
xpId)
             (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
             (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
             PU [Attribute] (Maybe LangTag)
xpLangTag
             PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
             -- TODO: NS?
         )
         (PU [Node] Element -> PU [Node] [Element]
forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim)
    )

xpPresence :: PU [Node] Presence
xpPresence :: PU [Node] Presence
xpPresence = (Text
"xpPresence" , Text
"") (Text, Text) -> PU [Node] Presence -> PU [Node] Presence
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, PresenceType,
   [ExtendedAttribute]),
  [Element])
 -> Presence)
-> (Presence
    -> ((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, PresenceType,
         [ExtendedAttribute]),
        [Element]))
-> PU
     [Node]
     ((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, PresenceType,
       [ExtendedAttribute]),
      [Element])
-> PU [Node] Presence
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, PresenceType
tp, [ExtendedAttribute]
attr), [Element]
ext)
        -> Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> PresenceType
-> [Element]
-> [ExtendedAttribute]
-> Presence
Presence Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang PresenceType
tp [Element]
ext [ExtendedAttribute]
attr)
    (\(Presence Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang PresenceType
tp [Element]
ext [ExtendedAttribute]
attr)
       -> ((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, PresenceType
tp, [ExtendedAttribute]
attr), [Element]
ext))
    (Name
-> PU
     [Attribute]
     (Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, PresenceType,
      [ExtendedAttribute])
-> PU [Node] [Element]
-> PU
     [Node]
     ((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, PresenceType,
       [ExtendedAttribute]),
      [Element])
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}presence"
         (PU [Attribute] (Maybe Text)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe LangTag)
-> PU [Attribute] PresenceType
-> PU [Attribute] [ExtendedAttribute]
-> PU
     [Attribute]
     (Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, PresenceType,
      [ExtendedAttribute])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (Name -> PU Text Text -> PU [Attribute] (Maybe Text)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   PU Text Text
forall a. PU a a
xpId)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              PU [Attribute] (Maybe LangTag)
xpLangTag
              (PresenceType
-> PU [Attribute] PresenceType -> PU [Attribute] PresenceType
forall a t. Eq a => a -> PU [t] a -> PU [t] a
xpDefault PresenceType
Available (PU [Attribute] PresenceType -> PU [Attribute] PresenceType)
-> PU [Attribute] PresenceType -> PU [Attribute] PresenceType
forall a b. (a -> b) -> a -> b
$ Name -> PU Text PresenceType -> PU [Attribute] PresenceType
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"type" PU Text PresenceType
xpPresenceType)
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (PU [Node] Element -> PU [Node] [Element]
forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim)
    )

xpIQRequest :: PU [Node] IQRequest
xpIQRequest :: PU [Node] IQRequest
xpIQRequest = (Text
"xpIQRequest" , Text
"") (Text, Text) -> PU [Node] IQRequest -> PU [Node] IQRequest
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((Text, Maybe Jid, Maybe Jid, Maybe LangTag, IQRequestType,
   [ExtendedAttribute]),
  Element)
 -> IQRequest)
-> (IQRequest
    -> ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, IQRequestType,
         [ExtendedAttribute]),
        Element))
-> PU
     [Node]
     ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, IQRequestType,
       [ExtendedAttribute]),
      Element)
-> PU [Node] IQRequest
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, IQRequestType
tp, [ExtendedAttribute]
attr),Element
body)
       -> Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> IQRequestType
-> Element
-> [ExtendedAttribute]
-> IQRequest
IQRequest Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang IQRequestType
tp Element
body [ExtendedAttribute]
attr)
    (\(IQRequest Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang IQRequestType
tp Element
body [ExtendedAttribute]
attr)
        -> ((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, IQRequestType
tp, [ExtendedAttribute]
attr), Element
body))
    (Name
-> PU
     [Attribute]
     (Text, Maybe Jid, Maybe Jid, Maybe LangTag, IQRequestType,
      [ExtendedAttribute])
-> PU [Node] Element
-> PU
     [Node]
     ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, IQRequestType,
       [ExtendedAttribute]),
      Element)
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}iq"
         (PU [Attribute] Text
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe LangTag)
-> PU [Attribute] IQRequestType
-> PU [Attribute] [ExtendedAttribute]
-> PU
     [Attribute]
     (Text, Maybe Jid, Maybe Jid, Maybe LangTag, IQRequestType,
      [ExtendedAttribute])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
             (Name -> PU Text Text -> PU [Attribute] Text
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"id"   PU Text Text
forall a. PU a a
xpId)
             (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
             (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
             PU [Attribute] (Maybe LangTag)
xpLangTag
             ((Name -> PU Text IQRequestType -> PU [Attribute] IQRequestType
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"type" PU Text IQRequestType
xpIQRequestType))
             PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         PU [Node] Element
xpElemVerbatim
    )

xpIQResult :: PU [Node] IQResult
xpIQResult :: PU [Node] IQResult
xpIQResult = (Text
"xpIQResult" , Text
"") (Text, Text) -> PU [Node] IQResult -> PU [Node] IQResult
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
   [ExtendedAttribute]),
  Maybe Element)
 -> IQResult)
-> (IQResult
    -> ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
         [ExtendedAttribute]),
        Maybe Element))
-> PU
     [Node]
     ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
       [ExtendedAttribute]),
      Maybe Element)
-> PU [Node] IQResult
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, ()
_tp, [ExtendedAttribute]
attr),Maybe Element
body)
        -> Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> Maybe Element
-> [ExtendedAttribute]
-> IQResult
IQResult Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang Maybe Element
body [ExtendedAttribute]
attr)
    (\(IQResult Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang Maybe Element
body [ExtendedAttribute]
attr)
        -> ((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, (), [ExtendedAttribute]
attr ), Maybe Element
body))
    (Name
-> PU
     [Attribute]
     (Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
      [ExtendedAttribute])
-> PU [Node] (Maybe Element)
-> PU
     [Node]
     ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
       [ExtendedAttribute]),
      Maybe Element)
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}iq"
         (PU [Attribute] Text
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe LangTag)
-> PU [Attribute] ()
-> PU [Attribute] [ExtendedAttribute]
-> PU
     [Attribute]
     (Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
      [ExtendedAttribute])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
             (Name -> PU Text Text -> PU [Attribute] Text
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"id"   PU Text Text
forall a. PU a a
xpId)
             (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
             (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
             PU [Attribute] (Maybe LangTag)
xpLangTag
             ((Name -> Text -> PU [Attribute] ()
xpAttrFixed Name
"type" Text
"result"))
             PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (PU [Node] Element -> PU [Node] (Maybe Element)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim)
    )

----------------------------------------------------------
-- Errors
----------------------------------------------------------

xpStanzaErrorCondition :: PU [Node] StanzaErrorCondition
xpStanzaErrorCondition :: PU [Node] StanzaErrorCondition
xpStanzaErrorCondition = (Text
"xpErrorCondition" , Text
"") (Text, Text)
-> PU [Node] StanzaErrorCondition -> PU [Node] StanzaErrorCondition
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> ((StanzaErrorCondition, (), Maybe NonemptyText)
 -> Either String StanzaErrorCondition)
-> (StanzaErrorCondition
    -> (StanzaErrorCondition, (), Maybe NonemptyText))
-> PU [Node] (StanzaErrorCondition, (), Maybe NonemptyText)
-> PU [Node] StanzaErrorCondition
forall e a b t.
Show e =>
(a -> Either e b) -> (b -> a) -> PU t a -> PU t b
xpWrapEither
                   (\(StanzaErrorCondition
cond, (),Maybe NonemptyText
cont) -> case (StanzaErrorCondition
cond, Maybe NonemptyText
cont) of
                         (Gone Maybe NonemptyText
_, Maybe NonemptyText
x) -> StanzaErrorCondition -> Either String StanzaErrorCondition
forall a b. b -> Either a b
Right (StanzaErrorCondition -> Either String StanzaErrorCondition)
-> StanzaErrorCondition -> Either String StanzaErrorCondition
forall a b. (a -> b) -> a -> b
$ Maybe NonemptyText -> StanzaErrorCondition
Gone Maybe NonemptyText
x
                         (Redirect Maybe NonemptyText
_, Maybe NonemptyText
x) -> StanzaErrorCondition -> Either String StanzaErrorCondition
forall a b. b -> Either a b
Right (StanzaErrorCondition -> Either String StanzaErrorCondition)
-> StanzaErrorCondition -> Either String StanzaErrorCondition
forall a b. (a -> b) -> a -> b
$ Maybe NonemptyText -> StanzaErrorCondition
Redirect Maybe NonemptyText
x
                         (StanzaErrorCondition
x , Maybe NonemptyText
Nothing) -> StanzaErrorCondition -> Either String StanzaErrorCondition
forall a b. b -> Either a b
Right StanzaErrorCondition
x
                         (StanzaErrorCondition, Maybe NonemptyText)
_ -> String -> Either String StanzaErrorCondition
forall a b. a -> Either a b
Left
                              (String
"Only Gone and Redirect may have character data"
                                 :: String)
                              )
                   (\StanzaErrorCondition
x -> case StanzaErrorCondition
x of
                         (Gone Maybe NonemptyText
t) -> (Maybe NonemptyText -> StanzaErrorCondition
Gone Maybe NonemptyText
forall a. Maybe a
Nothing, (),  Maybe NonemptyText
t)
                         (Redirect Maybe NonemptyText
t) -> (Maybe NonemptyText -> StanzaErrorCondition
Redirect Maybe NonemptyText
forall a. Maybe a
Nothing, () , Maybe NonemptyText
t)
                         StanzaErrorCondition
c -> (StanzaErrorCondition
c, (), Maybe NonemptyText
forall a. Maybe a
Nothing))
    (Text
-> PU Text StanzaErrorCondition
-> PU [Attribute] ()
-> PU [Node] (Maybe NonemptyText)
-> PU [Node] (StanzaErrorCondition, (), Maybe NonemptyText)
forall name a n.
Text
-> PU Text name
-> PU [Attribute] a
-> PU [Node] n
-> PU [Node] (name, a, n)
xpElemByNamespace
        Text
"urn:ietf:params:xml:ns:xmpp-stanzas"
        PU Text StanzaErrorCondition
xpStanzaErrorConditionShape
        PU [Attribute] ()
forall a. PU [a] ()
xpUnit
        (PU [Node] NonemptyText -> PU [Node] (Maybe NonemptyText)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption (PU [Node] NonemptyText -> PU [Node] (Maybe NonemptyText))
-> PU [Node] NonemptyText -> PU [Node] (Maybe NonemptyText)
forall a b. (a -> b) -> a -> b
$ PU Text NonemptyText -> PU [Node] NonemptyText
forall a. PU Text a -> PU [Node] a
xpContent PU Text NonemptyText
xpNonemptyText)
    )
  where
    -- Create the "shape" of the error condition. In case of Gone and Redirect
    -- the optional field is left empty and must be filled in by the caller
    xpStanzaErrorConditionShape :: PU Text StanzaErrorCondition
    xpStanzaErrorConditionShape :: PU Text StanzaErrorCondition
xpStanzaErrorConditionShape = (Text
"xpStanzaErrorCondition", Text
"") (Text, Text)
-> PU Text StanzaErrorCondition -> PU Text StanzaErrorCondition
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
            (Text -> StanzaErrorCondition)
-> (StanzaErrorCondition -> Text) -> PU Text StanzaErrorCondition
forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso Text -> StanzaErrorCondition
forall a. (Eq a, IsString a) => a -> StanzaErrorCondition
stanzaErrorConditionFromText
                  StanzaErrorCondition -> Text
forall p. IsString p => StanzaErrorCondition -> p
stanzaErrorConditionToText
    stanzaErrorConditionToText :: StanzaErrorCondition -> p
stanzaErrorConditionToText StanzaErrorCondition
BadRequest = p
"bad-request"
    stanzaErrorConditionToText StanzaErrorCondition
Conflict = p
"conflict"
    stanzaErrorConditionToText StanzaErrorCondition
FeatureNotImplemented = p
"feature-not-implemented"
    stanzaErrorConditionToText StanzaErrorCondition
Forbidden = p
"forbidden"
    stanzaErrorConditionToText (Gone Maybe NonemptyText
_) = p
"gone"
    stanzaErrorConditionToText StanzaErrorCondition
InternalServerError = p
"internal-server-error"
    stanzaErrorConditionToText StanzaErrorCondition
ItemNotFound = p
"item-not-found"
    stanzaErrorConditionToText StanzaErrorCondition
JidMalformed = p
"jid-malformed"
    stanzaErrorConditionToText StanzaErrorCondition
NotAcceptable = p
"not-acceptable"
    stanzaErrorConditionToText StanzaErrorCondition
NotAllowed = p
"not-allowed"
    stanzaErrorConditionToText StanzaErrorCondition
NotAuthorized = p
"not-authorized"
    stanzaErrorConditionToText StanzaErrorCondition
PolicyViolation = p
"policy-violation"
    stanzaErrorConditionToText StanzaErrorCondition
RecipientUnavailable = p
"recipient-unavailable"
    stanzaErrorConditionToText (Redirect Maybe NonemptyText
_) = p
"redirect"
    stanzaErrorConditionToText StanzaErrorCondition
RegistrationRequired = p
"registration-required"
    stanzaErrorConditionToText StanzaErrorCondition
RemoteServerNotFound = p
"remote-server-not-found"
    stanzaErrorConditionToText StanzaErrorCondition
RemoteServerTimeout = p
"remote-server-timeout"
    stanzaErrorConditionToText StanzaErrorCondition
ResourceConstraint = p
"resource-constraint"
    stanzaErrorConditionToText StanzaErrorCondition
ServiceUnavailable = p
"service-unavailable"
    stanzaErrorConditionToText StanzaErrorCondition
SubscriptionRequired = p
"subscription-required"
    stanzaErrorConditionToText StanzaErrorCondition
UndefinedCondition = p
"undefined-condition"
    stanzaErrorConditionToText StanzaErrorCondition
UnexpectedRequest = p
"unexpected-request"
    stanzaErrorConditionFromText :: a -> StanzaErrorCondition
stanzaErrorConditionFromText a
"bad-request" = StanzaErrorCondition
BadRequest
    stanzaErrorConditionFromText a
"conflict" = StanzaErrorCondition
Conflict
    stanzaErrorConditionFromText a
"feature-not-implemented" = StanzaErrorCondition
FeatureNotImplemented
    stanzaErrorConditionFromText a
"forbidden" = StanzaErrorCondition
Forbidden
    stanzaErrorConditionFromText a
"gone" = Maybe NonemptyText -> StanzaErrorCondition
Gone Maybe NonemptyText
forall a. Maybe a
Nothing
    stanzaErrorConditionFromText a
"internal-server-error" = StanzaErrorCondition
InternalServerError
    stanzaErrorConditionFromText a
"item-not-found" = StanzaErrorCondition
ItemNotFound
    stanzaErrorConditionFromText a
"jid-malformed" = StanzaErrorCondition
JidMalformed
    stanzaErrorConditionFromText a
"not-acceptable" = StanzaErrorCondition
NotAcceptable
    stanzaErrorConditionFromText a
"not-allowed" = StanzaErrorCondition
NotAllowed
    stanzaErrorConditionFromText a
"not-authorized" = StanzaErrorCondition
NotAuthorized
    stanzaErrorConditionFromText a
"policy-violation" = StanzaErrorCondition
PolicyViolation
    stanzaErrorConditionFromText a
"recipient-unavailable" = StanzaErrorCondition
RecipientUnavailable
    stanzaErrorConditionFromText a
"redirect" = Maybe NonemptyText -> StanzaErrorCondition
Redirect Maybe NonemptyText
forall a. Maybe a
Nothing
    stanzaErrorConditionFromText a
"registration-required" = StanzaErrorCondition
RegistrationRequired
    stanzaErrorConditionFromText a
"remote-server-not-found" = StanzaErrorCondition
RemoteServerNotFound
    stanzaErrorConditionFromText a
"remote-server-timeout" = StanzaErrorCondition
RemoteServerTimeout
    stanzaErrorConditionFromText a
"resource-constraint" = StanzaErrorCondition
ResourceConstraint
    stanzaErrorConditionFromText a
"service-unavailable" = StanzaErrorCondition
ServiceUnavailable
    stanzaErrorConditionFromText a
"subscription-required" = StanzaErrorCondition
SubscriptionRequired
    stanzaErrorConditionFromText a
"undefined-condition" = StanzaErrorCondition
UndefinedCondition
    stanzaErrorConditionFromText a
"unexpected-request" = StanzaErrorCondition
UnexpectedRequest
    stanzaErrorConditionFromText a
_ = StanzaErrorCondition
UndefinedCondition



xpStanzaError :: PU [Node] StanzaError
xpStanzaError :: PU [Node] StanzaError
xpStanzaError = (Text
"xpStanzaError" , Text
"") (Text, Text) -> PU [Node] StanzaError -> PU [Node] StanzaError
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((StanzaErrorType, Maybe Text),
  (StanzaErrorCondition, Maybe (Maybe LangTag, NonemptyText),
   Maybe Element))
 -> StanzaError)
-> (StanzaError
    -> ((StanzaErrorType, Maybe Text),
        (StanzaErrorCondition, Maybe (Maybe LangTag, NonemptyText),
         Maybe Element)))
-> PU
     [Node]
     ((StanzaErrorType, Maybe Text),
      (StanzaErrorCondition, Maybe (Maybe LangTag, NonemptyText),
       Maybe Element))
-> PU [Node] StanzaError
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((StanzaErrorType
tp, Maybe Text
_code), (StanzaErrorCondition
cond, Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
ext)) -> StanzaErrorType
-> StanzaErrorCondition
-> Maybe (Maybe LangTag, NonemptyText)
-> Maybe Element
-> StanzaError
StanzaError StanzaErrorType
tp StanzaErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
ext)
    (\(StanzaError StanzaErrorType
tp StanzaErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
ext) -> ((StanzaErrorType
tp, Maybe Text
forall a. Maybe a
Nothing), (StanzaErrorCondition
cond, Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
ext)))
    (Name
-> PU [Attribute] (StanzaErrorType, Maybe Text)
-> PU
     [Node]
     (StanzaErrorCondition, Maybe (Maybe LangTag, NonemptyText),
      Maybe Element)
-> PU
     [Node]
     ((StanzaErrorType, Maybe Text),
      (StanzaErrorCondition, Maybe (Maybe LangTag, NonemptyText),
       Maybe Element))
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}error"
         (PU [Attribute] StanzaErrorType
-> PU [Attribute] (Maybe Text)
-> PU [Attribute] (StanzaErrorType, Maybe Text)
forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple
             (Name -> PU Text StanzaErrorType -> PU [Attribute] StanzaErrorType
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"type" PU Text StanzaErrorType
xpStanzaErrorType)
             (Name -> PU Text Text -> PU [Attribute] (Maybe Text)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttribute' Name
"code" PU Text Text
forall a. PU a a
xpId))
         (PU [Node] StanzaErrorCondition
-> PU [Node] (Maybe (Maybe LangTag, NonemptyText))
-> PU [Node] (Maybe Element)
-> PU
     [Node]
     (StanzaErrorCondition, Maybe (Maybe LangTag, NonemptyText),
      Maybe Element)
forall a a1 a2 a3.
PU [a] a1 -> PU [a] a2 -> PU [a] a3 -> PU [a] (a1, a2, a3)
xp3Tuple
              PU [Node] StanzaErrorCondition
xpStanzaErrorCondition
              (PU [Node] (Maybe LangTag, NonemptyText)
-> PU [Node] (Maybe (Maybe LangTag, NonemptyText))
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption (PU [Node] (Maybe LangTag, NonemptyText)
 -> PU [Node] (Maybe (Maybe LangTag, NonemptyText)))
-> PU [Node] (Maybe LangTag, NonemptyText)
-> PU [Node] (Maybe (Maybe LangTag, NonemptyText))
forall a b. (a -> b) -> a -> b
$ Name
-> PU [Attribute] (Maybe LangTag)
-> PU [Node] NonemptyText
-> PU [Node] (Maybe LangTag, NonemptyText)
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{urn:ietf:params:xml:ns:xmpp-stanzas}text"
                   (Name -> PU Text LangTag -> PU [Attribute] (Maybe LangTag)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
xmlLang PU Text LangTag
xpLang)
                   (PU Text NonemptyText -> PU [Node] NonemptyText
forall a. PU Text a -> PU [Node] a
xpContent PU Text NonemptyText
xpNonemptyText)
              )
              (PU [Node] Element -> PU [Node] (Maybe Element)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim)
         )
    )

xpMessageError :: PU [Node] (MessageError)
xpMessageError :: PU [Node] MessageError
xpMessageError = (Text
"xpMessageError" , Text
"") (Text, Text) -> PU [Node] MessageError -> PU [Node] MessageError
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> ((((), Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
   [ExtendedAttribute]),
  (StanzaError, [Element]))
 -> MessageError)
-> (MessageError
    -> (((), Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
         [ExtendedAttribute]),
        (StanzaError, [Element])))
-> PU
     [Node]
     (((), Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
       [ExtendedAttribute]),
      (StanzaError, [Element]))
-> PU [Node] MessageError
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((()
_, Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attr), (StanzaError
err, [Element]
ext)) ->
        Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> [Element]
-> [ExtendedAttribute]
-> MessageError
MessageError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr)
    (\(MessageError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr) ->
        (((), Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, [ExtendedAttribute]
attr), (StanzaError
err, [Element]
ext)))
    (Name
-> PU
     [Attribute]
     ((), Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
      [ExtendedAttribute])
-> PU [Node] (StanzaError, [Element])
-> PU
     [Node]
     (((), Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
       [ExtendedAttribute]),
      (StanzaError, [Element]))
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}message"
         (PU [Attribute] ()
-> PU [Attribute] (Maybe Text)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe LangTag)
-> PU [Attribute] [ExtendedAttribute]
-> PU
     [Attribute]
     ((), Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag,
      [ExtendedAttribute])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (Name -> Text -> PU [Attribute] ()
xpAttrFixed   Name
"type" Text
"error")
              (Name -> PU Text Text -> PU [Attribute] (Maybe Text)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   PU Text Text
forall a. PU a a
xpId)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              (Name -> PU Text LangTag -> PU [Attribute] (Maybe LangTag)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
xmlLang PU Text LangTag
xpLang)
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (PU [Node] StanzaError
-> PU [Node] [Element] -> PU [Node] (StanzaError, [Element])
forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple PU [Node] StanzaError
xpStanzaError (PU [Node] Element -> PU [Node] [Element]
forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim))
    )

xpPresenceError :: PU [Node] PresenceError
xpPresenceError :: PU [Node] PresenceError
xpPresenceError = (Text
"xpPresenceError" , Text
"") (Text, Text) -> PU [Node] PresenceError -> PU [Node] PresenceError
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
   [ExtendedAttribute]),
  (StanzaError, [Element]))
 -> PresenceError)
-> (PresenceError
    -> ((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
         [ExtendedAttribute]),
        (StanzaError, [Element])))
-> PU
     [Node]
     ((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
       [ExtendedAttribute]),
      (StanzaError, [Element]))
-> PU [Node] PresenceError
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, ()
_, [ExtendedAttribute]
attr),(StanzaError
err, [Element]
ext)) ->
        Maybe Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> [Element]
-> [ExtendedAttribute]
-> PresenceError
PresenceError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr)
    (\(PresenceError Maybe Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err [Element]
ext [ExtendedAttribute]
attr) ->
        ((Maybe Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, (), [ExtendedAttribute]
attr), (StanzaError
err, [Element]
ext)))
    (Name
-> PU
     [Attribute]
     (Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
      [ExtendedAttribute])
-> PU [Node] (StanzaError, [Element])
-> PU
     [Node]
     ((Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
       [ExtendedAttribute]),
      (StanzaError, [Element]))
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}presence"
         (PU [Attribute] (Maybe Text)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe LangTag)
-> PU [Attribute] ()
-> PU [Attribute] [ExtendedAttribute]
-> PU
     [Attribute]
     (Maybe Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
      [ExtendedAttribute])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (Name -> PU Text Text -> PU [Attribute] (Maybe Text)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id"   PU Text Text
forall a. PU a a
xpId)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              PU [Attribute] (Maybe LangTag)
xpLangTag
              (Name -> Text -> PU [Attribute] ()
xpAttrFixed Name
"type" Text
"error")
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (PU [Node] StanzaError
-> PU [Node] [Element] -> PU [Node] (StanzaError, [Element])
forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple PU [Node] StanzaError
xpStanzaError (PU [Node] Element -> PU [Node] [Element]
forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim))
    )

xpIQError :: PU [Node] IQError
xpIQError :: PU [Node] IQError
xpIQError = (Text
"xpIQError" , Text
"") (Text, Text) -> PU [Node] IQError -> PU [Node] IQError
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
   [ExtendedAttribute]),
  (StanzaError, Maybe Element))
 -> IQError)
-> (IQError
    -> ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
         [ExtendedAttribute]),
        (StanzaError, Maybe Element)))
-> PU
     [Node]
     ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
       [ExtendedAttribute]),
      (StanzaError, Maybe Element))
-> PU [Node] IQError
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, ()
_tp, [ExtendedAttribute]
attr),(StanzaError
err, Maybe Element
body)) ->
        Text
-> Maybe Jid
-> Maybe Jid
-> Maybe LangTag
-> StanzaError
-> Maybe Element
-> [ExtendedAttribute]
-> IQError
IQError Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err Maybe Element
body [ExtendedAttribute]
attr)
    (\(IQError Text
qid Maybe Jid
from Maybe Jid
to Maybe LangTag
lang StanzaError
err Maybe Element
body [ExtendedAttribute]
attr) ->
        ((Text
qid, Maybe Jid
from, Maybe Jid
to, Maybe LangTag
lang, (), [ExtendedAttribute]
attr), (StanzaError
err, Maybe Element
body)))
    (Name
-> PU
     [Attribute]
     (Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
      [ExtendedAttribute])
-> PU [Node] (StanzaError, Maybe Element)
-> PU
     [Node]
     ((Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
       [ExtendedAttribute]),
      (StanzaError, Maybe Element))
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem Name
"{jabber:client}iq"
         (PU [Attribute] Text
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe LangTag)
-> PU [Attribute] ()
-> PU [Attribute] [ExtendedAttribute]
-> PU
     [Attribute]
     (Text, Maybe Jid, Maybe Jid, Maybe LangTag, (),
      [ExtendedAttribute])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (Name -> PU Text Text -> PU [Attribute] Text
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr        Name
"id"   PU Text Text
forall a. PU a a
xpId)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
              (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to"   PU Text Jid
xpJid)
              PU [Attribute] (Maybe LangTag)
xpLangTag
              ((Name -> Text -> PU [Attribute] ()
xpAttrFixed Name
"type" Text
"error"))
              PU [Attribute] [ExtendedAttribute]
xpExtendedAttrs
         )
         (PU [Node] StanzaError
-> PU [Node] (Maybe Element)
-> PU [Node] (StanzaError, Maybe Element)
forall a b1 b2. PU [a] b1 -> PU [a] b2 -> PU [a] (b1, b2)
xp2Tuple PU [Node] StanzaError
xpStanzaError (PU [Node] Element -> PU [Node] (Maybe Element)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim))
    )

xpStreamError :: PU [Node] StreamErrorInfo
xpStreamError :: PU [Node] StreamErrorInfo
xpStreamError = (Text
"xpStreamError" , Text
"") (Text, Text)
-> PU [Node] StreamErrorInfo -> PU [Node] StreamErrorInfo
forall t a. (Text, Text) -> PU t a -> PU t a
<?+> (((StreamErrorCondition, (), ()),
  Maybe (Maybe LangTag, NonemptyText), Maybe Element)
 -> StreamErrorInfo)
-> (StreamErrorInfo
    -> ((StreamErrorCondition, (), ()),
        Maybe (Maybe LangTag, NonemptyText), Maybe Element))
-> PU
     [Node]
     ((StreamErrorCondition, (), ()),
      Maybe (Maybe LangTag, NonemptyText), Maybe Element)
-> PU [Node] StreamErrorInfo
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\((StreamErrorCondition
cond,() ,()), Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
el) -> StreamErrorCondition
-> Maybe (Maybe LangTag, NonemptyText)
-> Maybe Element
-> StreamErrorInfo
StreamErrorInfo StreamErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
el)
    (\(StreamErrorInfo StreamErrorCondition
cond Maybe (Maybe LangTag, NonemptyText)
txt Maybe Element
el) ->((StreamErrorCondition
cond,() ,()), Maybe (Maybe LangTag, NonemptyText)
txt, Maybe Element
el))
    (Name
-> PU
     [Node]
     ((StreamErrorCondition, (), ()),
      Maybe (Maybe LangTag, NonemptyText), Maybe Element)
-> PU
     [Node]
     ((StreamErrorCondition, (), ()),
      Maybe (Maybe LangTag, NonemptyText), Maybe Element)
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes
         (Text -> Maybe Text -> Maybe Text -> Name
Name
              Text
"error"
              (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://etherx.jabber.org/streams")
              (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"stream")
         )
         (PU [Node] (StreamErrorCondition, (), ())
-> PU [Node] (Maybe (Maybe LangTag, NonemptyText))
-> PU [Node] (Maybe Element)
-> PU
     [Node]
     ((StreamErrorCondition, (), ()),
      Maybe (Maybe LangTag, NonemptyText), Maybe Element)
forall a a1 a2 a3.
PU [a] a1 -> PU [a] a2 -> PU [a] a3 -> PU [a] (a1, a2, a3)
xp3Tuple
              (Text
-> PU Text StreamErrorCondition
-> PU [Attribute] ()
-> PU [Node] ()
-> PU [Node] (StreamErrorCondition, (), ())
forall name a n.
Text
-> PU Text name
-> PU [Attribute] a
-> PU [Node] n
-> PU [Node] (name, a, n)
xpElemByNamespace
                   Text
"urn:ietf:params:xml:ns:xmpp-streams"
                   PU Text StreamErrorCondition
xpStreamErrorCondition
                   PU [Attribute] ()
forall a. PU [a] ()
xpUnit
                   PU [Node] ()
forall a. PU [a] ()
xpUnit
              )
              (PU [Node] (Maybe LangTag, NonemptyText)
-> PU [Node] (Maybe (Maybe LangTag, NonemptyText))
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption (PU [Node] (Maybe LangTag, NonemptyText)
 -> PU [Node] (Maybe (Maybe LangTag, NonemptyText)))
-> PU [Node] (Maybe LangTag, NonemptyText)
-> PU [Node] (Maybe (Maybe LangTag, NonemptyText))
forall a b. (a -> b) -> a -> b
$ Name
-> PU [Attribute] (Maybe LangTag)
-> PU [Node] NonemptyText
-> PU [Node] (Maybe LangTag, NonemptyText)
forall a n.
Name -> PU [Attribute] a -> PU [Node] n -> PU [Node] (a, n)
xpElem
                   Name
"{urn:ietf:params:xml:ns:xmpp-streams}text"
                   PU [Attribute] (Maybe LangTag)
xpLangTag
                   (PU Text NonemptyText -> PU [Node] NonemptyText
forall a. PU Text a -> PU [Node] a
xpContent PU Text NonemptyText
xpNonemptyText)
              )
              (PU [Node] Element -> PU [Node] (Maybe Element)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Element
xpElemVerbatim) -- Application specific error conditions
         )
    )

xpLangTag :: PU [Attribute] (Maybe LangTag)
xpLangTag :: PU [Attribute] (Maybe LangTag)
xpLangTag = Name -> PU Text LangTag -> PU [Attribute] (Maybe LangTag)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
xmlLang PU Text LangTag
xpLang

xpLang :: PU Text LangTag
xpLang :: PU Text LangTag
xpLang = (Text
"xpLang", Text
"") (Text, Text) -> PU Text LangTag -> PU Text LangTag
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
    (Text -> Either Text LangTag)
-> (LangTag -> Text) -> PU Text LangTag
forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case Text -> Maybe LangTag
langTagFromText Text
input of
                               Maybe LangTag
Nothing -> Text -> Either Text LangTag
forall a b. a -> Either a b
Left Text
"Could not parse language tag."
                               Just LangTag
j -> LangTag -> Either Text LangTag
forall a b. b -> Either a b
Right LangTag
j)
              LangTag -> Text
langTagToText

xmlLang :: Name
xmlLang :: Name
xmlLang = Text -> Maybe Text -> Maybe Text -> Name
Name Text
"lang" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/XML/1998/namespace") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"xml")

-- Given a pickler and an object, produces an Element.
pickleElem :: PU [Node] a -> a -> Element
pickleElem :: PU [Node] a -> a -> Element
pickleElem PU [Node] a
p = PU Element a -> a -> Element
forall t a. PU t a -> a -> t
pickle (PU Element a -> a -> Element) -> PU Element a -> a -> Element
forall a b. (a -> b) -> a -> b
$ PU [Node] a -> PU Element a
forall a. PU [Node] a -> PU Element a
xpNodeElem PU [Node] a
p

-- Given a pickler and an element, produces an object.
unpickleElem :: PU [Node] a -> Element -> Either UnpickleError a
unpickleElem :: PU [Node] a -> Element -> Either UnpickleError a
unpickleElem PU [Node] a
p Element
x = PU Element a -> Element -> Either UnpickleError a
forall t a. PU t a -> t -> Either UnpickleError a
unpickle (PU [Node] a -> PU Element a
forall a. PU [Node] a -> PU Element a
xpNodeElem PU [Node] a
p) Element
x

xpNodeElem :: PU [Node] a -> PU Element a
xpNodeElem :: PU [Node] a -> PU Element a
xpNodeElem = PU [Element] a -> PU Element a
forall a b. PU [a] b -> PU a b
xpRoot (PU [Element] a -> PU Element a)
-> (PU [Node] a -> PU [Element] a) -> PU [Node] a -> PU Element a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU [Node] a -> PU [Element] a
forall a. PU [Node] a -> PU [Element] a
xpUnliftElems

mbl :: Maybe [a] -> [a]
mbl :: Maybe [a] -> [a]
mbl (Just [a]
l) = [a]
l
mbl Maybe [a]
Nothing = []

lmb :: [t] -> Maybe [t]
lmb :: [t] -> Maybe [t]
lmb [] = Maybe [t]
forall a. Maybe a
Nothing
lmb [t]
x = [t] -> Maybe [t]
forall a. a -> Maybe a
Just [t]
x

xpStream :: PU [Node] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
xpStream :: PU [Node] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
xpStream = Name
-> PU
     [Attribute] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
-> PU
     [Node] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
forall b. Name -> PU [Attribute] b -> PU [Node] b
xpElemAttrs
    (Text -> Maybe Text -> Maybe Text -> Name
Name Text
"stream" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://etherx.jabber.org/streams") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"stream"))
    (PU [Attribute] Text
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Jid)
-> PU [Attribute] (Maybe Text)
-> PU [Attribute] (Maybe LangTag)
-> PU
     [Attribute] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
forall a a1 a2 a3 a4 a5.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] (a1, a2, a3, a4, a5)
xp5Tuple
         (Name -> PU Text Text -> PU [Attribute] Text
forall a. Name -> PU Text a -> PU [Attribute] a
xpAttr Name
"version" PU Text Text
forall a. PU a a
xpId)
         (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"from" PU Text Jid
xpJid)
         (Name -> PU Text Jid -> PU [Attribute] (Maybe Jid)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"to" PU Text Jid
xpJid)
         (Name -> PU Text Text -> PU [Attribute] (Maybe Text)
forall a. Name -> PU Text a -> PU [Attribute] (Maybe a)
xpAttrImplied Name
"id" PU Text Text
forall a. PU a a
xpId)
         PU [Attribute] (Maybe LangTag)
xpLangTag
    )

-- Pickler/Unpickler for the stream features - TLS, SASL, and the rest.
xpStreamFeatures :: PU [Node] StreamFeatures
xpStreamFeatures :: PU [Node] StreamFeatures
xpStreamFeatures = (Text
"xpStreamFeatures",Text
"") (Text, Text)
-> PU [Node] StreamFeatures -> PU [Node] StreamFeatures
forall t a. (Text, Text) -> PU t a -> PU t a
<?> ((Maybe Bool, Maybe [Text], Maybe Bool, Bool, Maybe Bool,
  [Element])
 -> StreamFeatures)
-> (StreamFeatures
    -> (Maybe Bool, Maybe [Text], Maybe Bool, Bool, Maybe Bool,
        [Element]))
-> PU
     [Node]
     (Maybe Bool, Maybe [Text], Maybe Bool, Bool, Maybe Bool, [Element])
-> PU [Node] StreamFeatures
forall a b t. (a -> b) -> (b -> a) -> PU t a -> PU t b
xpWrap
    (\(Maybe Bool
tls, Maybe [Text]
sasl, Maybe Bool
ver, Bool
preAppr, Maybe Bool
session, [Element]
rest)
       -> Maybe Bool
-> [Text]
-> Maybe Bool
-> Bool
-> Maybe Bool
-> [Element]
-> StreamFeatures
StreamFeatures Maybe Bool
tls (Maybe [Text] -> [Text]
forall a. Maybe [a] -> [a]
mbl Maybe [Text]
sasl) Maybe Bool
ver Bool
preAppr Maybe Bool
session [Element]
rest )
    (\(StreamFeatures Maybe Bool
tls [Text]
sasl Maybe Bool
ver Bool
preAppr Maybe Bool
session [Element]
rest)
     -> (Maybe Bool
tls, [Text] -> Maybe [Text]
forall t. [t] -> Maybe [t]
lmb [Text]
sasl, Maybe Bool
ver, Bool
preAppr, Maybe Bool
session, [Element]
rest))
    (Name
-> PU
     [Node]
     (Maybe Bool, Maybe [Text], Maybe Bool, Bool, Maybe Bool, [Element])
-> PU
     [Node]
     (Maybe Bool, Maybe [Text], Maybe Bool, Bool, Maybe Bool, [Element])
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes
         (Text -> Maybe Text -> Maybe Text -> Name
Name
             Text
"features"
             (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://etherx.jabber.org/streams")
             (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"stream")
         )
         (PU [Node] (Maybe Bool)
-> PU [Node] (Maybe [Text])
-> PU [Node] (Maybe Bool)
-> PU [Node] Bool
-> PU [Node] (Maybe Bool)
-> PU [Node] [Element]
-> PU
     [Node]
     (Maybe Bool, Maybe [Text], Maybe Bool, Bool, Maybe Bool, [Element])
forall a a1 a2 a3 a4 a5 a6.
PU [a] a1
-> PU [a] a2
-> PU [a] a3
-> PU [a] a4
-> PU [a] a5
-> PU [a] a6
-> PU [a] (a1, a2, a3, a4, a5, a6)
xp6Tuple
              (PU [Node] Bool -> PU [Node] (Maybe Bool)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Bool
pickleTlsFeature)
              (PU [Node] [Text] -> PU [Node] (Maybe [Text])
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] [Text]
pickleSaslFeature)
              (PU [Node] Bool -> PU [Node] (Maybe Bool)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Bool
pickleRosterVer)
              PU [Node] Bool
picklePreApproval
              (PU [Node] Bool -> PU [Node] (Maybe Bool)
forall t a. PU [t] a -> PU [t] (Maybe a)
xpOption PU [Node] Bool
pickleSessionFeature)
              (PU [Node] Element -> PU [Node] [Element]
forall a b. PU [a] b -> PU [a] [b]
xpAll PU [Node] Element
xpElemVerbatim)
         )
    )
  where
    pickleTlsFeature :: PU [Node] Bool
    pickleTlsFeature :: PU [Node] Bool
pickleTlsFeature = (Text
"pickleTlsFeature", Text
"") (Text, Text) -> PU [Node] Bool -> PU [Node] Bool
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        Name -> PU [Node] Bool -> PU [Node] Bool
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:ietf:params:xml:ns:xmpp-tls}starttls"
        (Name -> PU [Node] Bool
xpElemExists Name
"{urn:ietf:params:xml:ns:xmpp-tls}required")
    pickleSaslFeature :: PU [Node] [Text]
    pickleSaslFeature :: PU [Node] [Text]
pickleSaslFeature = (Text
"pickleSaslFeature", Text
"") (Text, Text) -> PU [Node] [Text] -> PU [Node] [Text]
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        Name -> PU [Node] [Text] -> PU [Node] [Text]
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:ietf:params:xml:ns:xmpp-sasl}mechanisms"
        (PU [Node] Text -> PU [Node] [Text]
forall a b. PU [a] b -> PU [a] [b]
xpAll (PU [Node] Text -> PU [Node] [Text])
-> PU [Node] Text -> PU [Node] [Text]
forall a b. (a -> b) -> a -> b
$ Name -> PU [Node] Text -> PU [Node] Text
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes
             Name
"{urn:ietf:params:xml:ns:xmpp-sasl}mechanism" (PU Text Text -> PU [Node] Text
forall a. PU Text a -> PU [Node] a
xpContent PU Text Text
forall a. PU a a
xpId))
    pickleRosterVer :: PU [Node] Bool
pickleRosterVer = Name -> PU [Node] Bool -> PU [Node] Bool
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:xmpp:features:rosterver}ver" (PU [Node] Bool -> PU [Node] Bool)
-> PU [Node] Bool -> PU [Node] Bool
forall a b. (a -> b) -> a -> b
$
                           Name -> PU [Node] Bool
xpElemExists Name
"{urn:xmpp:features:rosterver}optional"
    picklePreApproval :: PU [Node] Bool
picklePreApproval = Name -> PU [Node] Bool
xpElemExists Name
"{urn:xmpp:features:pre-approval}sub"
    pickleSessionFeature :: PU [Node] Bool
    pickleSessionFeature :: PU [Node] Bool
pickleSessionFeature = (Text
"pickleSessionFeature", Text
"") (Text, Text) -> PU [Node] Bool -> PU [Node] Bool
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        Name -> PU [Node] Bool -> PU [Node] Bool
forall b. Name -> PU [Node] b -> PU [Node] b
xpElemNodes Name
"{urn:ietf:params:xml:ns:xmpp-session}session"
        (Name -> PU [Node] Bool
xpElemExists Name
"{urn:ietf:params:xml:ns:xmpp-session}optional")


xpJid :: PU Text Jid
xpJid :: PU Text Jid
xpJid = (Text
"xpJid", Text
"") (Text, Text) -> PU Text Jid -> PU Text Jid
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        (Text -> Either Text Jid) -> (Jid -> Text) -> PU Text Jid
forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case Text -> Maybe Jid
jidFromText Text
input of
                                   Maybe Jid
Nothing -> Text -> Either Text Jid
forall a b. a -> Either a b
Left Text
"Could not parse JID."
                                   Just Jid
j -> Jid -> Either Text Jid
forall a b. b -> Either a b
Right Jid
j)
                  Jid -> Text
jidToText

xpIQRequestType :: PU Text IQRequestType
xpIQRequestType :: PU Text IQRequestType
xpIQRequestType = (Text
"xpIQRequestType", Text
"") (Text, Text) -> PU Text IQRequestType -> PU Text IQRequestType
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        (Text -> Either Text IQRequestType)
-> (IQRequestType -> Text) -> PU Text IQRequestType
forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case Text -> Maybe IQRequestType
forall a. (Eq a, IsString a) => a -> Maybe IQRequestType
iqRequestTypeFromText Text
input of
                                   Maybe IQRequestType
Nothing -> Text -> Either Text IQRequestType
forall a b. a -> Either a b
Left Text
"Could not parse IQ request type."
                                   Just IQRequestType
j -> IQRequestType -> Either Text IQRequestType
forall a b. b -> Either a b
Right IQRequestType
j)
                  IQRequestType -> Text
forall p. IsString p => IQRequestType -> p
iqRequestTypeToText
  where
    iqRequestTypeFromText :: a -> Maybe IQRequestType
iqRequestTypeFromText a
"get" = IQRequestType -> Maybe IQRequestType
forall a. a -> Maybe a
Just IQRequestType
Get
    iqRequestTypeFromText a
"set" = IQRequestType -> Maybe IQRequestType
forall a. a -> Maybe a
Just IQRequestType
Set
    iqRequestTypeFromText a
_ = Maybe IQRequestType
forall a. Maybe a
Nothing
    iqRequestTypeToText :: IQRequestType -> p
iqRequestTypeToText IQRequestType
Get = p
"get"
    iqRequestTypeToText IQRequestType
Set = p
"set"

xpMessageType :: PU Text MessageType
xpMessageType :: PU Text MessageType
xpMessageType = (Text
"xpMessageType", Text
"") (Text, Text) -> PU Text MessageType -> PU Text MessageType
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        (Text -> MessageType)
-> (MessageType -> Text) -> PU Text MessageType
forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso Text -> MessageType
forall a. (Eq a, IsString a) => a -> MessageType
messageTypeFromText
              MessageType -> Text
forall p. IsString p => MessageType -> p
messageTypeToText
  where
    messageTypeFromText :: a -> MessageType
messageTypeFromText a
"chat" = MessageType
Chat
    messageTypeFromText a
"groupchat" = MessageType
GroupChat
    messageTypeFromText a
"headline" = MessageType
Headline
    messageTypeFromText a
"normal" = MessageType
Normal
    messageTypeFromText a
_ = MessageType
Normal
    messageTypeToText :: MessageType -> p
messageTypeToText MessageType
Chat = p
"chat"
    messageTypeToText MessageType
GroupChat = p
"groupchat"
    messageTypeToText MessageType
Headline = p
"headline"
    messageTypeToText MessageType
Normal = p
"normal"

xpPresenceType :: PU Text PresenceType
xpPresenceType :: PU Text PresenceType
xpPresenceType = (Text
"xpPresenceType", Text
"") (Text, Text) -> PU Text PresenceType -> PU Text PresenceType
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        (Text -> Either Text PresenceType)
-> (PresenceType -> Text) -> PU Text PresenceType
forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case Text -> Maybe PresenceType
forall a. (Eq a, IsString a) => a -> Maybe PresenceType
presenceTypeFromText Text
input of
                                   Maybe PresenceType
Nothing -> Text -> Either Text PresenceType
forall a b. a -> Either a b
Left Text
"Could not parse presence type."
                                   Just PresenceType
j -> PresenceType -> Either Text PresenceType
forall a b. b -> Either a b
Right PresenceType
j)
                  PresenceType -> Text
forall p. IsString p => PresenceType -> p
presenceTypeToText
  where
    presenceTypeFromText :: a -> Maybe PresenceType
presenceTypeFromText a
"" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Available
    presenceTypeFromText a
"available" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Available
    presenceTypeFromText a
"unavailable" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Unavailable
    presenceTypeFromText a
"subscribe" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Subscribe
    presenceTypeFromText a
"subscribed" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Subscribed
    presenceTypeFromText a
"unsubscribe" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Unsubscribe
    presenceTypeFromText a
"unsubscribed" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Unsubscribed
    presenceTypeFromText a
"probe" = PresenceType -> Maybe PresenceType
forall a. a -> Maybe a
Just PresenceType
Probe
    presenceTypeFromText a
_ = Maybe PresenceType
forall a. Maybe a
Nothing
    presenceTypeToText :: PresenceType -> p
presenceTypeToText PresenceType
Available = p
"available"
    presenceTypeToText PresenceType
Unavailable = p
"unavailable"
    presenceTypeToText PresenceType
Subscribe = p
"subscribe"
    presenceTypeToText PresenceType
Subscribed = p
"subscribed"
    presenceTypeToText PresenceType
Unsubscribe = p
"unsubscribe"
    presenceTypeToText PresenceType
Unsubscribed = p
"unsubscribed"
    presenceTypeToText PresenceType
Probe = p
"probe"

xpStanzaErrorType :: PU Text StanzaErrorType
xpStanzaErrorType :: PU Text StanzaErrorType
xpStanzaErrorType = (Text
"xpStanzaErrorType", Text
"") (Text, Text) -> PU Text StanzaErrorType -> PU Text StanzaErrorType
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        (Text -> Either Text StanzaErrorType)
-> (StanzaErrorType -> Text) -> PU Text StanzaErrorType
forall a b. (a -> Either Text b) -> (b -> a) -> PU a b
xpPartial ( \Text
input -> case Text -> Maybe StanzaErrorType
forall a. (Eq a, IsString a) => a -> Maybe StanzaErrorType
stanzaErrorTypeFromText Text
input of
                                   Maybe StanzaErrorType
Nothing -> Text -> Either Text StanzaErrorType
forall a b. a -> Either a b
Left Text
"Could not parse stanza error type."
                                   Just StanzaErrorType
j -> StanzaErrorType -> Either Text StanzaErrorType
forall a b. b -> Either a b
Right StanzaErrorType
j)
                  StanzaErrorType -> Text
forall p. IsString p => StanzaErrorType -> p
stanzaErrorTypeToText
  where
    stanzaErrorTypeFromText :: a -> Maybe StanzaErrorType
stanzaErrorTypeFromText a
"auth" = StanzaErrorType -> Maybe StanzaErrorType
forall a. a -> Maybe a
Just StanzaErrorType
Auth
    stanzaErrorTypeFromText a
"cancel" = StanzaErrorType -> Maybe StanzaErrorType
forall a. a -> Maybe a
Just StanzaErrorType
Cancel
    stanzaErrorTypeFromText a
"continue" = StanzaErrorType -> Maybe StanzaErrorType
forall a. a -> Maybe a
Just StanzaErrorType
Continue
    stanzaErrorTypeFromText a
"modify" = StanzaErrorType -> Maybe StanzaErrorType
forall a. a -> Maybe a
Just StanzaErrorType
Modify
    stanzaErrorTypeFromText a
"wait" = StanzaErrorType -> Maybe StanzaErrorType
forall a. a -> Maybe a
Just StanzaErrorType
Wait
    stanzaErrorTypeFromText a
_ = Maybe StanzaErrorType
forall a. Maybe a
Nothing
    stanzaErrorTypeToText :: StanzaErrorType -> p
stanzaErrorTypeToText StanzaErrorType
Auth = p
"auth"
    stanzaErrorTypeToText StanzaErrorType
Cancel = p
"cancel"
    stanzaErrorTypeToText StanzaErrorType
Continue = p
"continue"
    stanzaErrorTypeToText StanzaErrorType
Modify = p
"modify"
    stanzaErrorTypeToText StanzaErrorType
Wait = p
"wait"


xpStreamErrorCondition :: PU Text StreamErrorCondition
xpStreamErrorCondition :: PU Text StreamErrorCondition
xpStreamErrorCondition = (Text
"xpStreamErrorCondition", Text
"") (Text, Text)
-> PU Text StreamErrorCondition -> PU Text StreamErrorCondition
forall t a. (Text, Text) -> PU t a -> PU t a
<?>
        (Text -> StreamErrorCondition)
-> (StreamErrorCondition -> Text) -> PU Text StreamErrorCondition
forall a b. (a -> b) -> (b -> a) -> PU a b
xpIso Text -> StreamErrorCondition
forall a. (Eq a, IsString a) => a -> StreamErrorCondition
streamErrorConditionFromText
              StreamErrorCondition -> Text
forall p. IsString p => StreamErrorCondition -> p
streamErrorConditionToText
  where
    streamErrorConditionToText :: StreamErrorCondition -> p
streamErrorConditionToText StreamErrorCondition
StreamBadFormat              = p
"bad-format"
    streamErrorConditionToText StreamErrorCondition
StreamBadNamespacePrefix     = p
"bad-namespace-prefix"
    streamErrorConditionToText StreamErrorCondition
StreamConflict               = p
"conflict"
    streamErrorConditionToText StreamErrorCondition
StreamConnectionTimeout      = p
"connection-timeout"
    streamErrorConditionToText StreamErrorCondition
StreamHostGone               = p
"host-gone"
    streamErrorConditionToText StreamErrorCondition
StreamHostUnknown            = p
"host-unknown"
    streamErrorConditionToText StreamErrorCondition
StreamImproperAddressing     = p
"improper-addressing"
    streamErrorConditionToText StreamErrorCondition
StreamInternalServerError    = p
"internal-server-error"
    streamErrorConditionToText StreamErrorCondition
StreamInvalidFrom            = p
"invalid-from"
    streamErrorConditionToText StreamErrorCondition
StreamInvalidNamespace       = p
"invalid-namespace"
    streamErrorConditionToText StreamErrorCondition
StreamInvalidXml             = p
"invalid-xml"
    streamErrorConditionToText StreamErrorCondition
StreamNotAuthorized          = p
"not-authorized"
    streamErrorConditionToText StreamErrorCondition
StreamNotWellFormed          = p
"not-well-formed"
    streamErrorConditionToText StreamErrorCondition
StreamPolicyViolation        = p
"policy-violation"
    streamErrorConditionToText StreamErrorCondition
StreamRemoteConnectionFailed = p
"remote-connection-failed"
    streamErrorConditionToText StreamErrorCondition
StreamReset                  = p
"reset"
    streamErrorConditionToText StreamErrorCondition
StreamResourceConstraint     = p
"resource-constraint"
    streamErrorConditionToText StreamErrorCondition
StreamRestrictedXml          = p
"restricted-xml"
    streamErrorConditionToText StreamErrorCondition
StreamSeeOtherHost           = p
"see-other-host"
    streamErrorConditionToText StreamErrorCondition
StreamSystemShutdown         = p
"system-shutdown"
    streamErrorConditionToText StreamErrorCondition
StreamUndefinedCondition     = p
"undefined-condition"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedEncoding    = p
"unsupported-encoding"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedFeature     = p
"unsupported-feature"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedStanzaType  = p
"unsupported-stanza-type"
    streamErrorConditionToText StreamErrorCondition
StreamUnsupportedVersion     = p
"unsupported-version"
    streamErrorConditionFromText :: a -> StreamErrorCondition
streamErrorConditionFromText a
"bad-format" = StreamErrorCondition
StreamBadFormat
    streamErrorConditionFromText a
"bad-namespace-prefix" = StreamErrorCondition
StreamBadNamespacePrefix
    streamErrorConditionFromText a
"conflict" = StreamErrorCondition
StreamConflict
    streamErrorConditionFromText a
"connection-timeout" = StreamErrorCondition
StreamConnectionTimeout
    streamErrorConditionFromText a
"host-gone" = StreamErrorCondition
StreamHostGone
    streamErrorConditionFromText a
"host-unknown" = StreamErrorCondition
StreamHostUnknown
    streamErrorConditionFromText a
"improper-addressing" = StreamErrorCondition
StreamImproperAddressing
    streamErrorConditionFromText a
"internal-server-error" = StreamErrorCondition
StreamInternalServerError
    streamErrorConditionFromText a
"invalid-from" = StreamErrorCondition
StreamInvalidFrom
    streamErrorConditionFromText a
"invalid-namespace" = StreamErrorCondition
StreamInvalidNamespace
    streamErrorConditionFromText a
"invalid-xml" = StreamErrorCondition
StreamInvalidXml
    streamErrorConditionFromText a
"not-authorized" = StreamErrorCondition
StreamNotAuthorized
    streamErrorConditionFromText a
"not-well-formed" = StreamErrorCondition
StreamNotWellFormed
    streamErrorConditionFromText a
"policy-violation" = StreamErrorCondition
StreamPolicyViolation
    streamErrorConditionFromText a
"remote-connection-failed" = StreamErrorCondition
StreamRemoteConnectionFailed
    streamErrorConditionFromText a
"reset" = StreamErrorCondition
StreamReset
    streamErrorConditionFromText a
"resource-constraint" = StreamErrorCondition
StreamResourceConstraint
    streamErrorConditionFromText a
"restricted-xml" = StreamErrorCondition
StreamRestrictedXml
    streamErrorConditionFromText a
"see-other-host" = StreamErrorCondition
StreamSeeOtherHost
    streamErrorConditionFromText a
"system-shutdown" = StreamErrorCondition
StreamSystemShutdown
    streamErrorConditionFromText a
"undefined-condition" = StreamErrorCondition
StreamUndefinedCondition
    streamErrorConditionFromText a
"unsupported-encoding" = StreamErrorCondition
StreamUnsupportedEncoding
    streamErrorConditionFromText a
"unsupported-feature" = StreamErrorCondition
StreamUnsupportedFeature
    streamErrorConditionFromText a
"unsupported-stanza-type" = StreamErrorCondition
StreamUnsupportedStanzaType
    streamErrorConditionFromText a
"unsupported-version" = StreamErrorCondition
StreamUnsupportedVersion
    streamErrorConditionFromText a
_ = StreamErrorCondition
StreamUndefinedCondition -- §4.9.2