Yay! Deadlock problem has finally been solved!

[Lucu.git] / Network / HTTP / Lucu / ResponseWriter.hs

diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
index 266f825c4d8a0ce8e4d9190703d90dc050cc6a21..ebd97e79d4d6c16584f354d50588abdbd8859e04 100644 (file)
--- a/Network/HTTP/Lucu/ResponseWriter.hs
+++ b/Network/HTTP/Lucu/ResponseWriter.hs
@@ -17,15 +17,18 @@ import           Prelude hiding (catch)
 import           System.IO
 import           Text.Printf
 
+import Control.Concurrent
 import Debug.Trace
 
 
-responseWriter :: Handle -> InteractionQueue -> IO ()
-responseWriter h tQueue
+responseWriter :: Handle -> InteractionQueue -> ThreadId -> IO ()
+responseWriter h tQueue readerTID
     = catch awaitSomethingToWrite $ \ exc ->
       case exc of
-        IOException _ -> return ()
-        _             -> print exc
+        IOException _               -> return ()
+        AsyncException ThreadKilled -> return ()
+        BlockedIndefinitely         -> putStrLn "requestWriter: blocked indefinitely"
+        _                           -> print exc
     where
       awaitSomethingToWrite :: IO ()
       awaitSomethingToWrite 
@@ -133,6 +136,7 @@ responseWriter h tQueue
 
                                             readItr itr itrWillClose id
                if willClose then
-                   hClose h
+                   do killThread readerTID
+                      hClose h
                  else
                    awaitSomethingToWrite