From 36637654a5d18125370ba1323e9e96a6bc01441f Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Mon, 29 Jul 2013 23:50:14 -0400
Subject: Progress toward support for messaging.

---
 Presence/SendMessage.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

(limited to 'Presence/SendMessage.hs')

diff --git a/Presence/SendMessage.hs b/Presence/SendMessage.hs
index d1db7a4f..8b4d00f7 100644
--- a/Presence/SendMessage.hs
+++ b/Presence/SendMessage.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 module SendMessage
     ( sendMessage
     , CommandCache(..)
@@ -46,13 +47,15 @@ import Network.Socket
     , SocketType(..)
     )
 
-import XMPPTypes (Peer(..),discardPort,peerAddr,withPort,socketFamily)
+import XMPPTypes (Peer(..),discardPort,peerAddr,withPort,socketFamily,showPeer)
 import SocketLike
 import ServerC (packetSink)
 import ControlMaybe 
 import Data.Conduit (Sink,Source)
 import qualified Data.ByteString as S (ByteString)
 import XMLToByteStrings
+import Logging
+import ByteStringOperators
 
 type ByteStringSink = Sink S.ByteString IO ()
 
@@ -94,7 +97,7 @@ newOutgoingConnections interpretCommands = do
 
 
 sendMessage
-  :: (CommandCache a, ThreadChannelCommand (CacheableCommand a)) =>
+  :: (Show (CacheableCommand a), CommandCache a, ThreadChannelCommand (CacheableCommand a)) =>
      OutgoingConnections a -> CacheableCommand a -> Peer -> IO ()
 sendMessage (OutgoingConnections cons interpretCommands) msg peer0 = do
     let peer = discardPort peer0
@@ -192,7 +195,7 @@ type OutBoundXML sock cache msg =
          -> Source IO [XML.Event]
 
 handleOutgoingToPeer
-  :: SocketLike sock =>
+  :: (SocketLike sock, Show msg) =>
      OutBoundXML sock cache msg
      -> sock
      -> cache 
@@ -201,11 +204,11 @@ handleOutgoingToPeer
      -> IO (Maybe msg)
 handleOutgoingToPeer toPeer sock cache chan snk = do
     p <- getPeerName sock
-    -- L.putStrLn $ "(>P) connected " <++> showPeer (RemotePeer p)
+    debugL $ "(>P) connected " <++> showPeer (RemotePeer p)
     failed <- newIORef Nothing
     let failure cmd = do
             writeIORef failed cmd
-            -- putStrLn $ "Failed: " ++ show cmd
+            debugStr $ "Failed: " ++ show cmd
     finally (
         handleIO_ (return ()) $ toPeer sock cache chan failure `xmlToByteStrings` snk
         ) $ return () -- logging L.putStrLn $ "(>P) disconnected " <++> showPeer (RemotePeer p)
-- 
cgit v1.2.3