cleaner debug output

1 files changed, 12 insertions, 6 deletions

diff --git a/Presence/Server.hs b/Presence/Server.hs
index adc3de84..deab779b 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -24,6 +24,8 @@ import Control.Exception (handle,SomeException(..))
 import Data.HList
 import Data.HList.TypeEqGeneric1()
 import Data.HList.TypeCastGeneric1()
+import System.IO.Error
+import ByteStringOperators
 
 
 newtype ConnId = ConnId Int
@@ -50,9 +52,6 @@ doServer port g startCon = runServer2 port (runConn2 g)
         hSetBuffering h NoBuffering
         st'' <- startCon sock (h .*. st)
         let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n")
-        handle doException $ do
-            -- PEER CRED: (0,4294967295,4294967295)
-            -- PEER NAME: 127.0.0.1:37253
         handle doException $ fix $ \loop -> do
             let continue () = hIsEOF h >>= flip when loop . not
             packet <- getPacket h
@@ -73,12 +72,19 @@ doServer port g startCon = runServer2 port (runConn2 g)
         listen sock 2
         forkIO $ do
             mainLoop sock (ConnId 0) go
-            L.putStrLn $ "quit accept loop"
+            -- L.putStrLn $ "quit accept loop"
         return sock
      where
         mainLoop sock idnum@(ConnId n) go = do
-            let doException (SomeException e) = do
-                Prelude.putStrLn ("\n\naccept-loop exception: " ++ show e ++ "\n\n")
+            let doException ioerror = do
+                let typ = ioeGetErrorType ioerror
+                if -- typ == InvalidArgument  
+                   -- but the symbol is not exported :/
+                   bshow typ=="invalid argument" 
+                  then do
+                    L.putStrLn $ "quit accept-loop."
+                  else do
+                    L.putStrLn ("accept-loop exception: " <++> bshow ioerror <++> "\n")
                 return Nothing
             mcon <- handle doException $ fix $ \loop -> do
                 con <- accept sock