summaryrefslogtreecommitdiff
path: root/Presence/EventUtil.hs
blob: a1c48e331d23289353962a9e25551cb4b206fcb5 (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
{-# 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

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"