fixing labelSocket

Author: kazu-yamamoto

Network/Socket.hs

@@ -287,6 +287,8 @@ module Network.Socket (
     isSupportedFamily,
     packFamily,
     unpackFamily,
+    labelSocket,
+    socketLabel,
 
     -- ** Protocol number
     ProtocolNumber,

Network/Socket/SockAddr.hs

@@ -77,7 +77,7 @@ bind' s sa = case sa of
                         G.bind s sa
     _ -> do
         G.bind s sa
-        labelSocket s (\label -> label ++ "" ++ show sa)
+        labelSocket s (\label -> label ++ " " ++ show sa)
 
 -- | Accept a connection.  The socket must be bound to an address and
 -- listening for connections.  The return value is a pair @(conn,
@@ -90,7 +90,8 @@ accept s = accept' `annotateWithSocket` (s, Nothing)
   where
     accept' = do
         r@(news, sa) <- G.accept s
-        labelSocket news (\label -> label ++ " " ++ show sa)
+        label <- socketLabel s
+        labelSocket news (\_ -> label ++ " " ++ show sa)
         return r
 
 -- | Send data to the socket.  The recipient can be specified
@@ -156,6 +157,6 @@ annotateWithSocket :: IO a -> (Socket, Maybe SockAddr) -> IO a
 annotateWithSocket io (s, mpeersa) = do
     label <- socketLabel s
     let label' = case mpeersa of
-            Nothing -> label
-            Just peersa -> label ++ " " ++ show peersa
+            Nothing -> "<" ++ label ++ ">"
+            Just peersa -> "<" ++ label ++ "> " ++ show peersa
     annotateIOException io label'

Network/Socket/Types.hsc

@@ -222,7 +222,7 @@ foreign import ccall unsafe "dup"
 mkSocket :: CInt -> IO Socket
 mkSocket fd = do
     ref <- newIORef fd
-    anno <- newIORef ""
+    anno <- newIORef $ "sock " ++ show fd
     let s = Socket ref fd anno
     void $ mkWeakIORef ref $ close s
     return s