X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FInternal.hs;h=a19339c1e6280e3830987bab5a9d200002ad6344;hp=f6d17b6b2f367e32d4956cdccd68431165414db2;hb=950640dd241222203778f8167943d30fa52f356a;hpb=3baf479eba12bc3e9c4ef966df770cd70aa5cd81 diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs index f6d17b6..a19339c 100644 --- a/Network/HTTP/Lucu/Resource/Internal.hs +++ b/Network/HTTP/Lucu/Resource/Internal.hs @@ -261,25 +261,30 @@ getRequest ∷ Rsrc Request getRequest = niRequest <$> getInteraction -- |Get the path of this 'Rsrc' (to be exact, 'Resource') in the --- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The result of this +-- corresponding 'Network.HTTP.Lucu.ResourceTree'. The result of this -- action is the exact path in the tree even when the 'Resource' is --- greedy. +-- 'Network.HTTP.Lucu.greedy'. -- -- Example: -- --- > main = let tree = mkResTree [ (["foo"], resFoo) ] --- > in runHttpd defaultConfig tree [] --- > --- > resFoo = emptyResource { --- > resIsGreedy = True --- > , resGet = Just $ do requestURI <- getRequestURI --- > resourcePath <- getResourcePath --- > pathInfo <- getPathInfo --- > -- uriPath requestURI == "/foo/bar/baz" --- > -- resourcePath == ["foo"] --- > -- pathInfo == ["bar", "baz"] --- > ... --- > } +-- @ +-- main :: 'IO' () +-- main = let tree :: 'Network.HTTP.Lucu.ResourceTree' +-- tree = 'fromList' [ (["foo"], 'Network.HTTP.Lucu.greedy' resFoo) ] +-- in 'Network.withSocketsDo' '.' 'Network.HTTP.Lucu.runHttpd' 'defaultConfig' $ 'Network.HTTP.Lucu.resourceMap' tree +-- +-- resFoo :: 'Resource' +-- resFoo = 'singleton' +-- ( 'GET' +-- , do requestURI <- 'getRequestURI' +-- resourcePath <- 'getResourcePath' +-- pathInfo <- 'getPathInfo' +-- -- 'Network.URI.uriPath' requestURI '==' \"/foo/bar/baz\" +-- -- resourcePath == ["foo"] +-- -- pathInfo == ["bar", "baz"] +-- ... +-- ) +-- @ getResourcePath ∷ Rsrc Path getResourcePath = niResourcePath <$> getInteraction @@ -330,7 +335,7 @@ setStatus sc -- |@'setHeader' name value@ declares the value of the response header -- @name@ as @value@. Note that this function is not intended to be -- used so frequently: there should be specialised functions like --- 'setContentType' for every common headers. +-- 'Network.HTTP.Lucu.setContentType' for every common headers. -- -- Some important headers (especially \"Content-Length\" and -- \"Transfer-Encoding\") may be silently dropped or overwritten by @@ -375,8 +380,8 @@ deleteHeader name = liftIO ∘ atomically ∘ go =≪ getInteraction -- infinitely long stream of octets. -- -- Note that you must first declare the response header --- \"Content-Type\" before applying this function. See: --- 'setContentType' +-- \"Content-Type\" before applying this function. See +-- 'Network.HTTP.Lucu.setContentType'. putBuilder ∷ Builder → Rsrc () putBuilder b = liftIO ∘ atomically ∘ go =≪ getInteraction where