)
where
import Control.Applicative hiding (many)
+import Control.Monad
import Data.Ascii (Ascii, CIAscii)
import qualified Data.Ascii as A
-import Data.Attoparsec.Char8
+import Data.Attoparsec
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LS
import Data.Map (Map)
import Data.Monoid.Unicode
import Data.Text (Text)
import Network.HTTP.Lucu.Headers
+import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.RFC2231
import Prelude.Unicode
multipartFormP ∷ Ascii → Parser [(Text, FormData)]
multipartFormP boundary
- = do parts ← many $ try $ partP boundary
- _ ← string "--"
- _ ← string $ A.toByteString boundary
- _ ← string "--"
+ = do void boundaryP
+ parts ← many $ partP boundaryP
+ void (string "--" <?> "suffix")
crlf
catMaybes <$> mapM partToFormPair parts
+ <?>
+ "multipartFormP"
+ where
+ boundaryP ∷ Parser BS.ByteString
+ boundaryP = string ("--" ⊕ A.toByteString boundary)
+ <?>
+ "boundaryP"
-partP ∷ Ascii → Parser Part
-partP boundary
- = do _ ← string "--"
- _ ← string $ A.toByteString boundary
- crlf
+partP ∷ Parser α → Parser Part
+partP boundaryP
+ = do crlf
hs ← headersP
d ← getContDispo hs
- body ← bodyP boundary
+ body ← bodyP boundaryP
return $ Part hs d body
+ <?>
+ "partP"
-bodyP ∷ Ascii → Parser LS.ByteString
-bodyP boundary
- = do body ← manyCharsTill anyChar $
- try $
- do crlf
- _ ← string "--"
- _ ← string $ A.toByteString boundary
- return ()
- crlf
- return body
+bodyP ∷ Parser α → Parser LS.ByteString
+bodyP boundaryP
+ = manyOctetsTill anyWord8 (try $ crlf *> boundaryP)
+ <?>
+ "bodyP"
partToFormPair ∷ Monad m ⇒ Part → m (Maybe (Text, FormData))
{-# INLINEABLE partToFormPair #-}
])
contDispoP ∷ Parser ContDispo
-contDispoP = do dispoType ← A.toCIAscii <$> token
- params ← paramsP
- return $ ContDispo dispoType params
+{-# INLINEABLE contDispoP #-}
+contDispoP
+ = do dispoType ← A.toCIAscii <$> token
+ params ← paramsP
+ return $ ContDispo dispoType params
+ <?>
+ "contDispoP"