Lucu 0.3.3 → 0.4
raw patch · 6 files changed
+88/−41 lines, 6 files
Files
- Lucu.cabal +1/−1
- NEWS +11/−1
- Network/HTTP/Lucu/MultipartForm.hs +4/−4
- Network/HTTP/Lucu/Parser.hs +66/−30
- Network/HTTP/Lucu/Resource.hs +1/−1
- examples/Multipart.hs +5/−4
Lucu.cabal view
@@ -8,7 +8,7 @@ messing around FastCGI. It is also intended to be run behind a reverse-proxy so it doesn't have some facilities like logging, client filtering or such like.-Version: 0.3.3+Version: 0.4 License: PublicDomain License-File: COPYING Author: PHO <pho at cielonegro dot org>
NEWS view
@@ -1,6 +1,16 @@+Changes from 0.3.3 to 0.4+-------------------------+* Network.HTTP.Lucu.Resource: (Thanks: Voker57)++ - Bugfix: inputForm was consuming too much memory. The memory+ usage is still somewhat high, but not insanely high.++ - Changed the type of FormData/fdContent from String to+ Lazy.ByteString. Sorry for frequent type changes.+ Changes from 0.3.2 to 0.3.3 ----------------------------* Network.HTTP.Lucu.Resource:+* Network.HTTP.Lucu.Resource: (Thanks: Voker57) - getQueryForm and inputForm now returns [FormData] instead of [(String, String)] to possibly include a name of uploaded file.
Network/HTTP/Lucu/MultipartForm.hs view
@@ -16,7 +16,7 @@ import Network.HTTP.Lucu.Utils -data Part = Part Headers String+data Part = Part Headers L8.ByteString -- |This data type represents a form entry name, form value and -- possibly an uploaded file name.@@ -24,7 +24,7 @@ = FormData { fdName :: String , fdFileName :: Maybe String- , fdContent :: String+ , fdContent :: L8.ByteString } instance HasHeaders Part where@@ -71,9 +71,9 @@ return $ Part hs body -bodyP :: String -> Parser String+bodyP :: String -> Parser L8.ByteString bodyP boundary- = do body <- many $+ = do body <- manyChar $ do notFollowedBy $ do crlf string "--" string boundary
Network/HTTP/Lucu/Parser.hs view
@@ -39,6 +39,7 @@ , hexDigit , notFollowedBy , many+ , manyChar , many1 , count , option@@ -55,6 +56,7 @@ import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as B hiding (ByteString) import qualified Data.Foldable as Fold+import Data.Int import qualified Data.Sequence as Seq import Data.Sequence (Seq, (|>)) @@ -88,8 +90,8 @@ return IllegalInput ReachedEOF -> do put saved -- 状態を復歸 return ReachedEOF- return x = x `seq` Parser $! return $! Success x- fail _ = Parser $! return $! IllegalInput+ return !x = Parser $! return $! Success x+ fail _ = Parser $! return $! IllegalInput -- |@'failP'@ is just a synonym for @'Prelude.fail' -- 'Prelude.undefined'@.@@ -99,17 +101,15 @@ -- |@'parse' p bstr@ parses @bstr@ with @p@ and returns @(# result, -- remaining #)@. parse :: Parser a -> Lazy.ByteString -> (# ParserResult a, Lazy.ByteString #)-parse p input -- input は lazy である必要有り。- = p `seq`- let (result, state') = runState (runParser p) (PST input True)+parse !p input -- input は lazy である必要有り。+ = let (!result, state') = runState (runParser p) (PST input True) in- result `seq` (# result, pstInput state' #) -- pstInput state' も lazy である必要有り。+ (# result, pstInput state' #) -- pstInput state' も lazy である必要有り。 -- |@'parseStr' p str@ packs @str@ and parses it. parseStr :: Parser a -> String -> (# ParserResult a, Lazy.ByteString #)-parseStr p input- = p `seq` -- input は lazy である必要有り。- parse p (B.pack input)+parseStr !p input -- input は lazy である必要有り。+ = parse p (B.pack input) anyChar :: Parser Char@@ -132,16 +132,16 @@ -- |@'allowEOF' p@ makes @p@ treat reaching EOF a normal failure. allowEOF :: Parser a -> Parser a-allowEOF f = f `seq`- Parser $! do saved@(PST _ isEOFFatal) <- get- put $! saved { pstIsEOFFatal = False }+allowEOF !f+ = Parser $! do saved@(PST _ isEOFFatal) <- get+ put $! saved { pstIsEOFFatal = False } - result <- runParser f+ result <- runParser f - state <- get- put $! state { pstIsEOFFatal = isEOFFatal }+ state <- get+ put $! state { pstIsEOFFatal = isEOFFatal } - return result+ return result satisfy :: (Char -> Bool) -> Parser Char@@ -158,9 +158,22 @@ string :: String -> Parser String-string !str = str `seq`- do mapM_ char str- return str+string !str+ = let bs = B.pack str+ len = B.length bs+ in+ Parser $!+ do st <- get+ let (bs', rest) = B.splitAt len $ pstInput st+ st' = st { pstInput = rest }+ if B.length bs' < len then+ return ReachedEOF+ else+ if bs == bs' then+ do put st'+ return $ Success str+ else+ return IllegalInput infixr 0 <|>@@ -168,9 +181,8 @@ -- |This is the backtracking alternation. There is no non-backtracking -- equivalent. (<|>) :: Parser a -> Parser a -> Parser a-f <|> g- = f `seq` g `seq`- Parser $! do saved <- get -- 状態を保存+(!f) <|> (!g)+ = Parser $! do saved <- get -- 状態を保存 result <- runParser f case result of Success a -> return $! Success a@@ -240,7 +252,33 @@ else (# Success (Fold.toList soFar), st #) +manyChar :: Parser Char -> Parser Lazy.ByteString+manyChar !p = Parser $!+ do state <- get+ case scan' state 0 of+ Success len+ -> do let (bs, rest) = B.splitAt len (pstInput state)+ state' = state { pstInput = rest }+ put state'+ return $ Success bs+ ReachedEOF+ -> if pstIsEOFFatal state then+ return ReachedEOF+ else+ error "internal error"+ _ -> error "internal error"+ where+ scan' :: ParserState -> Int64 -> ParserResult Int64+ scan' !st !soFar+ = case runState (runParser p) st of+ (Success _ , st') -> scan' st' (soFar + 1)+ (IllegalInput, _ ) -> Success soFar+ (ReachedEOF , _ ) -> if pstIsEOFFatal st then+ ReachedEOF+ else+ Success soFar + many1 :: Parser a -> Parser [a] many1 !p = do x <- p xs <- many p@@ -266,20 +304,18 @@ -- def may be a _|_ option :: a -> Parser a -> Parser a-option def p = p `seq`- p <|> return def+option def !p = p <|> return def sepBy :: Parser a -> Parser sep -> Parser [a]-sepBy p sep = p `seq` sep `seq`- sepBy1 p sep <|> return []+sepBy !p !sep = sepBy1 p sep <|> return [] sepBy1 :: Parser a -> Parser sep -> Parser [a]-sepBy1 p sep = p `seq` sep `seq`- do x <- p- xs <- many $! sep >> p- return (x:xs)+sepBy1 !p !sep+ = do x <- p+ xs <- many $! sep >> p+ return (x:xs) sp :: Parser Char
Network/HTTP/Lucu/Resource.hs view
@@ -312,7 +312,7 @@ = FormData { fdName = name , fdFileName = Nothing- , fdContent = value+ , fdContent = L8.pack value } -- |Get a value of given request header. Comparison of header name is
examples/Multipart.hs view
@@ -1,3 +1,4 @@+import qualified Data.ByteString.Lazy.Char8 as L8 import Data.List import Data.Maybe import Network@@ -28,12 +29,12 @@ , resHead = Nothing , resPost = Just $ do form <- inputForm defaultLimit- let text = fromMaybe "" $ fmap fdContent $ find ((== "text") . fdName) form- file = fromMaybe "" $ fmap fdContent $ find ((== "file") . fdName) form+ let text = fromMaybe L8.empty $ fmap fdContent $ find ((== "text") . fdName) form+ file = fromMaybe L8.empty $ fmap fdContent $ find ((== "file") . fdName) form fileName = fdFileName =<< find ((== "file") . fdName) form setContentType $ read "text/plain"- outputChunk ("You entered \"" ++ text ++ "\".\n")- outputChunk ("You uploaded a " ++ show (length file) ++ " bytes long file.\n")+ outputChunk ("You entered \"" ++ L8.unpack text ++ "\".\n")+ outputChunk ("You uploaded a " ++ show (L8.length file) ++ " bytes long file.\n") output ("The file name is " ++ show fileName ++ ".\n") , resPut = Nothing , resDelete = Nothing