diff options
-rw-r--r-- | Presence/XMPP.hs | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs index 7e513212..d0333f4a 100644 --- a/Presence/XMPP.hs +++ b/Presence/XMPP.hs | |||
@@ -74,15 +74,28 @@ xmlifyPresenceForClient (Presence jid stat) = do | |||
74 | shw Offline = "away" -- Is this right? | 74 | shw Offline = "away" -- Is this right? |
75 | 75 | ||
76 | 76 | ||
77 | -- type Consumer i m r = forall o. ConduitM i o m r | ||
78 | mawait :: Monad m => MaybeT (ConduitM i o m) i | ||
79 | mawait = MaybeT await | ||
80 | |||
81 | elementAttrs expected (EventBeginElement name attrs) | ||
82 | | nameLocalName name==expected | ||
83 | = return attrs | ||
84 | elementAttrs _ _ = mzero | ||
85 | |||
77 | 86 | ||
78 | fromClient :: MonadIO m => TChan Commands -> Sink XML.Event m () | 87 | fromClient :: MonadIO m => TChan Commands -> Sink XML.Event m () |
79 | fromClient cmdChan = fix $ \loop -> do | 88 | fromClient cmdChan = (>>return ()) . runMaybeT $ do |
80 | mb <- await | 89 | mawait >>= guard . (==EventBeginDocument) |
81 | maybe (return ()) | 90 | liftIO . L.putStrLn $ "client-in: begin-doc " |
82 | (\packet -> do | 91 | xml <- mawait |
83 | liftIO (L.putStrLn $ "client-in: " <++> bshow packet) | 92 | stream_attrs <- elementAttrs "stream" xml |
84 | loop) | 93 | liftIO . L.putStrLn $ "client-in: stream " <++> bshow stream_attrs |
85 | mb | 94 | fix $ \loop -> do |
95 | xml <- mawait | ||
96 | liftIO (L.putStrLn $ "client-in: " <++> bshow xml) | ||
97 | loop | ||
98 | |||
86 | 99 | ||
87 | toClient :: MonadIO m => TChan Presence -> TChan Commands -> Source m XML.Event | 100 | toClient :: MonadIO m => TChan Presence -> TChan Commands -> Source m XML.Event |
88 | toClient pchan cmdChan = fix $ \loop -> do | 101 | toClient pchan cmdChan = fix $ \loop -> do |