644bfda · typeable/wai

Network/Wai.hs+7−2

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−{-# LANGUAGE ExistentialQuantification #-}

1+{-# LANGUAGE Rank2Types #-}

2module Network.Wai

3 ( -- * Data types

4 -- ** Request method

@@ -23,6 +23,8 @@ module Network.Wai

23 , Status (..)

24 , statusCode

25 , statusMessage

26+ -- * Enumerator

27+ , Enumerator (..)

26 -- * WAI interface

28 -- * WAI interface

27 , Request (..)

29 , Request (..)

28 , Response (..)

30 , Response (..)

@@ -233,6 +235,9 @@ statusMessage Status405 = B8.pack "Method Not Allowed"

233statusMessage Status500 = B8.pack "Internal Server Error"

235statusMessage Status500 = B8.pack "Internal Server Error"

234statusMessage (Status _ m) = m

236statusMessage (Status _ m) = m

235

237

238+data Enumerator = Enumerator (forall a.

239+ ((a -> B.ByteString -> IO (Either a a)) -> a -> IO a))

240+

236data Request = Request

241data Request = Request

237 { requestMethod :: Method

242 { requestMethod :: Method

238 , httpVersion :: HttpVersion

243 , httpVersion :: HttpVersion

@@ -250,7 +255,7 @@ data Request = Request

250data Response = Response

255data Response = Response

251 { status :: Status

256 { status :: Status

252 , headers :: [(ResponseHeader, B.ByteString)]

257 , headers :: [(ResponseHeader, B.ByteString)]

253− , body :: Either FilePath ((B.ByteString -> IO ()) -> IO ())

258+ , body :: Either FilePath Enumerator

254 }

259 }

255

260

256type Application = Request -> IO Response

261type Application = Request -> IO Response

Network/Wai/Handler/SimpleServer.hs+2−1

@@ -167,8 +167,9 @@ sendResponse h res = do

167 BS.hPut h $ SL.pack "\r\n"

168 case body res of

169 Left fp -> unsafeSendFile h fp

170− Right enum -> enum $ BS.hPut h

170+ Right (Enumerator enum) -> enum myPut h >> return ()

171 where

172+ myPut h bs = BS.hPut h bs >> return (Right h)

172 putHeader (x, y) = do

173 putHeader (x, y) = do

173 BS.hPut h $ responseHeaderToBS x

174 BS.hPut h $ responseHeaderToBS x

174 BS.hPut h $ SL.pack ": "

175 BS.hPut h $ SL.pack ": "

test.hs+9−4

@@ -28,9 +28,14 @@ postResponse rb = return Response

28index :: Either FilePath a

29index = Left "index.html"

30

31−postBody :: IO (Maybe B.ByteString) -> (B.ByteString -> IO ()) -> IO ()

31+postBody :: IO (Maybe B.ByteString) -> Enumerator

32−postBody req res = do

32+postBody req = Enumerator $ \f a -> helper f a where

33+ helper f a = do

33 mbs <- req

34 mbs <- req

34 case mbs of

35 case mbs of

35− Nothing -> return ()

36+ Nothing -> return a

36− Just bs -> res bs >> postBody req res

37+ Just bs -> do

38+ res <- f a bs

39+ case res of

40+ Left a' -> return a'

41+ Right a' -> helper f a'