Exodus to GHC 6.8.1

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

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 468ef1179c78d5e9405f73b7f73879476c18d5fa..a81320b0f192e62cc2fbf40d2f998d70d3feab61 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -1,4 +1,3 @@
--- #hide
 module Network.HTTP.Lucu.Interaction
     ( Interaction(..)
     , InteractionState(..)
@@ -16,12 +15,15 @@ module Network.HTTP.Lucu.Interaction
     where
 
 import           Control.Concurrent.STM
-import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
+import qualified Data.ByteString as Strict (ByteString)
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import           Data.ByteString.Char8 as C8 hiding (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
 import qualified Data.Sequence as S
 import           Data.Sequence (Seq)
 import           Network.Socket
 import           Network.HTTP.Lucu.Config
+import           Network.HTTP.Lucu.Headers
 import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
@@ -30,30 +32,26 @@ data Interaction = Interaction {
       itrConfig       :: !Config
     , itrRemoteAddr   :: !SockAddr
     , itrResourcePath :: !(Maybe [String])
-    , itrRequest      :: !(TVar (Maybe Request))
+    , itrRequest      :: !(TVar (Maybe Request)) -- FIXME: TVar である必要無し
     , itrResponse     :: !(TVar Response)
 
-    -- FIXME: この三つは本來 TVar であるべきでないので、唯の Bool にす
-    -- るに越した事は無いが、それは重要でない。そんな golf で自分の貴重
-    -- な時間を /dev/null に突っ込むのは、他にしたい事が何も無くなって
-    -- からにすべき。
-    , itrRequestHasBody    :: !(TVar Bool)
-    , itrRequestIsChunked  :: !(TVar Bool)
-    , itrExpectedContinue  :: !(TVar Bool)
+    , itrRequestHasBody    :: !(TVar Bool) -- FIXME: TVar である必要無し
+    , itrRequestIsChunked  :: !(TVar Bool) -- FIXME: TVar である必要無し
+    , itrExpectedContinue  :: !(TVar Bool) -- FIXME: TVar である必要無し
 
     , itrReqChunkLength    :: !(TVar (Maybe Int))
     , itrReqChunkRemaining :: !(TVar (Maybe Int))
     , itrReqChunkIsOver    :: !(TVar Bool)
     , itrReqBodyWanted     :: !(TVar (Maybe Int))
     , itrReqBodyWasteAll   :: !(TVar Bool)
-    , itrReceivedBody      :: !(TVar ByteString) -- Resource が受領した部分は削除される
+    , itrReceivedBody      :: !(TVar Lazy.ByteString) -- Resource が受領した部分は削除される
 
     , itrWillReceiveBody   :: !(TVar Bool)
     , itrWillChunkBody     :: !(TVar Bool)
     , itrWillDiscardBody   :: !(TVar Bool)
     , itrWillClose         :: !(TVar Bool)
 
-    , itrBodyToSend :: !(TVar ByteString)
+    , itrBodyToSend :: !(TVar Lazy.ByteString)
     , itrBodyIsNull :: !(TVar Bool)
 
     , itrState :: !(TVar InteractionState)
@@ -78,8 +76,8 @@ newInteractionQueue :: IO InteractionQueue
 newInteractionQueue = newTVarIO S.empty
 
 
-defaultPageContentType :: String
-defaultPageContentType = "application/xhtml+xml"
+defaultPageContentType :: Strict.ByteString
+defaultPageContentType = C8.pack "application/xhtml+xml"
 
 
 newInteraction :: Config -> SockAddr -> Maybe Request -> IO Interaction
@@ -89,7 +87,7 @@ newInteraction conf addr req
          responce <- newTVarIO $ Response {
                        resVersion = HttpVersion 1 1
                      , resStatus  = Ok
-                     , resHeaders = [("Content-Type", defaultPageContentType)]
+                     , resHeaders = toHeaders [(C8.pack "Content-Type", defaultPageContentType)]
                      }
 
          requestHasBody     <- newTVarIO False
@@ -101,14 +99,14 @@ newInteraction conf addr req
          reqChunkIsOver     <- newTVarIO False   -- 最後のチャンクを讀み終へた
          reqBodyWanted      <- newTVarIO Nothing -- Resource が要求してゐるチャンク長
          reqBodyWasteAll    <- newTVarIO False   -- 殘りの body を讀み捨てよと云ふ要求
-         receivedBody       <- newTVarIO B.empty
+         receivedBody       <- newTVarIO L8.empty
 
          willReceiveBody   <- newTVarIO False
          willChunkBody     <- newTVarIO False
          willDiscardBody   <- newTVarIO False
          willClose         <- newTVarIO False
 
-         bodyToSend <- newTVarIO B.empty
+         bodyToSend <- newTVarIO L8.empty
          bodyIsNull <- newTVarIO True -- 一度でも bodyToSend が空でなくなったら False
 
          state <- newTVarIO ExaminingRequest
@@ -123,8 +121,8 @@ newInteraction conf addr req
                     , itrRequest      = request
                     , itrResponse     = responce
 
-                    , itrRequestHasBody    = requestHasBody
-                    , itrRequestIsChunked  = requestIsChunked
+                    , itrRequestHasBody   = requestHasBody
+                    , itrRequestIsChunked = requestIsChunked
                     , itrExpectedContinue = expectedContinue
 
                     , itrReqChunkLength    = reqChunkLength