blob: 02a37472bb68d72c42a07d4222b3cf186beba4d5 (
plain)
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
{-# LANGUAGE OverloadedStrings #-}
module EventUtil where
import Control.Monad
import Data.XML.Types as XML
import qualified Data.List as List
-- getStreamName (EventBeginElement name _) = name
isEventBeginElement (EventBeginElement {}) = True
isEventBeginElement _ = False
isEventEndElement (EventEndElement {}) = True
isEventEndElement _ = False
-- Note: This function ignores name space qualification
elementAttrs expected (EventBeginElement name attrs)
| nameLocalName name==expected
= return attrs
elementAttrs _ _ = mzero
streamP name = Name name (Just "http://etherx.jabber.org/streams") (Just "stream")
attr name value = (name,[ContentText value])
isServerIQOf (EventBeginElement name attrs) testType
| name=="{jabber:server}iq"
&& matchAttrib "type" testType attrs
= True
isServerIQOf _ _ = False
isClientIQOf (EventBeginElement name attrs) testType
| name=="{jabber:client}iq"
&& matchAttrib "type" testType attrs
= True
isClientIQOf _ _ = False
matchAttrib name value attrs =
case List.find ( (==name) . fst) attrs of
Just (_,[ContentText x]) | x==value -> True
Just (_,[ContentEntity x]) | x==value -> True
_ -> False
lookupAttrib name attrs =
case List.find ( (==name) . fst) attrs of
Just (_,[ContentText x]) -> Just x
Just (_,[ContentEntity x]) -> Just x
_ -> Nothing
tagAttrs (EventBeginElement _ xs) = xs
tagAttrs _ = []
{-
iqTypeSet = "set"
iqTypeGet = "get"
iqTypeResult = "result"
iqTypeError = "error"
-}
tagName (EventBeginElement n _) = n
tagName _ = ""
closerFor (EventBeginElement n _) = EventEndElement n
closerFor _ = error "closerFor: unsupported event"
|
