X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=34c1a725634b6485df32d7e5e302238e44cf78b4;hb=1c692e4261ccc65d89a0aeaa8c9971d9a91c276f;hp=08fb6f19ce50b434457d42f0deef09710f6c31f1;hpb=37b2602949bdb71894852304753f3aab34de191b;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 08fb6f1..34c1a72 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -301,20 +301,26 @@ getPathInfo = do rsrcPath <- getResourcePath
                  -- 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 [FormData]
-getQueryForm = do uri <- getRequestURI
-                  return $! map pairToFormData $ parseWWWFormURLEncoded $ snd $ splitAt 1 $ uriQuery uri
-
-pairToFormData :: (String, String) -> FormData
-pairToFormData (name, value)
-    = FormData {
-        fdName     = name
-      , fdFileName = Nothing
-      , fdContent  = L8.pack value
-      }
+-- |Assume the query part of request URI as
+-- application\/x-www-form-urlencoded, and parse it to pairs of
+-- @(name, formData)@. This action doesn't parse the request body. See
+-- 'inputForm'.
+getQueryForm :: Resource [(String, FormData)]
+getQueryForm = liftM parse' getRequestURI
+    where
+      parse' = map toPairWithFormData .
+               parseWWWFormURLEncoded .
+               snd .
+               splitAt 1 .
+               uriQuery
+
+toPairWithFormData :: (String, String) -> (String, FormData)
+toPairWithFormData (name, value)
+    = let fd = FormData {
+                 fdFileName = Nothing
+               , fdContent  = L8.pack value
+               }
+      in (name, fd)
 
 -- |Get a value of given request header. Comparison of header name is
 -- case-insensitive. Note that this action is not intended to be used
@@ -726,7 +732,7 @@ inputChunkLBS limit
 -- makes 'Resource' abort with status \"415 Unsupported Media
 -- Type\". If the request has no \"Content-Type\", it aborts with
 -- \"400 Bad Request\".
-inputForm :: Int -> Resource [FormData]
+inputForm :: Int -> Resource [(String, FormData)]
 inputForm limit
     = limit `seq` 
       do cTypeM <- getContentType
@@ -742,8 +748,7 @@ inputForm limit
                                                           ++ show cType)
     where
       readWWWFormURLEncoded
-          = do src <- input limit
-               return $ map pairToFormData $ parseWWWFormURLEncoded src
+          = liftM (map toPairWithFormData . parseWWWFormURLEncoded) (input limit)
 
       readMultipartFormData params
           = do case find ((== "boundary") . map toLower . fst) params of
@@ -752,7 +757,8 @@ inputForm limit
                  Just (_, boundary)
                      -> do src <- inputLBS limit
                            case parse (multipartFormP boundary) src of
-                             (# Success fdList, _ #) -> return fdList
+                             (# Success formList, _ #)
+                                 -> return formList
                              (# _, _ #)
                                  -> abort BadRequest [] (Just "Unparsable multipart/form-data")