git.iko.soy/typeable/wai
on master help sign in
Removed ResponseBody entirely
34a0542Michael Snoyman
Network/Wai.hs+1−26
compare with master
unifiedsplit
@@ -16,15 +16,10 @@ module Network.Wai
16 , Response (..)
16 , Response (..)
17 , Application
17 , Application
18 , Middleware
18 , Middleware
19− , ResponseBody (..)
20− , ResponseBodyClass (..)
21 ) where
19 ) where
22
20
23−import qualified Data.ByteString.Lazy as L
24import qualified Data.ByteString as B
21import qualified Data.ByteString as B
25import qualified Data.ByteString.Char8 as B8
22import qualified Data.ByteString.Char8 as B8
26−import System.IO (withBinaryFile, IOMode (ReadMode), hIsEOF)
27−import Control.Monad (unless)
28
23
29-- | Please do not use the Show and Read instances for anything other than
24-- | Please do not use the Show and Read instances for anything other than
30-- debugging purposes. Instead, the 'methodFromBS' and 'methodToBS' provide a
25-- debugging purposes. Instead, the 'methodFromBS' and 'methodToBS' provide a
@@ -108,29 +103,9 @@ data Response = Response
108 { status :: Int
103 { status :: Int
109 , statusMessage :: B.ByteString
104 , statusMessage :: B.ByteString
110 , headers :: [(B.ByteString, B.ByteString)]
105 , headers :: [(B.ByteString, B.ByteString)]
111− , body :: ResponseBody -> IO ()
106+ , body :: Either FilePath ((B.ByteString -> IO ()) -> IO ())
112 }
107 }
113
108
114type Application = Request -> IO Response
109type Application = Request -> IO Response
115
110
116type Middleware = Application -> Application
111type 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
21import qualified System.IO
21import qualified System.IO
22
22
23import qualified Data.ByteString as BS
23import qualified Data.ByteString as BS
24+import qualified Data.ByteString.Lazy as BL
24import qualified Data.ByteString.Char8 as B8
25import qualified Data.ByteString.Char8 as B8
25import Network
26import Network
26 ( listenOn, accept, sClose, PortID(PortNumber), Socket
27 ( listenOn, accept, sClose, PortID(PortNumber), Socket
@@ -160,7 +161,9 @@ sendResponse h res = do
160 BS.hPut h $ SL.pack "\r\n"
161 BS.hPut h $ SL.pack "\r\n"
161 mapM_ putHeader $ headers res
162 mapM_ putHeader $ headers res
162 BS.hPut h $ SL.pack "\r\n"
163 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
164 where
167 where
165 putHeader (x, y) = do
168 putHeader (x, y) = do
166 BS.hPut h x
169 BS.hPut h x
@@ -168,10 +171,6 @@ sendResponse h res = do
168 BS.hPut h y
171 BS.hPut h y
169 BS.hPut h $ SL.pack "\r\n"
172 BS.hPut h $ SL.pack "\r\n"
170
173
171−newtype SSResponseBody = SSResponseBody Handle
172−instance ResponseBodyClass SSResponseBody where
173− sendByteString (SSResponseBody h) = BS.hPut h
174−
175parseHeaderNoAttr :: StringLike a => a -> (a, a)
174parseHeaderNoAttr :: StringLike a => a -> (a, a)
176parseHeaderNoAttr s =
175parseHeaderNoAttr s =
177 let (k, rest) = SL.span (/= ':') s
176 let (k, rest) = SL.span (/= ':') s
test.hs+5−5
@@ -24,15 +24,15 @@ postResponse rb = return Response
24 { status = 200
24 { status = 200
25 , statusMessage = B8.pack "OK"
25 , statusMessage = B8.pack "OK"
26 , headers = [(B8.pack "Content-Type", B8.pack "text/plain")]
26 , headers = [(B8.pack "Content-Type", B8.pack "text/plain")]
27− , body = postBody rb
27+ , body = Right $ postBody rb
28 }
28 }
29
29
30−index :: ResponseBody -> IO ()
30+index :: Either FilePath a
31−index rb = sendFile rb "index.html"
31+index = Left "index.html"
32
32
33−postBody :: IO (Maybe B.ByteString) -> ResponseBody -> IO ()
33+postBody :: IO (Maybe B.ByteString) -> (B.ByteString -> IO ()) -> IO ()
34postBody req res = do
34postBody req res = do
35 mbs <- req
35 mbs <- req
36 case mbs of
36 case mbs of
37 Nothing -> return ()
37 Nothing -> return ()
38− Just bs -> sendByteString res bs >> postBody req res
38+ Just bs -> res bs >> postBody req res