Workaround hGetContents blocking all threads with my own version of the function
authorunc0rr
Wed, 20 Feb 2013 23:57:01 +0400
changeset 8521 80229928563f
parent 8519 98e2dbdda8c0
child 8523 f13ae07d82d7
Workaround hGetContents blocking all threads with my own version of the function
gameServer/OfficialServer/checker.hs
--- a/gameServer/OfficialServer/checker.hs	Wed Feb 20 22:54:16 2013 +0400
+++ b/gameServer/OfficialServer/checker.hs	Wed Feb 20 23:57:01 2013 +0400
@@ -32,10 +32,22 @@
 serverAddress = "netserver.hedgewars.org"
 protocolNumber = "43"
 
+getLines :: Handle -> IO [String]
+getLines h = g
+    where
+        g = do
+            l <- liftM Just (hGetLine h) `Exception.catch` (\(_ :: Exception.IOException) -> return Nothing)
+            if isNothing l then
+                return []
+                else
+                do
+                lst <- g
+                return $ fromJust l : lst
+
 
 engineListener :: Chan Message -> Handle -> IO ()
 engineListener coreChan h = do
-    output <- liftM lines $ hGetContents h
+    output <- getLines h
     debugM "Engine" $ show output
     if isNothing $ L.find start output then
         writeChan coreChan $ CheckFailed "No stats msg"