The attoparsec branch. It doesn't even compile for now.

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

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index e73b74d19b814f3830106828170b883d617bee23..741427f271636e48eb3d1cf060b4fbf794c6c662 100644 (file)
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -1,29 +1,29 @@
+{-# LANGUAGE
+    UnboxedTuples
+  , UnicodeSyntax
+  #-}

 module Network.HTTP.Lucu.MultipartForm
     ( FormData(..)
     , multipartFormP
     )
     where
 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 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
 
 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 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 {
 data FormData
     = FormData {

-        fdName     :: String
-      , fdFileName :: Maybe String
+        fdFileName :: Maybe String

       , fdContent  :: L8.ByteString
       }
 
       , fdContent  :: L8.ByteString
       }
 


@@ -50,22 +50,22 @@ instance Show ContDispo where
                                    value
 
 
                                    value
 
 

-multipartFormP :: String -> Parser [FormData]
+multipartFormP :: String -> Parser [(String, FormData)]

 multipartFormP boundary
     = do parts <- many (partP boundary)
 multipartFormP boundary
     = do parts <- many (partP boundary)

-         string "--"
-         string boundary
-         string "--"
-         crlf
+         _     <- string "--"
+         _     <- string boundary
+         _     <- string "--"
+         _     <- crlf

          eof
          eof

-         return $ map partToFormData parts
+         return $ map partToFormPair parts

 
 
 partP :: String -> Parser Part
 partP boundary
 
 
 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
          hs   <- headersP
          body <- bodyP boundary
          return $ Part hs body


@@ -74,25 +74,23 @@ partP boundary
 bodyP :: String -> Parser L8.ByteString
 bodyP boundary
     = do body <- manyChar $
 bodyP :: String -> Parser L8.ByteString
 bodyP boundary
     = do body <- manyChar $

-                 do notFollowedBy $ do crlf
-                                       string "--"
-                                       string boundary
+                 do notFollowedBy $ ( crlf         >>
+                                      string "--"  >>
+                                      string boundary )

                     anyChar
                     anyChar

-         crlf
+         _    <- crlf

          return body
 
 
          return body
 
 

-partToFormData :: Part -> FormData
-partToFormData part@(Part _ body)
+partToFormPair :: Part -> (String, FormData)
+partToFormPair part@(Part _ body)

     = let name  = partName part
     = 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
 
 partName :: Part -> String
 partName = getName' . getContDispoFormData


@@ -146,10 +144,10 @@ contDispoP = do dispoType <- token
                 return $ ContDispo dispoType params
     where
       paramP :: Parser (String, String)
                 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)
                   value <- token <|> quotedStr
                   return (name, value)