Exodus to GHC 6.8.1

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

diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
index 52f6cf3476e1613c3e99c07805b1b467d33ccf85..830baa68eb05ae0944c2cb19a35a412d5a58f971 100644 (file)
--- a/Network/HTTP/Lucu/ResponseWriter.hs
+++ b/Network/HTTP/Lucu/ResponseWriter.hs
@@ -36,15 +36,13 @@ responseWriter cnf h tQueue readerTID
           = {-# SCC "awaitSomethingToWrite" #-}
             do action
                    <- atomically $!
-                      do -- キューが空でなくなるまで待つ
-                         queue <- readTVar tQueue
-                         when (S.null queue)
-                              retry
-
+                      -- キューが空でなくなるまで待つ
+                      do queue <- readTVar tQueue
                          -- GettingBody 状態にあり、Continue が期待され
                          -- てゐて、それがまだ送信前なのであれば、
                          -- Continue を送信する。
                          case S.viewr queue of
+                           EmptyR   -> retry
                            _ :> itr -> do state <- readItr itr itrState id
 
                                           if state == GettingBody then
@@ -163,6 +161,7 @@ responseWriter cnf h tQueue readerTID
                             do queue <- readTVar tQueue
 
                                case S.viewr queue of
+                                 EmptyR         -> return () -- this should never happen
                                  remaining :> _ -> writeTVar tQueue remaining
 
                                readItr itr itrWillClose id