Moved all output to module: Logging

1 files changed, 30 insertions, 29 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index 83f11df3..ef6a0e66 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -31,6 +31,7 @@ import Data.HList
 import Control.Exception hiding (catch)
 import LocalPeerCred
 import System.Posix.User
+import Logging
 import qualified Data.Set as Set
 import           Data.Set as Set (Set,(\\))
 import qualified Data.Map as Map
@@ -43,7 +44,7 @@ import Control.Monad.IO.Class
 
 import ByteStringOperators
 import qualified Data.ByteString.Lazy.Char8 as L
-import           Data.ByteString.Lazy.Char8 as L (ByteString,putStrLn)
+import           Data.ByteString.Lazy.Char8 as L (ByteString)
 import qualified Prelude
 import           Prelude hiding (putStrLn)
 import System.Environment
@@ -149,7 +150,7 @@ instance JabberClientSession ClientSession where
         -- muid <- getLocalPeerCred sock
         addr <- getPeerName sock
         muid <- getLocalPeerCred' addr
-        L.putStrLn $ "CLIENT SESSION: open " <++> bshow muid
+        debugL $ "CLIENT SESSION: open " <++> bshow muid
         uid_ref <- newIORef muid
         (mtty,pid) <- getTTYandPID muid
         res_ref <- newIORef mtty
