X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=8d09d701fbe460a37059c6ed196e99b06d0f855d;hp=7ddcbd0f707e144a2ed450a053ee32fd0566d7fd;hb=dfc778742934b8f2ac6a6709741c79ecd40c5ff1;hpb=4498b6a9091bebb38a92a730b7abff40833e3ed2 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)