X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=741427f271636e48eb3d1cf060b4fbf794c6c662;hb=9bb89434103e9a22f100d6ecb7e65a5d461e0454;hp=4a34ba549764e722ea613de97ff5ff80bd116d79;hpb=a2a726f3581933cea2d805b76aca0e93da778994;p=Lucu.git

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 4a34ba5..741427f 100644
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -1,30 +1,30 @@
+{-# LANGUAGE
+    UnboxedTuples
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.MultipartForm
     ( FormData(..)
     , multipartFormP
     )
     where
-
 import qualified Data.ByteString.Char8 as C8
 import qualified Data.ByteString.Lazy.Char8 as L8
 import           Data.Char
 import           Data.List
 import           Network.HTTP.Lucu.Abortion
 import           Network.HTTP.Lucu.Headers
-import           Network.HTTP.Lucu.Parser
 import           Network.HTTP.Lucu.Parser.Http
 import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Utils
 
+data Part = Part Headers L8.ByteString
 
-data Part = Part Headers String
-
--- |This data type represents a form entry name, form value and
--- possibly an uploaded file name.
+-- |This data type represents a form value and possibly an uploaded
+-- file name.
 data FormData
     = FormData {
-        fdName     :: String
-      , fdFileName :: Maybe String
-      , fdContent  :: String
+        fdFileName :: Maybe String
+      , fdContent  :: L8.ByteString
       }
 
 instance HasHeaders Part where
@@ -50,49 +50,47 @@ instance Show ContDispo where
                                    value
 
 
-multipartFormP :: String -> Parser [FormData]
+multipartFormP :: String -> Parser [(String, FormData)]
 multipartFormP boundary
     = do parts <- many (partP boundary)
-         string "--"
-         string boundary
-         string "--"
-         crlf
+         _     <- string "--"
+         _     <- string boundary
+         _     <- string "--"
+         _     <- crlf
          eof
-         return $ map partToFormData parts
+         return $ map partToFormPair parts
 
 
 partP :: String -> Parser Part
 partP boundary
-    = do string "--"
-         string boundary
-         crlf -- バウンダリの末尾に -- が付いてゐたらここで fail する。
+    = do _    <- string "--"
+         _    <- string boundary
+         _    <- crlf -- バウンダリの末尾に -- が付いてゐたらここで fail する。
          hs   <- headersP
          body <- bodyP boundary
          return $ Part hs body
 
 
-bodyP :: String -> Parser String
+bodyP :: String -> Parser L8.ByteString
 bodyP boundary
-    = do body <- many $
-                 do notFollowedBy $ do crlf
-                                       string "--"
-                                       string boundary
+    = do body <- manyChar $
+                 do notFollowedBy $ ( crlf         >>
+                                      string "--"  >>
+                                      string boundary )
                     anyChar
-         crlf
+         _    <- crlf
          return body
 
 
-partToFormData :: Part -> FormData
-partToFormData part@(Part _ body)
+partToFormPair :: Part -> (String, FormData)
+partToFormPair part@(Part _ body)
     = let name  = partName part
-          fName = partFileName part
-      in
-        FormData {
-          fdName     = name
-        , fdFileName = fName
-        , fdContent  = body
-        }
-
+          fname = partFileName part
+          fd    = FormData {
+                    fdFileName = fname
+                  , fdContent  = body
+                  }
+      in (name, fd)
 
 partName :: Part -> String
 partName = getName' . getContDispoFormData
@@ -146,10 +144,10 @@ contDispoP = do dispoType <- token
                 return $ ContDispo dispoType params
     where
       paramP :: Parser (String, String)
-      paramP = do many lws
-                  char ';'
-                  many lws
-                  name <- token
-                  char '='
+      paramP = do _     <- many lws
+                  _     <- char ';'
+                  _     <- many lws
+                  name  <- token
+                  _     <- char '='
                   value <- token <|> quotedStr
                   return (name, value)