X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=c36b81905cb147ee37eb28c1463bcf8e51069dee;hb=db4b612;hp=10d1f64276f07307c581e66d463492c3ef7358d6;hpb=05f49fae07dfcac0c039f25c8a51123603918a93;p=Lucu.git

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 10d1f64..c36b819 100644
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE
     DoAndIfThenElse
   , OverloadedStrings
+  , RecordWildCards
   , ScopedTypeVariables
   , UnicodeSyntax
   #-}
@@ -10,22 +11,19 @@ module Network.HTTP.Lucu.MultipartForm
     )
     where
 import Control.Applicative hiding (many)
-import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
+import Data.Ascii (Ascii, CIAscii)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LS
-import Data.Char
-import Data.List
 import Data.Map (Map)
+import qualified Data.Map as M
 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Text (Text)
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.RFC2231
-import Network.HTTP.Lucu.Response
-import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
 -- |This data type represents a form value and possibly an uploaded
@@ -62,8 +60,7 @@ printContDispo d
 
 multipartFormP ∷ Ascii → Parser [(Text, FormData)]
 multipartFormP boundary
-    = try $
-      do parts ← many (partP boundary)
+    = do parts ← many $ try $ partP boundary
          _     ← string "--"
          _     ← string $ A.toByteString boundary
          _     ← string "--"
@@ -72,8 +69,7 @@ multipartFormP boundary
 
 partP ∷ Ascii → Parser Part
 partP boundary
-    = try $
-      do _    ← string "--"
+    = do _    ← string "--"
          _    ← string $ A.toByteString boundary
          crlf
          hs   ← headersP
@@ -83,8 +79,7 @@ partP boundary
 
 bodyP ∷ Ascii → Parser LS.ByteString
 bodyP boundary
-    = try $
-      do body ← manyCharsTill anyChar $
+    = do body ← manyCharsTill anyChar $
                     try $
                     do crlf
                        _ ← string "--"
@@ -97,7 +92,7 @@ partToFormPair ∷ Monad m ⇒ Part → m (Maybe (Text, FormData))
 {-# INLINEABLE partToFormPair #-}
 partToFormPair pt
     | dType (ptContDispo pt) ≡ "form-data"
-        = do name  ← partName pt
+        = do name ← partName pt
              let fname = partFileName pt
              let fd    = FormData {
                            fdFileName = fname
@@ -109,18 +104,18 @@ partToFormPair pt
 
 partName ∷ Monad m ⇒ Part → m Text
 {-# INLINEABLE partName #-}
-partName pt
-    = case find ((≡ "name") ∘ fst) $ dParams $ ptContDispo pt of
-        Just (_, name)
+partName (Part {..})
+    = case M.lookup "name" $ dParams ptContDispo of
+        Just name
             → return name
         Nothing
             → fail ("form-data without name: " ⧺
-                    A.toString (printContDispo $ ptContDispo pt))
+                    A.toString (printContDispo ptContDispo))
 
 partFileName ∷ Part → Maybe Text
 {-# INLINEABLE partFileName #-}
-partFileName pt
-    = snd <$> (find ((== "filename") ∘ fst) $ dParams $ ptContDispo pt)
+partFileName (Part {..})
+    = M.lookup "filename" $ dParams ptContDispo
 
 getContDispo ∷ Monad m ⇒ Headers → m ContDispo
 {-# INLINEABLE getContDispo #-}
@@ -143,16 +138,6 @@ getContDispo hdr
                                           ])
 
 contDispoP ∷ Parser ContDispo
-contDispoP = try $
-             do dispoType ← A.toCIAscii <$> token
-                params    ← many paramP
+contDispoP = do dispoType ← A.toCIAscii <$> token
+                params    ← paramsP
                 return $ ContDispo dispoType params
-    where
-      paramP ∷ Parser (CIAscii, Ascii)
-      paramP = do skipMany lws
-                  _     ← char ';'
-                  skipMany lws
-                  name  ← A.toCIAscii <$> token
-                  _     ← char '='
-                  value ← token <|> quotedStr
-                  return (name, value)