]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/MultipartForm.hs
Destroy Data.Attoparsec.Parsable; use Data.Default instead
[Lucu.git] / Network / HTTP / Lucu / MultipartForm.hs
index 2d1b3470f1cf62a797a1336c183e8d54999589b9..98699e43ca37d2e2a2978236130f50b6a705c04a 100644 (file)
@@ -33,6 +33,7 @@ import Data.Collections
 import Data.Convertible.Base
 import Data.Convertible.Instances.Ascii ()
 import Data.Convertible.Utils
+import Data.Default
 import Data.List (intercalate)
 import Data.Maybe
 import Data.Monoid.Unicode
@@ -40,9 +41,7 @@ import Data.Sequence (Seq)
 import Data.Text (Text)
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.MIMEParams
-import Network.HTTP.Lucu.MIMEType (MIMEType)
-import qualified Network.HTTP.Lucu.MIMEType as MT
-import Network.HTTP.Lucu.MIMEType.TH
+import Network.HTTP.Lucu.MIMEType
 import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.Utils
@@ -87,8 +86,8 @@ deriveAttempts [ ([t| ContDispo |], [t| Ascii        |])
                , ([t| ContDispo |], [t| AsciiBuilder |])
                ]
 
--- |Parse \"multipart/form-data\" and return either @'Left' err@ or
--- @'Right' result@. Note that there are currently the following
+-- |Parse \"multipart/form-data\" to a list of @(name,
+-- formData)@. Note that there are currently the following
 -- limitations:
 --
 --   * Multiple files embedded as \"multipart/mixed\" within the
@@ -97,9 +96,9 @@ deriveAttempts [ ([t| ContDispo |], [t| Ascii        |])
 --   * \"Content-Transfer-Encoding\" is always ignored.
 --
 --   * 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.
+--     that non-ASCII field names are encoded according to the method
+--     in RFC 2047 (<http://tools.ietf.org/html/rfc2047>), but this
+--     function currently doesn't decode them.
 parseMultipartFormData ∷ Ascii -- ^boundary
                        → LS.ByteString -- ^input
                        → Either String [(Ascii, FormData)]
@@ -170,7 +169,8 @@ parsePart boundary src
         defaultCType = [mimeType| text/plain |]
 
 partHeader ∷ Parser Headers
-partHeader = crlf *> headers
+{-# INLINE partHeader #-}
+partHeader = crlf *> def
 
 getContDispo ∷ MonadError String m ⇒ Headers → m ContDispo
 {-# INLINEABLE getContDispo #-}
@@ -187,8 +187,9 @@ getContDispo hdrs
                                        ⊕ err
 
 contentDisposition ∷ Parser ContDispo
+{-# INLINEABLE contentDisposition #-}
 contentDisposition
-    = (ContDispo <$> (cs <$> token) ⊛ mimeParams)
+    = (ContDispo <$> (cs <$> token) ⊛ def)
       <?>
       "contentDisposition"
 
@@ -199,7 +200,7 @@ getContType hdrs
         Nothing
             → return Nothing
         Just str
-            → case parseOnly (finishOff MT.mimeType) $ cs str of
+            → case parseOnly (finishOff def) $ cs str of
                  Right  d → return $ Just d
                  Left err → throwError $ "malformed Content-Type: "
                                        ⊕ cs str