New module: Network.HTTP.Lucu.MIMEType.TH

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

diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs
index 16d8f28017425e35fe0273e9c39e7326bea458a1..fd85eaf8f907bd506df0042b79dece95c386f85d 100644 (file)
--- a/Network/HTTP/Lucu/MultipartForm.hs
+++ b/Network/HTTP/Lucu/MultipartForm.hs
@@ -8,7 +8,7 @@
   , ViewPatterns
   #-}
 -- |Parse \"multipart/form-data\" based on RFC 2388:
--- <http://www.faqs.org/rfcs/rfc2388.html>
+-- <http://tools.ietf.org/html/rfc2388>
 --
 -- You usually don't have to use this module directly.
 module Network.HTTP.Lucu.MultipartForm
@@ -29,7 +29,6 @@ import qualified Data.ByteString.Lazy as LS
 import Data.ByteString.Lazy.Search
 import Data.Foldable
 import Data.List
-import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Monoid.Unicode
@@ -38,10 +37,10 @@ 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.Parser
 import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.RFC2231
 import Prelude.Unicode
 
 -- |'FormData' represents a form value and possibly an uploaded file
@@ -66,7 +65,7 @@ data Part
 data ContDispo
     = ContDispo {
         dType   ∷ !CIAscii
-      , dParams ∷ !(Map CIAscii Text)
+      , dParams ∷ !MIMEParams
       }
 
 printContDispo ∷ ContDispo → Ascii
@@ -85,10 +84,10 @@ printContDispo d
 --
 --   * \"Content-Transfer-Encoding\" is always ignored.
 --
---   * RFC 2388 says that non-ASCII field names are encoded according
---     to the method in RFC 2047
---     <http://www.faqs.org/rfcs/rfc2047.html>, but they won't be
---     decoded.
+--   * RFC 2388 (<http://tools.ietf.org/html/rfc2388#section-3>) says
+--   that non-ASCII field names are encoded according to the method in
+--   RFC 2047 (<http://tools.ietf.org/html/rfc2047>), but they won't
+--   be decoded.
 parseMultipartFormData ∷ Ascii -- ^boundary
                        → LS.ByteString -- ^input
                        → Either String [(Ascii, FormData)]
@@ -229,7 +228,7 @@ partToFormPair pt@(Part {..})
 partName ∷ MonadError String m ⇒ Part → m Ascii
 {-# INLINEABLE partName #-}
 partName (Part {..})
-    = case M.lookup "name" $ dParams ptContDispo of
+    = case M.lookup "name" params of
         Just name
             → case A.fromText name of
                  Just a  → return a
@@ -238,7 +237,10 @@ 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 (Part {..})
-    = M.lookup "filename" $ dParams ptContDispo
+partFileName (dParams ∘ ptContDispo → MIMEParams m)
+    = M.lookup "filename" m