From 7e8af335398be37523ff19244225b84d48e027ff Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 17 Jun 2013 18:03:50 -0400 Subject: cleaner debug output --- Presence/Server.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (limited to 'Presence/Server.hs') 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 -- cgit v1.2.3