From ac3702dd365691cc9abf37248633f00f1e06cb12 Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 19 Feb 2014 16:35:24 -0500 Subject: more type signatures --- Presence/EventUtil.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'Presence/EventUtil.hs') diff --git a/Presence/EventUtil.hs b/Presence/EventUtil.hs index 02a37472..908e09e0 100644 --- a/Presence/EventUtil.hs +++ b/Presence/EventUtil.hs @@ -4,49 +4,62 @@ 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 _ = [] @@ -59,8 +72,12 @@ iqTypeError = "error" -} +tagName :: Event -> Name tagName (EventBeginElement n _) = n tagName _ = "" +closerFor :: Event -> Event closerFor (EventBeginElement n _) = EventEndElement n closerFor _ = error "closerFor: unsupported event" + + -- cgit v1.2.3