X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FTree.hs;h=149fa9d92d3b5101a27f5ba6c334133a3921fe34;hp=c2f6add5483b2e19a653ce1d25f51510407a65ad;hb=0dc3d31312a12f2b085242841b29eb0d96e9c4ac;hpb=078fc2851ceae061fe368f2bc09fcd16d67ae00f

diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
index c2f6add..149fa9d 100644
--- a/Network/HTTP/Lucu/Resource/Tree.hs
+++ b/Network/HTTP/Lucu/Resource/Tree.hs
@@ -14,7 +14,7 @@ module Network.HTTP.Lucu.Resource.Tree
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
-import           Control.Monad.Reader
+import           Control.Monad
 import           Data.Dynamic
 import           Data.List
 import qualified Data.Map as M
@@ -41,9 +41,11 @@ import           Prelude hiding (catch)
 -- | 'ResourceDef' is basically a set of
 -- 'Network.HTTP.Lucu.Resource.Resource' monads for each HTTP methods.
 data ResourceDef = ResourceDef {
-    -- | Whether to run a 'Network.HTTP.Lucu.Resource.Resource' on a
-    -- native thread (spawned using @forkOS@) or to run it on a user
-    -- thread (spanwed using @forkIO@). Generally you don't
+    -- |Whether to run a 'Network.HTTP.Lucu.Resource.Resource' on a
+    -- native thread (spawned by 'Control.Concurrent.forkOS') or to
+    -- run it on a user thread (spanwed by
+    -- 'Control.Concurrent.forkIO'). Generally you don't need to set
+    -- this field to 'Prelude.True'.
       resUsesNativeThread :: !Bool
     -- | Whether to be greedy or not.
     -- 
@@ -168,10 +170,10 @@ runResource :: ResourceDef -> Interaction -> IO ThreadId
 runResource def itr
     = def `seq` itr `seq`
       fork
-      $! catch ( runReaderT ( do req <- getRequest
-                                 fromMaybe notAllowed $ rsrc req
-                                 driftTo Done
-                            ) itr
+      $! catch ( runRes ( do req <- getRequest
+                             fromMaybe notAllowed $ rsrc req
+                             driftTo Done
+                        ) itr
                )
              $ \ exc -> processException exc
     where
@@ -227,7 +229,7 @@ runResource def itr
                reqM  <- atomically $ readItr itr itrRequest id
                res   <- atomically $ readItr itr itrResponse id
                if state <= DecidingHeader then
-                   flip runReaderT itr
+                   flip runRes itr
                       $ do setStatus $ aboStatus abo
                            -- FIXME: 同じ名前で複數の値があった時は、こ
                            -- れではまずいと思ふ。
@@ -237,7 +239,7 @@ runResource def itr
                    when (cnfDumpTooLateAbortionToStderr $ itrConfig itr)
                             $ hPutStrLn stderr $ show abo
 
-               flip runReaderT itr $ driftTo Done
+               flip runRes itr $ driftTo Done
 
       formatIOE :: IOError -> String
       formatIOE ioE = if isUserError ioE then