on master help sign in
Allow stream bodies to have a result type
37fdcf8Andrew Pritchard
wai/Network/Wai/HTTP2.hs+7−6
@@ -1,3 +1,4 @@
1+{-# LANGUAGE RankNTypes #-}
1module Network.Wai.HTTP2
2module Network.Wai.HTTP2
2 ( Http2Application
3 ( Http2Application
3 , Response
4 , Response
@@ -17,17 +18,17 @@ import Network.Wai.Internal (Request)
17type Trailers = H.ResponseHeaders
18type Trailers = H.ResponseHeaders
18
19
19-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
20-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
20−type Http2Application = Request -> (Response -> IO ()) -> IO Trailers
21+type Http2Application = Request -> (forall a. Response a -> IO a) -> IO Trailers
21
22
22−type StreamingBody = (Builder -> IO ()) -> IO () -> IO ()
23+type StreamingBody a = (Builder -> IO ()) -> IO () -> IO a
23
24
24−type Response = (H.Status, H.ResponseHeaders, StreamingBody)
25+type Response a = (H.Status, H.ResponseHeaders, StreamingBody a)
25
26
26−responseStatus :: Response -> H.Status
27+responseStatus :: Response a -> H.Status
27responseStatus (s, _, _) = s
28responseStatus (s, _, _) = s
28
29
29−responseHeaders :: Response -> H.ResponseHeaders
30+responseHeaders :: Response a -> H.ResponseHeaders
30responseHeaders (_, h, _) = h
31responseHeaders (_, h, _) = h
31
32
32−responseStream :: H.Status -> H.ResponseHeaders -> StreamingBody -> Response
33+responseStream :: H.Status -> H.ResponseHeaders -> StreamingBody a -> Response a
33responseStream = (,,)
34responseStream = (,,)
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+11−7
@@ -1,4 +1,5 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE NamedFieldPuns #-}
3{-# LANGUAGE NamedFieldPuns #-}
3{-# LANGUAGE PatternGuards #-}
4{-# LANGUAGE PatternGuards #-}
4{-# LANGUAGE CPP #-}
5{-# LANGUAGE CPP #-}
@@ -31,11 +32,10 @@ import qualified Network.Wai.Handler.Warp.Timeout as T
31
32
32----------------------------------------------------------------
33----------------------------------------------------------------
33
34
34−-- | The wai definition is @type Http2Application = Request -> (Response -> IO ()) -> IO Trailers@.
35+-- | An 'Http2Application' takes a @forall a. Response a -> IO a@; this type
35−-- This type implements the second argument @Response -> IO ()@
36−-- with extra arguments.
36+-- implements that with extra arguments.
37−type Responder = ThreadContinue -> T.Handle -> Stream ->
37+type Responder = forall a. ThreadContinue -> T.Handle -> Stream ->
38− TBQueue Sequence -> Response -> IO ()
38+ TBQueue Sequence -> Response a -> IO a
39
39
40-- | This function is passed to workers.
40-- | This function is passed to workers.
41-- They also pass 'Response's from 'Http2Application's to this function.
41-- They also pass 'Response's from 'Http2Application's to this function.
@@ -70,8 +70,12 @@ data Break = Break deriving (Show, Typeable)
70
70
71instance Exception Break
71instance Exception Break
72
72
73−worker ::
73+worker :: Context
74+ -> S.Settings
75+ -> T.Manager
74− Context -> S.Settings -> T.Manager -> Http2Application -> Responder -> IO ()
76+ -> Http2Application
77+ -> Responder
78+ -> IO ()
75worker ctx@Context{inputQ,outputQ} set tm app responder = do
79worker ctx@Context{inputQ,outputQ} set tm app responder = do
76 tid <- myThreadId
80 tid <- myThreadId
77 sinfo <- newStreamInfo
81 sinfo <- newStreamInfo