Doc fix, optimization, and more.

[Lucu.git] / Network / HTTP / Lucu / Resource / Tree.hs

diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
index 9af5fd54ed809d19b1f65c168748a02b7878a641..149fa9d92d3b5101a27f5ba6c334133a3921fe34 100644 (file)
--- 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
@@ -22,7 +22,6 @@ import           Data.Map (Map)
 import           Data.Maybe
 import           Network.HTTP.Lucu.Abortion
 import           Network.HTTP.Lucu.Config
-import           Network.HTTP.Lucu.MIMEType
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Resource
 import           Network.HTTP.Lucu.Response
@@ -42,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.
     -- 
@@ -169,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
@@ -228,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: 同じ名前で複數の値があった時は、こ
                            -- れではまずいと思ふ。
@@ -238,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