~singpolyma/cheogram

cheogram/StanzaRec.hs -rw-r--r-- 1.3 KiB
7b3f9c67Stephen Paul Weber Include the command payload item along with the bot prompt 18 days ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
module StanzaRec (StanzaRec(..), mkStanzaRec, ensureId) where

import Prelude ()
import BasicPrelude
import qualified Data.UUID as UUID (toText)
import qualified Data.UUID.V1 as UUID (nextUUID)
import qualified Data.XML.Types as XML
import qualified Network.Protocol.XMPP as XMPP
import Network.Protocol.XMPP.Internal (Stanza(..))

import Util

data StanzaRec = StanzaRec (Maybe XMPP.JID) (Maybe XMPP.JID) (Maybe Text) (Maybe Text) [XML.Element] XML.Element deriving (Show)

instance Stanza StanzaRec where
	stanzaTo (StanzaRec to _ _ _ _ _) = to
	stanzaFrom (StanzaRec _ from _ _ _ _) = from
	stanzaID (StanzaRec _ _ sid _ _ _) = sid
	stanzaLang (StanzaRec _ _ _ lang _ _) = lang
	stanzaPayloads (StanzaRec _ _ _ _ payloads _) = payloads
	stanzaToElement (StanzaRec _ _ _ _ _ element) = element

mkStanzaRec :: (Stanza s) => s -> StanzaRec
mkStanzaRec x = StanzaRec (stanzaTo x) (stanzaFrom x) (stanzaID x) (stanzaLang x) (stanzaPayloads x) (stanzaToElement x)

ensureId :: StanzaRec -> IO StanzaRec
ensureId (StanzaRec to from Nothing lang payloads element) = do
	uuid <- (fmap.fmap) UUID.toText UUID.nextUUID
	return $ StanzaRec to from uuid lang payloads $ element {
			XML.elementAttributes =
				(s"id", [XML.ContentText $ fromMaybe mempty uuid]) :
				XML.elementAttributes element
		}
ensureId s = return s