+{-# LANGUAGE
+ UnboxedTuples
+ , UnicodeSyntax
+ #-}
module Network.HTTP.Lucu.MultipartForm
( FormData(..)
, multipartFormP
data Part = Part Headers L8.ByteString
--- |This data type represents a form entry name, form value and
--- possibly an uploaded file name.
+-- |This data type represents a form value and possibly an uploaded
+-- file name.
data FormData
= FormData {
- fdName :: String
- , fdFileName :: Maybe String
+ fdFileName :: Maybe String
, fdContent :: L8.ByteString
}
value
-multipartFormP :: String -> Parser [FormData]
+multipartFormP :: String -> Parser [(String, FormData)]
multipartFormP boundary
= do parts <- many (partP boundary)
- string "--"
- string boundary
- string "--"
- crlf
+ _ <- string "--"
+ _ <- string boundary
+ _ <- string "--"
+ _ <- crlf
eof
- return $ map partToFormData parts
+ return $ map partToFormPair parts
partP :: String -> Parser Part
partP boundary
- = do string "--"
- string boundary
- crlf -- バウンダリの末尾に -- が付いてゐたらここで fail する。
+ = do _ <- string "--"
+ _ <- string boundary
+ _ <- crlf -- バウンダリの末尾に -- が付いてゐたらここで fail する。
hs <- headersP
body <- bodyP boundary
return $ Part hs body
bodyP :: String -> Parser L8.ByteString
bodyP boundary
= do body <- manyChar $
- do notFollowedBy $ do crlf
- string "--"
- string boundary
+ do notFollowedBy $ ( crlf >>
+ string "--" >>
+ string boundary )
anyChar
- crlf
+ _ <- crlf
return body
-partToFormData :: Part -> FormData
-partToFormData part@(Part _ body)
+partToFormPair :: Part -> (String, FormData)
+partToFormPair part@(Part _ body)
= let name = partName part
- fName = partFileName part
- in
- FormData {
- fdName = name
- , fdFileName = fName
- , fdContent = body
- }
-
+ fname = partFileName part
+ fd = FormData {
+ fdFileName = fname
+ , fdContent = body
+ }
+ in (name, fd)
partName :: Part -> String
partName = getName' . getContDispoFormData
return $ ContDispo dispoType params
where
paramP :: Parser (String, String)
- paramP = do many lws
- char ';'
- many lws
- name <- token
- char '='
+ paramP = do _ <- many lws
+ _ <- char ';'
+ _ <- many lws
+ name <- token
+ _ <- char '='
value <- token <|> quotedStr
return (name, value)