blob: 908e09e012c0875e9180f86c004c0842bb5d1be0 (
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
{-# LANGUAGE OverloadedStrings #-}
module EventUtil where
import Control.Monad
import Data.XML.Types as XML
import qualified Data.List as List
import Data.Text (Text)
-- getStreamName (EventBeginElement name _) = name
isEventBeginElement :: Event -> Bool
isEventBeginElement (EventBeginElement {}) = True
isEventBeginElement _ = False
isEventEndElement :: Event -> Bool
isEventEndElement (EventEndElement {}) = True
isEventEndElement _ = False
-- Note: This function ignores name space qualification
elementAttrs ::
MonadPlus m =>
Text -> Event -> m [(Name, [Content])]
elementAttrs expected (EventBeginElement name attrs)
| nameLocalName name==expected
= return attrs
elementAttrs _ _ = mzero
streamP :: Text -> Name
streamP name = Name name (Just "http://etherx.jabber.org/streams") (Just "stream")
attr :: Name -> Text -> (Name,[Content])
attr name value = (name,[ContentText value])
isServerIQOf :: Event -> Text -> Bool
isServerIQOf (EventBeginElement name attrs) testType
| name=="{jabber:server}iq"
&& matchAttrib "type" testType attrs
= True
isServerIQOf _ _ = False
isClientIQOf :: Event -> Text -> Bool
isClientIQOf (EventBeginElement name attrs) testType
| name=="{jabber:client}iq"
&& matchAttrib "type" testType attrs
= True
isClientIQOf _ _ = False
matchAttrib :: Name -> Text -> [(Name, [Content])] -> Bool
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 -> [(Name, [Content])] -> Maybe Text
lookupAttrib name attrs =
case List.find ( (==name) . fst) attrs of
Just (_,[ContentText x]) -> Just x
Just (_,[ContentEntity x]) -> Just x
_ -> Nothing
tagAttrs :: Event -> [(Name, [Content])]
tagAttrs (EventBeginElement _ xs) = xs
tagAttrs _ = []
{-
iqTypeSet = "set"
iqTypeGet = "get"
iqTypeResult = "result"
iqTypeError = "error"
-}
tagName :: Event -> Name
tagName (EventBeginElement n _) = n
tagName _ = ""
closerFor :: Event -> Event
closerFor (EventBeginElement n _) = EventEndElement n
closerFor _ = error "closerFor: unsupported event"
|
