X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=30a4adb7dd3f11885254d8762862ad344a1daede;hp=fd85eaf8f907bd506df0042b79dece95c386f85d;hb=0678be8;hpb=5e561403ba8ad9c440cc2bf2bacb61ebc3c7a111

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index fd85eaf..30a4adb 100644
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -2,6 +2,7 @@
     DoAndIfThenElse
   , FlexibleContexts
   , OverloadedStrings
+  , QuasiQuotes
   , RecordWildCards
   , ScopedTypeVariables
   , UnicodeSyntax
@@ -9,8 +10,6 @@
   #-}
 -- |Parse \"multipart/form-data\" based on RFC 2388:
 -- <http://tools.ietf.org/html/rfc2388>
---
--- You usually don't have to use this module directly.
 module Network.HTTP.Lucu.MultipartForm
     ( FormData(..)
     , parseMultipartFormData
@@ -18,7 +17,7 @@ module Network.HTTP.Lucu.MultipartForm
     where
 import Control.Applicative hiding (many)
 import Control.Applicative.Unicode hiding ((∅))
-import Control.Monad.Error
+import Control.Monad.Error (MonadError, throwError)
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii)
 import qualified Data.Ascii as A
@@ -27,20 +26,25 @@ import qualified Data.Attoparsec.Lazy as LP
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LS
 import Data.ByteString.Lazy.Search
-import Data.Foldable
-import Data.List
-import qualified Data.Map as M
+import Data.Collections
+import Data.Convertible.Base
+import Data.Convertible.Instances.Ascii ()
+import Data.Convertible.Utils
+import Data.List (intercalate)
 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Sequence (Seq)
-import Data.Sequence.Unicode hiding ((∅))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.MIMEParams
-import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.MIMEType (MIMEType)
+import qualified Network.HTTP.Lucu.MIMEType as MT
+import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
+import Prelude hiding (lookup, mapM)
 import Prelude.Unicode
 
 -- |'FormData' represents a form value and possibly an uploaded file
@@ -68,12 +72,13 @@ data ContDispo
       , dParams ∷ !MIMEParams
       }
 
+-- FIXME
 printContDispo ∷ ContDispo → Ascii
 printContDispo d
     = A.fromAsciiBuilder
       ( A.toAsciiBuilder (A.fromCIAscii $ dType d)
         ⊕
-        printMIMEParams (dParams d) )
+        cs (dParams d) )
 
 -- |Parse \"multipart/form-data\" and return either @'Left' err@ or
 -- @'Right' result@. Note that there are currently the following
@@ -155,7 +160,7 @@ parsePart boundary src
                          ⧺ e
       where
         defaultCType ∷ MIMEType
-        defaultCType = parseMIMEType "text/plain"
+        defaultCType = [mimeType| text/plain |]
 
 partHeader ∷ Parser Headers
 partHeader = crlf *> headers
@@ -187,7 +192,7 @@ getContType hdrs
         Nothing
             → return Nothing
         Just str
-            → case parseOnly (finishOff mimeType) $ A.toByteString str of
+            → case parseOnly (finishOff MT.mimeType) $ A.toByteString str of
                  Right  d → return $ Just d
                  Left err → throwError $ "malformed Content-Type: "
                                        ⧺ A.toString str
@@ -228,7 +233,7 @@ partToFormPair pt@(Part {..})
 partName ∷ MonadError String m ⇒ Part → m Ascii
 {-# INLINEABLE partName #-}
 partName (Part {..})
-    = case M.lookup "name" params of
+    = case lookup "name" $ dParams ptContDispo of
         Just name
             → case A.fromText name of
                  Just a  → return a
@@ -237,10 +242,7 @@ partName (Part {..})
         Nothing
             → throwError $ "form-data without name: "
                          ⧺ A.toString (printContDispo ptContDispo)
-    where
-      params = case dParams ptContDispo of
-                 MIMEParams m → m
 
 partFileName ∷ Part → Maybe Text
-partFileName (dParams ∘ ptContDispo → MIMEParams m)
-    = M.lookup "filename" m
+partFileName (ptContDispo → ContDispo {..})
+    = lookup "filename" dParams