34a0542 · typeable/wai

git.iko.soy/typeable/wai

Removed ResponseBody entirely

commit34a05427924aa203fc5a478081c6814baa3c5e45 authorMichael Snoyman <michael@snoyman.com> dateSun 24 Jan 2010, 02:20 (17 years ago) parent31a70e8

3 files changed+10−36

compare with master

unifiedsplit

Network/Wai.hs+1−26 Network/Wai/Handler/SimpleServer.hs+4−5 test.hs+5−5

Network/Wai.hs+1−26

@@ -16,15 +16,10 @@ module Network.Wai

1616 , Response (..)

1717 , Application

1818 , Middleware

19− , ResponseBody (..)

20− , ResponseBodyClass (..)

2119 ) where

2220

23−import qualified Data.ByteString.Lazy as L

2421import qualified Data.ByteString as B

2522import qualified Data.ByteString.Char8 as B8

26−import System.IO (withBinaryFile, IOMode (ReadMode), hIsEOF)

27−import Control.Monad (unless)

2823

2924-- | Please do not use the Show and Read instances for anything other than

3025-- debugging purposes. Instead, the 'methodFromBS' and 'methodToBS' provide a

@@ -108,29 +103,9 @@ data Response = Response

108103 { status :: Int

109104 , statusMessage :: B.ByteString

110105 , headers :: [(B.ByteString, B.ByteString)]

111− , body :: ResponseBody -> IO ()

106+ , body :: Either FilePath ((B.ByteString -> IO ()) -> IO ())

112107 }

113108

114109type Application = Request -> IO Response

115110

116111type Middleware = Application -> Application

117−

118−data ResponseBody = forall a. ResponseBodyClass a => ResponseBody a

119−class ResponseBodyClass a where

120− sendByteString :: a -> B.ByteString -> IO ()

121−

122− sendLazyByteString :: a -> L.ByteString -> IO ()

123− sendLazyByteString a bs = mapM_ (sendByteString a) $ L.toChunks bs

124−

125− sendFile :: a -> FilePath -> IO ()

126− sendFile a fp = withBinaryFile fp ReadMode helper where

127− helper h = do

128− eof <- hIsEOF h

129− unless eof $ do

130− b <- B.hGet h 1024 -- FIXME determine better block size

131− sendByteString a b

132− helper h

133−instance ResponseBodyClass ResponseBody where

134− sendByteString (ResponseBody a) = sendByteString a

135− sendLazyByteString (ResponseBody a) = sendLazyByteString a

136− sendFile (ResponseBody a) = sendFile a

Network/Wai/Handler/SimpleServer.hs+4−5

@@ -21,6 +21,7 @@ import Network.Wai

2121import qualified System.IO

2222

2323import qualified Data.ByteString as BS

24+import qualified Data.ByteString.Lazy as BL

2425import qualified Data.ByteString.Char8 as B8

2526import Network

2627 ( listenOn, accept, sClose, PortID(PortNumber), Socket

@@ -160,7 +161,9 @@ sendResponse h res = do

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

161162 mapM_ putHeader $ headers res

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

163− body res $ ResponseBody $ SSResponseBody h

164+ case body res of

165+ Left fp -> BL.readFile fp >>= BL.hPut h

166+ Right enum -> enum $ BS.hPut h

164167 where

165168 putHeader (x, y) = do

166169 BS.hPut h x

@@ -168,10 +171,6 @@ sendResponse h res = do

168171 BS.hPut h y

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

170173

171−newtype SSResponseBody = SSResponseBody Handle

172−instance ResponseBodyClass SSResponseBody where

173− sendByteString (SSResponseBody h) = BS.hPut h

174−

175174parseHeaderNoAttr :: StringLike a => a -> (a, a)

176175parseHeaderNoAttr s =

177176 let (k, rest) = SL.span (/= ':') s

test.hs+5−5

@@ -24,15 +24,15 @@ postResponse rb = return Response

2424 { status = 200

2525 , statusMessage = B8.pack "OK"

2626 , headers = [(B8.pack "Content-Type", B8.pack "text/plain")]

27− , body = postBody rb

27+ , body = Right $ postBody rb

2828 }

2929

30−index :: ResponseBody -> IO ()

31−index rb = sendFile rb "index.html"

30+index :: Either FilePath a

31+index = Left "index.html"

3232

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

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

3434postBody req res = do

3535 mbs <- req

3636 case mbs of

3737 Nothing -> return ()

38− Just bs -> sendByteString res bs >> postBody req res

38+ Just bs -> res bs >> postBody req res