diff options
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/XMLToByteStrings.hs | 16 | ||||
-rw-r--r-- | Presence/XMPP.hs | 12 | ||||
-rw-r--r-- | Presence/XMPPTypes.hs | 5 |
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 #-} |
2 | module XMLToByteStrings (xmlToByteStrings) where | 2 | module XMLToByteStrings |
3 | ( xmlToByteStrings | ||
4 | , prettyPrint ) where | ||
3 | 5 | ||
4 | import Control.Monad.IO.Class | 6 | import Control.Monad.IO.Class |
5 | import Control.Monad.Trans.Class | 7 | import Control.Monad.Trans.Class |
@@ -8,13 +10,15 @@ import Control.Monad.Fix | |||
8 | import Control.Monad (when) | 10 | import Control.Monad (when) |
9 | import Data.Conduit | 11 | import Data.Conduit |
10 | import qualified Data.Conduit.List as CL | 12 | import qualified Data.Conduit.List as CL |
13 | import qualified Data.Conduit.Binary as CB | ||
11 | import Data.XML.Types as XML (Event) | 14 | import Data.XML.Types as XML (Event) |
12 | import qualified Data.ByteString as S (ByteString) | 15 | import qualified Data.ByteString as S (ByteString,append) |
16 | import qualified Data.ByteString.Char8 as S (putStrLn) | ||
13 | #ifdef RENDERFLUSH | 17 | #ifdef RENDERFLUSH |
14 | import Data.Conduit.Blaze (builderToByteStringFlush) | 18 | import Data.Conduit.Blaze (builderToByteStringFlush) |
15 | import Text.XML.Stream.Render (def,renderBuilderFlush) | 19 | import Text.XML.Stream.Render (def,renderBuilderFlush,renderBytes,rsPretty) |
16 | #else | 20 | #else |
17 | import Text.XML.Stream.Render (def,renderBytes) | 21 | import Text.XML.Stream.Render (def,renderBytes,rsPretty) |
18 | #endif | 22 | #endif |
19 | 23 | ||
20 | fixMaybeT f = (>> return ()) . runMaybeT . fix $ f | 24 | fixMaybeT f = (>> return ()) . runMaybeT . fix $ f |
@@ -62,3 +66,7 @@ renderChunks = fixMaybeT $ \loop -> do | |||
62 | loop | 66 | loop |
63 | #endif | 67 | #endif |
64 | 68 | ||
69 | |||
70 | prettyPrint 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 #-} |
4 | module XMPP | 4 | module 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 | ||
16 | import ServerC | 15 | import ServerC |
17 | import XMPPTypes | 16 | import XMPPTypes |
18 | import SocketLike | ||
19 | import ByteStringOperators | 17 | import ByteStringOperators |
20 | import ControlMaybe | 18 | import ControlMaybe |
21 | import XMLToByteStrings | 19 | import XMLToByteStrings |
@@ -42,10 +40,7 @@ import System.IO | |||
42 | ) | 40 | ) |
43 | import Control.Concurrent.STM | 41 | import Control.Concurrent.STM |
44 | import Data.Conduit | 42 | import Data.Conduit |
45 | import qualified Data.Conduit.List as CL | ||
46 | import qualified Data.Conduit.Binary as CB | ||
47 | import Data.ByteString (ByteString) | 43 | import Data.ByteString (ByteString) |
48 | import qualified Data.ByteString.Char8 as S (putStrLn,append) | ||
49 | import qualified Data.ByteString.Lazy.Char8 as L | 44 | import qualified Data.ByteString.Lazy.Char8 as L |
50 | ( putStrLn | 45 | ( putStrLn |
51 | , fromChunks | 46 | , fromChunks |
@@ -62,8 +57,7 @@ import System.IO.Error (isDoesNotExistError) | |||
62 | import Control.Monad.IO.Class | 57 | import Control.Monad.IO.Class |
63 | import Control.Monad.Trans.Class | 58 | import Control.Monad.Trans.Class |
64 | import Control.Monad.Trans.Maybe | 59 | import Control.Monad.Trans.Maybe |
65 | import Text.XML.Stream.Parse (parseBytes,content) | 60 | import Text.XML.Stream.Parse (def,parseBytes,content) |
66 | import Text.XML.Stream.Render | ||
67 | import Data.XML.Types as XML | 61 | import Data.XML.Types as XML |
68 | import qualified Data.Text as S (takeWhile) | 62 | import qualified Data.Text as S (takeWhile) |
69 | import Data.Text.Encoding as S (decodeUtf8,encodeUtf8) | 63 | import 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 | ||
461 | prettyPrint 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 | ||
466 | rosterPush to contact attrs = do | 456 | rosterPush 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 #-} |
3 | module XMPPTypes where | 3 | module XMPPTypes |
4 | ( module XMPPTypes | ||
5 | , module SocketLike | ||
6 | ) where | ||
4 | 7 | ||
5 | import Network.Socket | 8 | import Network.Socket |
6 | ( Family(..) | 9 | ( Family(..) |