@@ -171,7 +172,7 @@ instance JabberClientSession ClientSession where
         rsc <- readIORef (unix_resource s)
         let rsc' = maybe wanted_resource id rsc
         writeIORef (unix_resource s) (Just rsc')
-        L.putStrLn $ "CLIENT SESSION: resource " <++> rsc'
+        debugL $ "CLIENT SESSION: resource " <++> rsc'
 
     getJID       s             = do
         let host = localhost s
@@ -179,7 +180,7 @@ instance JabberClientSession ClientSession where
 
         rsc <- readIORef (unix_resource s)
         -- let jid = user <++> "@" <++> host <++?> "/" <++$> rsc
-        -- L.putStrLn $ "CLIENT SESSION: jid " <++> L.show (JID (Just user) host rsc)
+        -- debugL $ "CLIENT SESSION: jid " <++> L.show (JID (Just user) host rsc)
         return (JID (Just user) host rsc)
 
     closeSession session  = do
@@ -187,7 +188,7 @@ instance JabberClientSession ClientSession where
             cs <- readTVar (chans session)
             forM_ cs $ \(RefCountedChan c) -> do
                 unsubscribeToChan c
-        L.putStrLn "CLIENT SESSION: close"
+        debugL "CLIENT SESSION: close"
 
     subscribe session Nothing = do
         let tmvar = localSubscriber (presence_state session)
@@ -210,7 +211,7 @@ instance JabberClientSession ClientSession where
 
     forCachedPresence s action = do
         jid <- getJID s 
-        L.putStrLn $ "forCachedPresence "<++> bshow jid
+        debugL $ "forCachedPresence "<++> bshow jid
         withJust (name jid) $ \user -> do
         let parseHostNameJID' str = do
                 handle (\(SomeException _) -> return Nothing)
@@ -220,19 +221,19 @@ instance JabberClientSession ClientSession where
             fmap catMaybes (mapM parseHostNameJID' buddies)
         remotes <- readTVarIO . remoteUsers . presence_state $ s
         forM_ buddies $ \buddy -> do
-            L.putStrLn $ "forCachedPresence buddy = "<++> bshow buddy
+            debugL $ "forCachedPresence buddy = "<++> bshow buddy
             let mjids = fmap snd $ Map.lookup (peer buddy) remotes
             jids <- maybe (return MM.empty) readTVarIO mjids
-            L.putStrLn $ "forCachedPresence jids = "<++> bshow jids
+            debugL $ "forCachedPresence jids = "<++> bshow jids
             withJust (splitResource buddy) $ \(buddyU,_) -> do
             forM_ (Set.toList . MM.lookup buddyU $ jids) $ \(rsc,status) -> do
             let p = Presence buddy status
-            L.putStrLn $ "cached presence: " <++> bshow p
+            debugL $ "cached presence: " <++> bshow p
             action p
 
     sendPending s = do
         jid <- getJID s 
-        putStrLn $ "sendPending "<++> bshow jid
+        debugL $ "sendPending "<++> bshow jid
         flip (maybe (return ())) (name jid) $ \user -> do
         pending <- ConfigFiles.getPending user
         let getRChan = do
@@ -279,7 +280,7 @@ instance JabberClientSession ClientSession where
         handleIO (\e -> return False) $ do
         user <- readIORef (unix_uid s) >>= getJabberUserForId
         subs <- ConfigFiles.getSubscribers user
-        putStrLn $ "isSubscribed parsing: "<++>contact
+        debugL $ "isSubscribed parsing: "<++>contact
         cjid <- parseHostNameJID contact
         msubs <- mapM (cmpJID cjid) subs
         return (Nothing `elem` msubs)
@@ -288,7 +289,7 @@ instance JabberClientSession ClientSession where
         handleIO (\e -> return False) $ do
         user <- readIORef (unix_uid s) >>= getJabberUserForId
         subs <- ConfigFiles.getBuddies user
-        putStrLn $ "isBuddy parsing: "<++>contact
+        debugL $ "isBuddy parsing: "<++>contact
         cjid <- parseHostNameJID contact
         msubs <- mapM (cmpJID cjid) subs
         return (Nothing `elem` msubs)
@@ -369,13 +370,13 @@ instance JabberPeerSession PeerSession where
 
     newPeerSession (PeerSessions state) sock = do
         me <- fmap (RemotePeer . withoutPort) (getPeerName sock)
-        L.putStrLn $ "PEER SESSION: open "<++>showPeer me
+        debugL $ "PEER SESSION: open "<++>showPeer me
         let remotes = remoteUsers state
         jids <- atomically $ getRefFromMap remotes me (newTVar MM.empty) return
         return $ PeerSession jids me state
 
     closePeerSession session  = do
-        L.putStrLn $ "PEER SESSION: close "<++>showPeer (peer_name session)
+        debugL $ "PEER SESSION: close "<++>showPeer (peer_name session)
         let offline jid = Presence jid Offline
         unrefFromMap (remoteUsers . peer_global $ session) (peer_name session)
             $ do
@@ -409,7 +410,7 @@ instance JabberPeerSession PeerSession where
 
     sendPeerMessage session msg = do
         let cons = remotePeers . peer_global $ session
-        putStrLn $ "sendPeerMessage " <++> bshow msg <++> " --> "<++>bshow (peer_name session)
+        debugL $ "sendPeerMessage " <++> bshow msg <++> " --> "<++>bshow (peer_name session)
         sendMessage cons msg (peer_name session)
 
     getBuddies     _ user = ConfigFiles.getBuddies user
@@ -442,7 +443,7 @@ instance JabberPeerSession PeerSession where
                 hbuddy <- asHostNameJID buddy
                 modify user (cmpJID buddy) hbuddy
         was_pending <- addjid ConfigFiles.modifyPending user buddy
-        putStrLn $ "processRequest was_pending="<++>bshow was_pending
+        debugL $ "processRequest was_pending="<++>bshow was_pending
         --    "all available resources in accordence with section 8"
         --    Section 8 says (for presence of type "subscribe", the server MUST
         --    adhere to the rules defined under Section 3 and summarized under
@@ -492,7 +493,7 @@ getJabberUserForId muid =
                    muid
 
 cmpJID newitem jid = do
-    -- putStrLn $ "Comparing "<++>bshow jid
+    -- debugL $ "Comparing "<++>bshow jid
     olditem <- parseHostNameJID jid
     if olditem==newitem then return Nothing
                         else return $ Just jid
@@ -505,7 +506,7 @@ addRawJid modify user jid = do
 
 addJid modify user jid = do
     hjid <- asHostNameJID jid
-    putStrLn $ "addJid (asHostNameJID) --> "<++>bshow hjid
+    debugL $ "addJid (asHostNameJID) --> "<++>bshow hjid
     withJust hjid $ \hjid -> do
     modify user (cmpJID jid) (Just hjid)
     return ()
@@ -598,10 +599,10 @@ update_presence locals_greedy subscribers state getStatus =
       runMaybeT $ do
         chan <- MaybeT . return $ locals_greedy
         sendPresence chan jid status
-      putStrLn $ bshow jid <++> " " <++> bshow status
+      debugL $ bshow jid <++> " " <++> bshow status
 
 sendProbes state jid = do
-    L.putStrLn $ "sending probes for " <++> bshow jid
+    debugL $ "sending probes for " <++> bshow jid
     withJust (name jid) $ \user -> do
     let parseHostNameJID' str = do
             handle (\(SomeException _) -> return Nothing)
@@ -609,7 +610,7 @@ sendProbes state jid = do
     buddies <- do
         buddies <- ConfigFiles.getBuddies user
         fmap catMaybes (mapM parseHostNameJID' buddies)
-    L.putStrLn $ "buddies for " <++> bshow jid <++> " = " <++> bshow buddies
+    debugL $ "buddies for " <++> bshow jid <++> " = " <++> bshow buddies
     wanted <- do
         wanted <- ConfigFiles.getSolicited user
         fmap catMaybes (mapM parseHostNameJID' wanted)
@@ -621,7 +622,7 @@ sendProbes state jid = do
         let noinfo = not (MM.member buddyU jids)
         when noinfo $ do
         let msg = if got then PresenceProbe jid buddy else Solicitation jid buddy
-        L.putStrLn $ "sendMessage " <++> bshow msg
+        debugL $ "sendMessage " <++> bshow msg
         sendMessage (remotePeers state) msg (peer buddy) 
 
 
@@ -651,7 +652,7 @@ track_login host state e = do
 
 on_chvt state vtnum = do
     let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum)
-    L.putStrLn $ "VT switch: " <++> tty
+    debugL $ "VT switch: " <++> tty
     (users,subs,locals_greedy) <- atomically $ do
         us   <- readTVar $ activeUsers state
         subs <- readTVar $ subscriberMap state
@@ -694,19 +695,19 @@ start ip4or6 = do
 
     threadDelay 1000 -- wait a moment to obtain current tty
     dologin ()
-    putStrLn "\nHit enter to terminate...\n"
+    L.putStrLn "\nHit enter to terminate...\n"
     getLine
     killThread remotes
     quitListening clients
     quitListening peers
     -- threadDelay 1000
-    putStrLn "closed listener."
+    debugL "closed listener."
     unmonitorTTY mtty
-    putStrLn "unhooked tty monitor."
+    debugL "unhooked tty monitor."
 #ifndef NOUTMP
     removeWatch wd
 #endif
-    putStrLn "Normal termination."
+    debugL "Normal termination."
 
 sendUSR1 pid = do
     signalProcess sigUSR1 pid
@@ -721,11 +722,11 @@ getStartupAction (p:ps) = do
  where
     onEr (SomeException _) = do
         pid <- getProcessID
-        putStrLn $ "starting pid = " <++> bshow pid
+        debugL $ "starting pid = " <++> bshow pid
         handle (\(SomeException _) -> getStartupAction ps)
             (do 
                 writeFile p (show pid)
-                putStrLn $ "writing " <++> bshow p
+                debugL $ "writing " <++> bshow p
                 -- start daemon
                 return (Right p) )