X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequestReader.hs;h=08cc2e937b4696cb4078d425438407b95e11d81a;hb=b340a77fa7bd051dd13a41d0a5b1ad30220bc6b6;hp=42eda0e7cb8efcec541eed78f19ba4f1d557b241;hpb=1000bdc46cfe7b3ae550ff24ccea9f440f11b42a;p=Lucu.git

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 42eda0e..08cc2e9 100644
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -1,5 +1,6 @@
+-- #hide
 module Network.HTTP.Lucu.RequestReader
-    ( requestReader -- Config -> ResTree -> Handle -> HostName -> InteractionQueue -> IO ()
+    ( requestReader
     )
     where
 
@@ -25,10 +26,10 @@ import           Network.HTTP.Lucu.Preprocess
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Resource
+import           Network.HTTP.Lucu.Resource.Tree
 import           Prelude hiding (catch)
 import           System.IO
 
-import GHC.Conc (unsafeIOToSTM)
 
 requestReader :: Config -> ResTree -> Handle -> HostName -> InteractionQueue -> IO ()
 requestReader cnf tree h host tQueue
@@ -85,8 +86,8 @@ requestReader cnf tree h host tQueue
                                Nothing -- Resource が無かった
                                    -> acceptRequestForNonexistentResource itr input
 
-                               Just rsrcDef -- あった
-                                   -> acceptRequestForExistentResource itr input rsrcDef
+                               Just (rsrcPath, rsrcDef) -- あった
+                                   -> acceptRequestForExistentResource itr input rsrcPath rsrcDef
                action
 
       acceptSemanticallyInvalidRequest :: Interaction -> ByteString -> STM (IO ())
@@ -111,9 +112,10 @@ requestReader cnf tree h host tQueue
                enqueue itr
                return $ acceptRequest input
 
-      acceptRequestForExistentResource :: Interaction -> ByteString -> ResourceDef -> STM (IO ())
-      acceptRequestForExistentResource itr input rsrcDef
-          = do requestHasBody <- readItr itr itrRequestHasBody id
+      acceptRequestForExistentResource :: Interaction -> ByteString -> [String] -> ResourceDef -> STM (IO ())
+      acceptRequestForExistentResource oldItr input rsrcPath rsrcDef
+          = do let itr = oldItr { itrResourcePath = Just rsrcPath }
+               requestHasBody <- readItr itr itrRequestHasBody id
                enqueue itr
                return $ do runResource rsrcDef itr
                            if requestHasBody then