X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FTree.hs;h=4ed161fafc39c41ed0ed324100042430b674f8a2;hp=be51282c910ad11c78754190b7f96b35563a7d9a;hb=a827a5e1ba744d89c5b2396bb195e344ae892306;hpb=0b4db5681e3b0b27357a87316822ea3671f8c174 diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs index be51282..4ed161f 100644 --- a/Network/HTTP/Lucu/Resource/Tree.hs +++ b/Network/HTTP/Lucu/Resource/Tree.hs @@ -1,3 +1,6 @@ +-- #prune + +-- | Repository of the resources in httpd. module Network.HTTP.Lucu.Resource.Tree ( ResourceDef(..) , ResTree @@ -35,20 +38,67 @@ import Prelude hiding (catch) -- があれば、假に "/aaa/bbb/ccc" に何らかのリソースがあったとしても必ず -- "/aaa/bbb" が撰ばれる。"/aaa/bbb" のリソースが貪欲でなければ、それは -- 無視される。 + +-- | '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 resUsesNativeThread :: Bool + -- | Whether to be greedy or not. + -- + -- Say a client is trying to access \/aaa\/bbb\/ccc. If there is a + -- greedy resource at \/aaa\/bbb, it is always chosen even if + -- there is another resource at \/aaa\/bbb\/ccc. If the resource + -- at \/aaa\/bbb is not greedy, it is just ignored. Greedy + -- resource is like a CGI script. , resIsGreedy :: Bool + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a GET + -- request comes for the resource path. If 'resGet' is Nothing, + -- the system responds \"405 Method Not Allowed\" for GET + -- requests. + -- + -- It also runs for HEAD request if the 'resHead' is Nothing. In + -- this case 'Network.HTTP.Lucu.Resource.output' and such like + -- don't actually write a response body. , resGet :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a HEAD + -- request comes for the resource path. If 'resHead' is Nothing, + -- the system runs 'resGet' instead. If 'resGet' is also Nothing, + -- the system responds \"405 Method Not Allowed\" for HEAD + -- requests. , resHead :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a POST + -- request comes for the resource path. If 'resPost' is Nothing, + -- the system responds \"405 Method Not Allowed\" for POST + -- requests. , resPost :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a PUT + -- request comes for the resource path. If 'resPut' is Nothing, + -- the system responds \"405 Method Not Allowed\" for PUT + -- requests. , resPut :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a + -- DELETE request comes for the resource path. If 'resDelete' is + -- Nothing, the system responds \"405 Method Not Allowed\" for + -- DELETE requests. , resDelete :: Maybe (Resource ()) } + +-- | 'ResTree' is an opaque structure which is a map from resource +-- path to 'ResourceDef'. type ResTree = ResNode -- root だから Map ではない type ResSubtree = Map String ResNode data ResNode = ResNode (Maybe ResourceDef) ResSubtree - +-- | 'mkResTree' converts a list of @(path, def)@ to a 'ResTree' e.g. +-- +-- @ +-- mkResTree [ ([] , 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/stdio.h\" ) -- \/ +-- , ([\"unistd\"], 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/unistd.h\") -- \/unistd +-- ] +-- @ mkResTree :: [ ([String], ResourceDef) ] -> ResTree mkResTree list = processRoot list where @@ -182,7 +232,8 @@ runResource def itr mapM_ (\ (name, value) -> setHeader name value) $ aboHeaders abo output $ abortPage conf reqM res abo else - hPutStrLn stderr $ show abo + when (cnfDumpTooLateAbortionToStderr $ itrConfig itr) + $ hPutStrLn stderr $ show abo flip runReaderT itr $ driftTo Done