on master help sign in
More efficient chunk functions
commit5672e6b32d68664392592247d4361d9b7361e308 authorMichael Snoyman <michael@snoyman.com> dateWed 15 Dec 2010, 19:29 (16 years ago) parent47f1ebe
2 files changed+13−6
Network/Wai/Handler/SimpleServer.hs+11−4 proxy.hs+2−2
Network/Wai/Handler/SimpleServer.hs+11−4
@@ -41,12 +41,13 @@ import Data.Typeable (Typeable)
4141import Control.Arrow (first)
4242import Numeric (showHex)
4343
44−import Data.Enumerator (($$), Enumerator, enumList)
44+import Data.Enumerator (($$), Enumerator, enumList, (>>==))
4545import qualified Data.Enumerator as E
4646import Data.Enumerator.IO (iterHandle)
4747import Control.Monad.IO.Class (liftIO)
4848import Blaze.ByteString.Builder.Enumerator (builderToByteString)
49−import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding)
49+import Blaze.ByteString.Builder.HTTP
50+ (chunkedTransferEncoding, chunkedTransferTerminator)
5051import Blaze.ByteString.Builder (fromByteString, Builder, toLazyByteString)
5152import Blaze.ByteString.Builder.Char8 (fromChar)
5253import Data.Monoid (mconcat)
@@ -181,11 +182,17 @@ sendResponse hv handle res = do
181182 responseEnumerator res $ \s hs -> do
182183 liftIO $ L.hPutStr handle $ toLazyByteString $ headers hv s hs
183184 i <- E.joinI $ chunk $$ E.joinI $ builderToByteString $$ iterHandle handle
184− liftIO $ B.hPutStr handle "0\r\n\r\n"
185+ liftIO $ B.hPutStr handle "\r\n"
185186 return i
186187 where
187188 chunk :: E.Enumeratee Builder Builder IO ()
188− chunk = E.map chunkedTransferEncoding -- FIXME some extra mconcat
189+ chunk = E.checkDone $ E.continue . step
190+ step k E.EOF = k (E.Chunks [chunkedTransferTerminator]) >>== return
191+ step k (E.Chunks []) = E.continue $ step k
192+ step k (E.Chunks builders) =
193+ k (E.Chunks [chunked]) >>== chunk
194+ where
195+ chunked = chunkedTransferEncoding $ mconcat builders
189196
190197parseHeaderNoAttr :: ByteString -> (ByteString, ByteString)
191198parseHeaderNoAttr s =
proxy.hs+2−2
@@ -11,7 +11,7 @@ import qualified Data.Enumerator as E
1111main :: IO ()
1212main = run 3000 app
1313
14−app :: W.Application
14+app :: W.Application a
1515app W.Request { W.pathInfo = path } =
1616 case H.parseUrl $ "http://wiki.yesodweb.com" ++ S8.unpack path of
1717 Nothing -> return notFound
@@ -20,5 +20,5 @@ app W.Request { W.pathInfo = path } =
2020 go f s h = joinI $ E.map fromByteString $$ f s $ filter safe h
2121 safe (x, _) = not $ x `elem` ["Content-Encoding", "Transfer-Encoding"]
2222
23−notFound :: W.Response
23+notFound :: W.Response a
2424notFound = W.ResponseLBS W.status404 [("Content-Type", "text/plain")] "Not found"