rename all logging utilities

Author: banacorn

Web/SocketIO/Connection.hs

@@ -54,7 +54,6 @@ lookupSession :: SessionID -> ConnectionM (Maybe Session)
 lookupSession sessionID = do
     tableRef <- getSessionTableRef
     table <- liftIO (readIORef tableRef)
-    --debug Debug $ sessionID <> "    [Session] Lookup"
     return (H.lookup sessionID table)
 
 --------------------------------------------------------------------------------
@@ -99,8 +98,8 @@ handleConnection (Handshake, _) = do
 
     -- session table management
     updateSession (H.insert sessionID session)
-    debugLog Debug session "[Session] Created"
-    debugLog Debug session "[Request] Handshake"
+    logWithSessionID Debug sessionID "[Session] Created"
+    logWithSessionID Debug sessionID "[Request] Handshake"
 
     -- timeout
     setTimeout session
@@ -121,45 +120,45 @@ handleConnection (Handshake, _) = do
                 return $ Session sessionID Connecting channelHub listeners timeoutVar
 
 handleConnection (Connect sessionID, Just (session, Connecting)) = do
-    debugLog Debug session "[Request] Connect: ACK"
+    logWithSessionID Debug sessionID "[Request] Connect: ACK"
     extendTimeout session
     let session' = session { sessionState = Connected }
     updateSession (H.insert sessionID session')
     runSession SessionConnect session'
 
-handleConnection (Connect _, Just (session, Connected)) = do
-    debugLog Debug session "[Request] Connect: Polling"
+handleConnection (Connect sessionID, Just (session, Connected)) = do
+    logWithSessionID Debug sessionID "[Request] Connect: Polling"
     extendTimeout session  
     runSession SessionPolling session
 
 handleConnection (Connect sessionID, Nothing) = do
-    debug Warn $ sessionID <> "    [Request] Connect: Session not found" 
+    logWithSessionID Warn sessionID "[Request] Connect: Session not found" 
     return $ MsgError NoEndpoint NoData
 
 handleConnection (Disconnect sessionID, Just (session, _)) = do 
-    debugLog Debug session "[Request] Disconnect: By client"
+    logWithSessionID Debug sessionID "[Request] Disconnect: By client"
     clearTimeout session
     updateSession (H.delete sessionID)
-    debugLog Debug session "[Session] Destroyed"
+    logWithSessionID Debug sessionID "[Session] Destroyed"
     runSession SessionDisconnectByClient session
 
 handleConnection (Disconnect sessionID, Nothing) = do
-    debug Warn $ sessionID <> "    [Request] Disconnect: Session not found" 
+    logWithSessionID Warn sessionID "[Request] Disconnect: Session not found" 
     return MsgNoop
 
-handleConnection (Emit _ _, Just (session, Connecting)) = do
+handleConnection (Emit sessionID _, Just (session, Connecting)) = do
     extendTimeout session
-    debugLog Warn session "[Request] Emit: Session still connecting, not ACKed" 
+    logWithSessionID Warn sessionID "[Request] Emit: Session still connecting, not ACKed" 
     return $ MsgError NoEndpoint NoData
 
-handleConnection (Emit _ event@(Event eventName (Payload payloads)), Just (session, Connected)) = do
-    debugLog Debug session $ "[Request] Emit: " <> serialize eventName <> " " <> serialize payloads
+handleConnection (Emit sessionID event@(Event eventName (Payload payloads)), Just (session, Connected)) = do
+    logWithSessionID Debug sessionID $ "[Request] Emit: " <> serialize eventName <> " " <> serialize payloads
     runSession (SessionEmit event) session
 
-handleConnection (Emit _ NoEvent, Just (session, Connected)) = do
-    debugLog Warn session $ "[Request] Emit: event malformed"
+handleConnection (Emit sessionID NoEvent, Just (_, Connected)) = do
+    logWithSessionID Warn sessionID "[Request] Emit: event malformed"
     return $ MsgError NoEndpoint NoData
 
 handleConnection (Emit sessionID _, Nothing) = do
-    debug Warn $ sessionID <> "    [Request] Emit: Session not found" 
+    logWithSessionID Warn sessionID "[Request] Emit: Session not found" 
     return $ MsgError NoEndpoint NoData

Web/SocketIO/Log.hs

@@ -2,7 +2,7 @@
 -- | Exports some logging utilities.
 {-# LANGUAGE OverloadedStrings #-}
 
-module Web.SocketIO.Log ((<>), debugLog, debugSession, debug, showStatusBar) where
+module Web.SocketIO.Log ((<>), logRaw, logWithSession, logWithSessionID, showStatusBar) where
 
 --------------------------------------------------------------------------------
 import Web.SocketIO.Types
@@ -13,8 +13,8 @@ import Control.Monad.Trans                  (liftIO, MonadIO)
 
 --------------------------------------------------------------------------------
 -- | Write log to channel according to log level and configurations
-debug :: (Functor m, MonadIO m, ConnectionLayer m) => (ByteString -> Log) -> ByteString -> m ()
-debug logType message = do
+logRaw :: (Functor m, MonadIO m, ConnectionLayer m) => (ByteString -> Log) -> ByteString -> m ()
+logRaw logType message = do
     logLevel' <- fmap logLevel getConfiguration
     logChannel <- fmap envLogChannel getEnv
     if level <= logLevel' then liftIO $ writeChan logChannel (serialize log') else return ()
@@ -27,15 +27,15 @@ debug logType message = do
 
 --------------------------------------------------------------------------------
 -- | Attaches `Web.SocketIO.Types.Base.SessionID`
-debugLog :: (Functor m, MonadIO m, ConnectionLayer m) => (ByteString -> Log) -> Session -> ByteString -> m ()
-debugLog logType (Session sessionID _ _ _ _) message = debug logType (sessionID <> "    " <> serialize message) 
+logWithSessionID :: (Functor m, MonadIO m, ConnectionLayer m) => (ByteString -> Log) -> SessionID -> ByteString -> m ()
+logWithSessionID logType sessionID message = logRaw logType (sessionID <> "    " <> serialize message) 
 
 --------------------------------------------------------------------------------
 -- | Attaches `Web.SocketIO.Types.Base.SessionID` automatically
-debugSession :: (Functor m, MonadIO m, ConnectionLayer m, SessionLayer m) => (ByteString -> Log) -> ByteString -> m ()
-debugSession logType message = do
+logWithSession :: (Functor m, MonadIO m, ConnectionLayer m, SessionLayer m) => (ByteString -> Log) -> ByteString -> m ()
+logWithSession logType message = do
     Session sessionID _ _ _ _ <- getSession
-    debug logType $ fromByteString (sessionID <> "    " <> message)
+    logRaw logType $ fromByteString (sessionID <> "    " <> message)
 
 --------------------------------------------------------------------------------
 -- | Show status bar

Web/SocketIO/Session.hs

@@ -33,7 +33,7 @@ handleSession SessionHandshake = do
 
 
 handleSession SessionConnect = do
-    debugSession Info $ "Connected"
+    logWithSession Info $ "Connected"
     return $ MsgConnect NoEndpoint
 
 handleSession SessionPolling = do
@@ -45,35 +45,35 @@ handleSession SessionPolling = do
     case result of
         -- private
         Just (Private, Event eventName payloads) -> do
-            debugSession Info $ "Emit: " <> serialize eventName
+            logWithSession Info $ "Emit: " <> serialize eventName
             return $ MsgEvent NoID NoEndpoint (Event eventName payloads)
         -- broadcast
         Just (Broadcast _, Event eventName payloads) -> do
             -- this log will cause massive overhead, need to be removed
-            debugSession Info $ "Broadcast: " <> serialize eventName
+            logWithSession Info $ "Broadcast: " <> serialize eventName
             return $ MsgEvent NoID NoEndpoint (Event eventName payloads)
         -- wtf
         Just (_, NoEvent) -> do
-            debugSession Error $ "Event malformed"
+            logWithSession Error $ "Event malformed"
             return $ MsgEvent NoID NoEndpoint NoEvent
         -- no output, keep polling
         Nothing -> do
             return MsgNoop
 
 handleSession (SessionEmit event) = do
     case event of
-        Event eventName _ -> debugSession Info $ "On: " <> serialize eventName
-        NoEvent           -> debugSession Error $ "Event malformed"
+        Event eventName _ -> logWithSession Info $ "On: " <> serialize eventName
+        NoEvent           -> logWithSession Error $ "Event malformed"
     triggerEvent event
     return $ MsgConnect NoEndpoint
 
 handleSession SessionDisconnectByClient = do
-    debugSession Info $ "Disconnected by client"
+    logWithSession Info $ "Disconnected by client"
     triggerEvent (Event "disconnect" (Payload []))
     return $ MsgNoop
 
 handleSession SessionDisconnectByServer = do
-    debugSession Info $ "Disconnected by server"
+    logWithSession Info $ "Disconnected by server"
     triggerEvent (Event "disconnect" (Payload []))
     return $ MsgNoop
 

Web/SocketIO/Timeout.hs

@@ -37,8 +37,8 @@ primTimeout' firstTime session@(Session sessionID _ _ _ timeoutVar) = do
     duration <- getTimeoutDuration
 
     if firstTime 
-        then debug Debug $ sessionID <> "    [Session] Set timeout"
-        else debug Debug $ sessionID <> "    [Session] Extend timeout"
+        then logWithSessionID Debug sessionID "[Session] Set timeout"
+        else logWithSessionID Debug sessionID "[Session] Extend timeout"
     result <- timeout duration $ takeMVar timeoutVar
 
     case result of
@@ -51,7 +51,7 @@ primTimeout' firstTime session@(Session sessionID _ _ _ timeoutVar) = do
             -- remove session
             tableRef <- getSessionTableRef
             liftIO (modifyIORef tableRef (H.delete sessionID))
-            debug Debug $ sessionID <> "    [Session] Destroyed: close timeout"
+            logWithSessionID Debug sessionID "[Session] Destroyed: close timeout"
 
 ----------------------------------------------------------------------------------
 -- | Set timeout