Use base64-bytestring instead of dataenc

[Lucu.git] / Network / HTTP / Lucu / MultipartForm.hs

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 4a34ba549764e722ea613de97ff5ff80bd116d79..c4631300e9efae3b3d14ac57917597ef685032fd 100644 (file)
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    UnboxedTuples
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.MultipartForm
     ( FormData(..)
     , multipartFormP
@@ -16,15 +20,14 @@ import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Utils
 
 
-data Part = Part Headers String
+data Part = Part Headers L8.ByteString
 
--- |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 +53,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 +147,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)