From 6f2ad62dc05913f559b5e2f92e79fdaa73e4db0e Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 29 Jun 2013 20:44:43 -0400 Subject: more info on unhandled stanza --- Presence/XMPP.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs index 5435c913..36d9bf74 100644 --- a/Presence/XMPP.hs +++ b/Presence/XMPP.hs @@ -21,8 +21,9 @@ import Network.BSD (PortNumber) import Control.Concurrent.STM import Data.Conduit import qualified Data.Conduit.List as CL +import qualified Data.Conduit.Binary as CB import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as S (pack,putStr,putStrLn) +import qualified Data.ByteString.Char8 as S (pack,putStr,putStrLn,append) import qualified Data.ByteString.Lazy.Char8 as L ( putStrLn , fromChunks @@ -352,7 +353,9 @@ fromClient session cmdChan = doNestingXML $ do whenJust nextElement $ \stanza -> do stanza_lvl <- nesting - let unhandledStanza = liftIO $ putStrLn ("ignoring stanza: "++show stanza) + let unhandledStanza = do + mb <- lift . runMaybeT $ gatherElement stanza Seq.empty + withJust mb $ \xs -> prettyPrint "C: " (toList xs) case () of _ | stanza `isIQOf` iqTypeSet -> handleIQSet session cmdChan stanza _ | otherwise -> unhandledStanza @@ -366,8 +369,7 @@ fromClient session cmdChan = doNestingXML $ do prettyPrint prefix xs = liftIO $ do - S.putStrLn prefix - CL.sourceList xs $= renderBytes (def { rsPretty=True }) $$ CL.mapM_ S.putStr + CL.sourceList xs $= renderBytes (def { rsPretty=True }) =$= CB.lines $$ CL.mapM_ (S.putStrLn . (prefix `S.append`)) toClient :: MonadIO m => TChan Presence -> TChan Commands -> Source m [XML.Event] toClient pchan cmdChan = fix $ \loop -> do @@ -376,7 +378,7 @@ toClient pchan cmdChan = fix $ \loop -> do (fmap Right $ readTChan cmdChan) case event of Right QuitThread -> return () - Right (Send xs) -> yield xs >> prettyPrint "client-out: " xs >> loop + Right (Send xs) -> yield xs >> prettyPrint ">C: " xs >> loop Left presence -> do xs <- liftIO $ xmlifyPresenceForClient presence yield xs -- cgit v1.2.3