--- > main = let tree = mkResTree [ (["foo"], resFoo) ]
--- > in runHttpd defaultConfig tree
--- >
--- > resFoo = ResourceDef {
--- > resIsGreedy = True
--- > , resGet = Just $ do requestURI <- getRequestURI
--- > resourcePath <- getResourcePath
--- > pathInfo <- getPathInfo
--- > -- uriPath requestURI == "/foo/bar/baz"
--- > -- resourcePath == ["foo"]
--- > -- pathInfo == ["bar", "baz"]
--- > ...
--- > , ...
--- > }
-getResourcePath :: Resource [String]
-getResourcePath = do itr <- ask
- return $! fromJust $! itrResourcePath itr
-
-
--- |This is an analogy of CGI PATH_INFO. Its result is always @[]@ if
--- the 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is not
--- greedy. See 'getResourcePath'.
-getPathInfo :: Resource [String]
-getPathInfo = do rsrcPath <- getResourcePath
- reqURI <- getRequestURI
- let reqPathStr = uriPath reqURI
- reqPath = [x | x <- splitBy (== '/') reqPathStr, x /= ""]
- -- rsrcPath と reqPath の共通する先頭部分を reqPath か
- -- ら全部取り除くと、それは PATH_INFO のやうなものにな
- -- る。rsrcPath は全部一致してゐるに決まってゐる(でな
- -- ければこの Resource が撰ばれた筈が無い)ので、
- -- rsrcPath の長さの分だけ削除すれば良い。
- return $! drop (length rsrcPath) reqPath
-
--- | Assume the query part of request URI as
--- application\/x-www-form-urlencoded, and parse it. This action
--- doesn't parse the request body. See 'inputForm'.
-getQueryForm :: Resource [(String, String)]
-getQueryForm = do reqURI <- getRequestURI
- return $! parseWWWFormURLEncoded $ uriQuery reqURI
-
--- |Get a value of given request header. Comparison of header name is
--- case-insensitive. Note that this action is not intended to be used
--- so frequently: there should be actions like 'getContentType' for
--- every common headers.
-getHeader :: String -> Resource (Maybe String)
-getHeader name = name `seq`
- do req <- getRequest
- return $! H.getHeader name req
-
--- |Get a list of 'Network.HTTP.Lucu.MIMEType.MIMEType' enumerated on
--- header \"Accept\".
-getAccept :: Resource [MIMEType]
-getAccept = do acceptM <- getHeader "Accept"
- case acceptM of
- Nothing
- -> return []
- Just accept
- -> case parseStr mimeTypeListP accept of
- (# Success xs, _ #) -> return xs
- (# _ , _ #) -> abort BadRequest []
- (Just $ "Unparsable Accept: " ++ accept)
-
--- |Get a list of @(contentCoding, qvalue)@ enumerated on header
--- \"Accept-Encoding\". The list is sorted in descending order by
--- qvalue.
-getAcceptEncoding :: Resource [(String, Maybe Double)]
+-- Note that the returned path components are URI-decoded.
+getPathInfo ∷ Rsrc [Strict.ByteString]
+getPathInfo = do rsrcPath ← getResourcePath
+ reqPath ← uriPathSegments <$> getRequestURI
+ return $ drop (length rsrcPath) reqPath
+
+-- |Assume the query part of request URI as
+-- application\/x-www-form-urlencoded, and parse it into pairs of
+-- @(name, formData)@. This function doesn't read the request
+-- body.
+getQueryForm ∷ Rsrc [(Strict.ByteString, FormData)]
+getQueryForm = parse' <$> getRequestURI
+ where
+ parse' = map toPairWithFormData ∘
+ parseWWWFormURLEncoded ∘
+ fromJust ∘
+ A.fromChars ∘
+ drop 1 ∘
+ uriQuery
+
+toPairWithFormData ∷ (ByteString, ByteString) → (Strict.ByteString, FormData)
+toPairWithFormData (name, value)
+ = let fd = FormData {
+ fdFileName = Nothing
+ , fdMIMEType = [mimeType| text/plain |]
+ , fdContent = Lazy.fromChunks [value]
+ }
+ in (name, fd)
+
+-- |@'getHeader' name@ returns the value of the request header field
+-- @name@. Comparison of header name is case-insensitive. Note that
+-- this function is not intended to be used so frequently: there
+-- should be functions like 'getContentType' for every common headers.
+getHeader ∷ CIAscii → Rsrc (Maybe Ascii)
+getHeader name
+ = H.getHeader name <$> getRequest
+
+-- |Return the list of 'MIMEType' enumerated on the value of request
+-- header \"Accept\", or @[]@ if absent.
+getAccept ∷ Rsrc [MIMEType]
+getAccept
+ = do acceptM ← getHeader "Accept"
+ case acceptM of
+ Nothing
+ → return []
+ Just accept
+ → case P.parseOnly (finishOff MT.mimeTypeList) (A.toByteString accept) of
+ Right xs → return xs
+ Left _ → abort $ mkAbortion' BadRequest
+ $ "Unparsable Accept: " ⊕ A.toText accept
+
+-- |Return the list of @(contentCoding, qvalue)@ enumerated on the
+-- value of request header \"Accept-Encoding\". The list is sorted in
+-- descending order by qvalue.
+getAcceptEncoding ∷ Rsrc [(CIAscii, Maybe Double)]