X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMultipartForm.hs;h=8d09d701fbe460a37059c6ed196e99b06d0f855d;hb=dfc7787;hp=db32a4cfa56484a92018911aef8dcdb325a50649;hpb=b923d454928e3d01134b15d6072b6d3edf7a15ca;p=Lucu.git diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs index db32a4c..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 #-} @@ -140,16 +138,6 @@ getContDispo hdr ]) contDispoP ∷ Parser ContDispo -contDispoP = try $ - do dispoType ← A.toCIAscii <$> token - params ← many paramP +contDispoP = do dispoType ← A.toCIAscii <$> token + 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)