From 9c52669ffde25a15066df74666fd2d8eb0bf0438 Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 13 Jul 2013 18:38:08 -0400 Subject: refactored, more layering --- Presence/XMLToByteStrings.hs | 16 ++- Presence/XMPP.hs | 12 +- Presence/XMPPTypes.hs | 5 +- modules.svg | 311 ++++++++++++++++++++++--------------------- 4 files changed, 175 insertions(+), 169 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 @@ {-# LANGUAGE CPP #-} -module XMLToByteStrings (xmlToByteStrings) where +module XMLToByteStrings + ( xmlToByteStrings + , prettyPrint ) where import Control.Monad.IO.Class import Control.Monad.Trans.Class @@ -8,13 +10,15 @@ import Control.Monad.Fix import Control.Monad (when) import Data.Conduit import qualified Data.Conduit.List as CL +import qualified Data.Conduit.Binary as CB import Data.XML.Types as XML (Event) -import qualified Data.ByteString as S (ByteString) +import qualified Data.ByteString as S (ByteString,append) +import qualified Data.ByteString.Char8 as S (putStrLn) #ifdef RENDERFLUSH import Data.Conduit.Blaze (builderToByteStringFlush) -import Text.XML.Stream.Render (def,renderBuilderFlush) +import Text.XML.Stream.Render (def,renderBuilderFlush,renderBytes,rsPretty) #else -import Text.XML.Stream.Render (def,renderBytes) +import Text.XML.Stream.Render (def,renderBytes,rsPretty) #endif fixMaybeT f = (>> return ()) . runMaybeT . fix $ f @@ -62,3 +66,7 @@ renderChunks = fixMaybeT $ \loop -> do loop #endif + +prettyPrint prefix xs = + liftIO $ do + 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 @@ {-# LANGUAGE ViewPatterns #-} module XMPP ( module XMPPTypes - , module SocketLike , listenForXmppClients , listenForRemotePeers , newServerConnections @@ -15,7 +14,6 @@ module XMPP import ServerC import XMPPTypes -import SocketLike import ByteStringOperators import ControlMaybe import XMLToByteStrings @@ -42,10 +40,7 @@ import System.IO ) 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 (putStrLn,append) import qualified Data.ByteString.Lazy.Char8 as L ( putStrLn , fromChunks @@ -62,8 +57,7 @@ import System.IO.Error (isDoesNotExistError) import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe -import Text.XML.Stream.Parse (parseBytes,content) -import Text.XML.Stream.Render +import Text.XML.Stream.Parse (def,parseBytes,content) import Data.XML.Types as XML import qualified Data.Text as S (takeWhile) import Data.Text.Encoding as S (decodeUtf8,encodeUtf8) @@ -458,10 +452,6 @@ fromClient session cmdChan = doNestingXML $ do withXML $ \xml -> do log $ "end-of-document: " <++> bshow xml -prettyPrint prefix xs = - liftIO $ do - CL.sourceList xs $= renderBytes (def { rsPretty=True }) =$= CB.lines $$ CL.mapM_ (S.putStrLn . (prefix `S.append`)) - rosterPush to contact attrs = do 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 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -module XMPPTypes where +module XMPPTypes + ( module XMPPTypes + , module SocketLike + ) where import Network.Socket ( Family(..) diff --git a/modules.svg b/modules.svg index 350ab062..c1f004fb 100644 --- a/modules.svg +++ b/modules.svg @@ -4,259 +4,264 @@ - - + + G - + cluster_0 - -Data + +Data cluster_1 - -Holumbus + +Holumbus cluster_2 - -Data + +Data cluster_3 - -Text + +Text cluster_4 - -XML + +XML cluster_5 - -Stream + +Stream u6 - -FGConsole + +FGConsole monitortty - -monitortty.c + +monitortty.c u6->monitortty - - + + - -u15 - -LocalPeerCred + +u16 + +LocalPeerCred -u9 - -SocketLike +u9 + +SocketLike - -u15->u9 - - + +u16->u9 + + -u3 - -ControlMaybe +u3 + +ControlMaybe - -u15->u3 - - + +u16->u3 + + - -u14 - -NestingXML + +u15 + +NestingXML + + +u12 + +XMLToByteStrings + + +u13 + +Render + + +u12->u13 + + -u11 - -GetHostByAddr +u11 + +GetHostByAddr -u10 - -XMPPTypes +u10 + +XMPPTypes -u10->u11 - - +u10->u11 + + -u10->u9 - - +u10->u9 + + -u2 - -ByteStringOperators +u2 + +ByteStringOperators -u10->u2 - - +u10->u2 + + -u8 - -ServerC +u8 + +ServerC -u8->u9 - - +u8->u9 + + -u8->u2 - - +u8->u2 + + -u7 - -XMPP +u7 + +XMPP - -u7->u14 - - + +u7->u15 + + - -u7->u10 - - + +u7->u12 + + - -u7->u9 - - + +u7->u10 + + u7->u8 - - + + u7->u3 - - + + u7->u2 - - - - -u12 - -Render - - -u7->u12 - - + + -u4 - -UTmp +u4 + +UTmp -u5 - -BitSyntax +u5 + +BitSyntax u4->u5 - - + + -u1 - -ConfigFiles +u1 + +ConfigFiles u1->u3 - - + + u1->u2 - - + + -u0 - -Main +u0 + +Main u0->u6 - - + + - -u0->u15 - - + +u0->u16 + + u0->u7 - - + + u0->u4 - - + + u0->u3 - - + + u0->u2 - - + + u0->u1 - - + + - -u16 - -MultiMap - - -u0->u16 - - + +u17 + +MultiMap - -u13 - -Token + +u0->u17 + + - -u12->u13 - - + +u14 + +Token + + +u13->u14 + + -- cgit v1.2.3