M Network/Protocol/XMPP/Component.hs => Network/Protocol/XMPP/Component.hs +2 -2
@@ 61,8 61,8 @@ beginStream jid = do
Nothing -> throwError M.NoComponentStreamID
Just x -> return x
-parseStreamID :: X.SaxEvent -> Maybe Text
-parseStreamID (X.BeginElement name attrs) = X.attributeText
+parseStreamID :: X.Event -> Maybe Text
+parseStreamID (X.EventBeginElement name attrs) = X.attributeText
"{jabber:component:accept}jid"
(X.Element name attrs [])
parseStreamID _ = Nothing
M Network/Protocol/XMPP/Connections.hs => Network/Protocol/XMPP/Connections.hs +2 -2
@@ 51,9 51,9 @@ xmlHeader ns jid = encodeUtf8 header where
, " xmlns:stream=\"http://etherx.jabber.org/streams\">"
]
-startOfStream :: Integer -> X.SaxEvent -> Bool
+startOfStream :: Integer -> X.Event -> Bool
startOfStream depth event = case (depth, event) of
- (1, (X.BeginElement elemName _)) -> qnameStream == elemName
+ (1, (X.EventBeginElement elemName _)) -> qnameStream == elemName
_ -> False
qnameStream :: X.Name
M Network/Protocol/XMPP/Monad.hs => Network/Protocol/XMPP/Monad.hs +2 -2
@@ 157,7 157,7 @@ putElement = putBytes . encodeUtf8 . X.serialiseElement
putStanza :: S.Stanza a => a -> XMPP ()
putStanza = withLock sessionWriteLock . putElement . S.stanzaToElement
-readEvents :: (Integer -> X.SaxEvent -> Bool) -> XMPP [X.SaxEvent]
+readEvents :: (Integer -> X.Event -> Bool) -> XMPP [X.Event]
readEvents done = xmpp where
xmpp = do
Session h _ p _ _ <- getSession
@@ 179,7 179,7 @@ getElement = xmpp where
Just x -> return x
Nothing -> E.throwError $ TransportError "getElement: invalid event list"
- endOfTree 0 (X.EndElement _) = True
+ endOfTree 0 (X.EventEndElement _) = True
endOfTree _ _ = False
getStanza :: XMPP S.ReceivedStanza
M Network/Protocol/XMPP/XML.hs => Network/Protocol/XMPP/XML.hs +20 -28
@@ 29,7 29,6 @@ module Network.Protocol.XMPP.XML
-- * libxml-sax-0.4 API imitation
, Parser
- , SaxEvent (..)
, newParser
, parse
, eventsToElement
@@ 91,7 90,7 @@ serialiseElement e = text where
-- quick-and-dirty imitation of libxml-sax-0.4 API; later, this should
-- probably be rewritten to use ST and discard the list parsing
-data Parser = Parser (SAX.Parser IO) (IORef (Either Text [SaxEvent]))
+data Parser = Parser (SAX.Parser IO) (IORef (Either Text [Event]))
newParser :: IO Parser
newParser = do
@@ 105,16 104,16 @@ newParser = do
Right es -> writeIORef ref (Right (e:es))
return True
- SAX.setCallback p SAX.parsedBeginElement (\name' attrs -> addEvent $ BeginElement name' attrs)
- SAX.setCallback p SAX.parsedEndElement (\name' -> addEvent $ EndElement name')
- SAX.setCallback p SAX.parsedCharacters (\txt -> addEvent $ Characters txt)
- SAX.setCallback p SAX.parsedComment (\txt -> addEvent $ Comment txt)
- SAX.setCallback p SAX.parsedInstruction (\i -> addEvent $ ProcessingInstruction i)
+ SAX.setCallback p SAX.parsedBeginElement (\name attrs -> addEvent (EventBeginElement name attrs))
+ SAX.setCallback p SAX.parsedEndElement (\name -> addEvent (EventEndElement name))
+ SAX.setCallback p SAX.parsedCharacters (\txt -> addEvent (EventContent (ContentText txt)))
+ SAX.setCallback p SAX.parsedComment (\txt -> addEvent (EventComment txt))
+ SAX.setCallback p SAX.parsedInstruction (\i -> addEvent (EventInstruction i))
SAX.setCallback p SAX.reportError (\err -> writeIORef ref (Left err) >> return False)
return $ Parser p ref
-parse :: Parser -> ByteString -> Bool -> IO (Either Text [SaxEvent])
+parse :: Parser -> ByteString -> Bool -> IO (Either Text [Event])
parse (Parser p ref) bytes finish = do
writeIORef ref (Right [])
SAX.parseBytes p bytes
@@ 124,17 123,10 @@ parse (Parser p ref) bytes finish = do
Left err -> Left err
Right events -> Right $ reverse events
-data SaxEvent
- = BeginElement Name [(Name, [Content])]
- | EndElement Name
- | Characters Text
- | Comment Text
- | ProcessingInstruction Instruction
-
readEvents :: Monad m
- => (Integer -> SaxEvent -> Bool)
- -> m [SaxEvent]
- -> m [SaxEvent]
+ => (Integer -> Event -> Bool)
+ -> m [Event]
+ -> m [Event]
readEvents done nextEvents = readEvents' 0 [] where
readEvents' depth acc = do
events <- nextEvents
@@ 146,8 138,8 @@ readEvents done nextEvents = readEvents' 0 [] where
step [] depth acc = (False, depth, acc)
step (e:es) depth acc = let
depth' = depth + case e of
- (BeginElement _ _) -> 1
- (EndElement _) -> (- 1)
+ (EventBeginElement _ _) -> 1
+ (EventEndElement _) -> (- 1)
_ -> 0
acc' = e : acc
in if done depth' e
@@ 156,18 148,18 @@ readEvents done nextEvents = readEvents' 0 [] where
-- | Convert a list of events to a single 'Element'. If the events do not
-- contain at least one valid element, 'Nothing' will be returned instead.
-eventsToElement :: [SaxEvent] -> Maybe Element
+eventsToElement :: [Event] -> Maybe Element
eventsToElement es = case eventsToNodes es >>= isElement of
(e:_) -> Just e
_ -> Nothing
-eventsToNodes :: [SaxEvent] -> [Node]
+eventsToNodes :: [Event] -> [Node]
eventsToNodes = concatMap blockToNodes . splitBlocks
-- Split event list into a sequence of "blocks", which are the events including
-- and between a pair of tags. <start><start2/></start> and <start/> are both
-- single blocks.
-splitBlocks :: [SaxEvent] -> [[SaxEvent]]
+splitBlocks :: [Event] -> [[Event]]
splitBlocks es = ret where
(_, _, ret) = foldl splitBlocks' (0, [], []) es
@@ 178,17 170,17 @@ splitBlocks es = ret where
accum' = accum ++ [e]
depth' :: Integer
depth' = depth + case e of
- (BeginElement _ _) -> 1
- (EndElement _) -> (- 1)
+ (EventBeginElement _ _) -> 1
+ (EventEndElement _) -> (- 1)
_ -> 0
-blockToNodes :: [SaxEvent] -> [Node]
+blockToNodes :: [Event] -> [Node]
blockToNodes [] = []
blockToNodes (begin:rest) = nodes where
end = last rest
nodes = case (begin, end) of
- (BeginElement name' attrs, EndElement _) -> [node name' attrs]
- (Characters t, _) -> [NodeContent (ContentText t)]
+ (EventBeginElement name attrs, EventEndElement _) -> [node name attrs]
+ (EventContent c, _) -> [NodeContent c]
_ -> []
node n as = NodeElement $ Element n as $ eventsToNodes $ init rest