~singpolyma/cheogram

ref: 3bd9c3870d41e3af2f469f2a3904025aef29a767 cheogram/StanzaRec.hs -rw-r--r-- 1.3 KiB
3bd9c387 — Stephen Paul Weber -O2 takes too much RAM for CI 1 year, 28 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