From dfc778742934b8f2ac6a6709741c79ecd40c5ff1 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Fri, 26 Aug 2011 01:51:25 +0900
Subject: [PATCH] MIMEType and MultipartForm

Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa
---
 Network/HTTP/Lucu/MIMEType.hs      | 29 +++-------------------------
 Network/HTTP/Lucu/MultipartForm.hs | 31 ++++++++++--------------------
 2 files changed, 13 insertions(+), 47 deletions(-)

diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs
index 9f2cb87..dfaef11 100644
--- a/Network/HTTP/Lucu/MIMEType.hs
+++ b/Network/HTTP/Lucu/MIMEType.hs
@@ -23,7 +23,7 @@ import Data.Map (Map)
 import Data.Monoid.Unicode
 import Data.Text (Text)
 import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.Utils
+import Network.HTTP.Lucu.RFC2231
 import Prelude hiding (min)
 import Prelude.Unicode
 
@@ -42,21 +42,8 @@ printMIMEType (MIMEType maj min params)
       ( A.toAsciiBuilder (A.fromCIAscii maj) ⊕
         A.toAsciiBuilder "/" ⊕
         A.toAsciiBuilder (A.fromCIAscii min) ⊕
-        if null params then
-            (∅)
-        else
-            A.toAsciiBuilder "; " ⊕
-            joinWith "; " (map printPair params)
+        printParams params
       )
-    where
-      printPair ∷ (CIAscii, Ascii) → A.AsciiBuilder
-      printPair (name, value)
-          = A.toAsciiBuilder (A.fromCIAscii name) ⊕
-            A.toAsciiBuilder "=" ⊕
-            if C8.any ((¬) ∘ isToken) (A.toByteString value) then
-                quoteStr value
-            else
-                A.toAsciiBuilder value
 
 -- |Parse 'MIMEType' from an 'Ascii'. This function throws an
 -- exception for parse error.
@@ -75,18 +62,8 @@ mimeTypeP ∷ Parser MIMEType
 mimeTypeP = do maj    ← A.toCIAscii <$> token
                _      ← char '/'
                min    ← A.toCIAscii <$> token
-               params ← P.many paramP
+               params ← paramsP
                return $ MIMEType maj min params
-    where
-      paramP ∷ Parser (CIAscii, Ascii)
-      paramP = try $
-               do skipMany lws
-                  _     ← char ';'
-                  skipMany lws
-                  name  ← A.toCIAscii <$> token
-                  _     ← char '='
-                  value ← token <|> quotedStr
-                  return (name, value)
 
 mimeTypeListP ∷ Parser [MIMEType]
 mimeTypeListP = listOf mimeTypeP
diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 7ddcbd0..8d09d70 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
@@ -106,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 #-}
@@ -141,14 +139,5 @@ getContDispo hdr
 
 contDispoP ∷ Parser ContDispo
 contDispoP = do dispoType ← A.toCIAscii <$> token
-                params    ← many paramP
+                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)
-- 
2.40.0