summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/XMLToByteStrings.hs16
-rw-r--r--Presence/XMPP.hs12
-rw-r--r--Presence/XMPPTypes.hs5
3 files changed, 17 insertions, 16 deletions
diff --git a/Presence/XMLToByteStrings.hs b/Presence/XMLToByteStrings.hs
index d8d2e965..92ac05cd 100644
--- a/Presence/XMLToByteStrings.hs
+++ b/Presence/XMLToByteStrings.hs
@@ -1,5 +1,7 @@
1{-# LANGUAGE CPP #-} 1{-# LANGUAGE CPP #-}
2module XMLToByteStrings (xmlToByteStrings) where 2module XMLToByteStrings
3 ( xmlToByteStrings
4 , prettyPrint ) where
3 5
4import Control.Monad.IO.Class 6import Control.Monad.IO.Class
5import Control.Monad.Trans.Class 7import Control.Monad.Trans.Class
@@ -8,13 +10,15 @@ import Control.Monad.Fix
8import Control.Monad (when) 10import Control.Monad (when)
9import Data.Conduit 11import Data.Conduit
10import qualified Data.Conduit.List as CL 12import qualified Data.Conduit.List as CL
13import qualified Data.Conduit.Binary as CB
11import Data.XML.Types as XML (Event) 14import Data.XML.Types as XML (Event)
12import qualified Data.ByteString as S (ByteString) 15import qualified Data.ByteString as S (ByteString,append)
16import qualified Data.ByteString.Char8 as S (putStrLn)
13#ifdef RENDERFLUSH 17#ifdef RENDERFLUSH
14import Data.Conduit.Blaze (builderToByteStringFlush) 18import Data.Conduit.Blaze (builderToByteStringFlush)
15import Text.XML.Stream.Render (def,renderBuilderFlush) 19import Text.XML.Stream.Render (def,renderBuilderFlush,renderBytes,rsPretty)
16#else 20#else
17import Text.XML.Stream.Render (def,renderBytes) 21import Text.XML.Stream.Render (def,renderBytes,rsPretty)
18#endif 22#endif
19 23
20fixMaybeT f = (>> return ()) . runMaybeT . fix $ f 24fixMaybeT f = (>> return ()) . runMaybeT . fix $ f
@@ -62,3 +66,7 @@ renderChunks = fixMaybeT $ \loop -> do
62 loop 66 loop
63#endif 67#endif
64 68
69
70prettyPrint prefix xs =
71 liftIO $ do
72 CL.sourceList xs $= renderBytes (def { rsPretty=True }) =$= CB.lines $$ CL.mapM_ (S.putStrLn . (prefix `S.append`))
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index ec2feb3a..a469c08e 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -3,7 +3,6 @@
3{-# LANGUAGE ViewPatterns #-} 3{-# LANGUAGE ViewPatterns #-}
4module XMPP 4module XMPP
5 ( module XMPPTypes 5 ( module XMPPTypes
6 , module SocketLike
7 , listenForXmppClients 6 , listenForXmppClients
8 , listenForRemotePeers 7 , listenForRemotePeers
9 , newServerConnections 8 , newServerConnections
@@ -15,7 +14,6 @@ module XMPP
15 14
16import ServerC 15import ServerC
17import XMPPTypes 16import XMPPTypes
18import SocketLike
19import ByteStringOperators 17import ByteStringOperators
20import ControlMaybe 18import ControlMaybe
21import XMLToByteStrings 19import XMLToByteStrings
@@ -42,10 +40,7 @@ import System.IO
42 ) 40 )
43import Control.Concurrent.STM 41import Control.Concurrent.STM
44import Data.Conduit 42import Data.Conduit
45import qualified Data.Conduit.List as CL
46import qualified Data.Conduit.Binary as CB
47import Data.ByteString (ByteString) 43import Data.ByteString (ByteString)
48import qualified Data.ByteString.Char8 as S (putStrLn,append)
49import qualified Data.ByteString.Lazy.Char8 as L 44import qualified Data.ByteString.Lazy.Char8 as L
50 ( putStrLn 45 ( putStrLn
51 , fromChunks 46 , fromChunks
@@ -62,8 +57,7 @@ import System.IO.Error (isDoesNotExistError)
62import Control.Monad.IO.Class 57import Control.Monad.IO.Class
63import Control.Monad.Trans.Class 58import Control.Monad.Trans.Class
64import Control.Monad.Trans.Maybe 59import Control.Monad.Trans.Maybe
65import Text.XML.Stream.Parse (parseBytes,content) 60import Text.XML.Stream.Parse (def,parseBytes,content)
66import Text.XML.Stream.Render
67import Data.XML.Types as XML 61import Data.XML.Types as XML
68import qualified Data.Text as S (takeWhile) 62import qualified Data.Text as S (takeWhile)
69import Data.Text.Encoding as S (decodeUtf8,encodeUtf8) 63import Data.Text.Encoding as S (decodeUtf8,encodeUtf8)
@@ -458,10 +452,6 @@ fromClient session cmdChan = doNestingXML $ do
458 withXML $ \xml -> do 452 withXML $ \xml -> do
459 log $ "end-of-document: " <++> bshow xml 453 log $ "end-of-document: " <++> bshow xml
460 454
461prettyPrint prefix xs =
462 liftIO $ do
463 CL.sourceList xs $= renderBytes (def { rsPretty=True }) =$= CB.lines $$ CL.mapM_ (S.putStrLn . (prefix `S.append`))
464
465 455
466rosterPush to contact attrs = do 456rosterPush to contact attrs = do
467 let n = name to 457 let n = name to
diff --git a/Presence/XMPPTypes.hs b/Presence/XMPPTypes.hs
index 4802002c..a44f7fb1 100644
--- a/Presence/XMPPTypes.hs
+++ b/Presence/XMPPTypes.hs
@@ -1,6 +1,9 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE TypeFamilies #-} 2{-# LANGUAGE TypeFamilies #-}
3module XMPPTypes where 3module XMPPTypes
4 ( module XMPPTypes
5 , module SocketLike
6 ) where
4 7
5import Network.Socket 8import Network.Socket
6 ( Family(..) 9 ( Family(..)