Change definition of StreamGenerator

This commit is contained in:
Jan van Brügge 2018-05-16 12:50:17 +02:00
parent 3e8c2170d1
commit 0ba09c999b
2 changed files with 15 additions and 14 deletions

View file

@ -284,10 +284,10 @@ instance OVERLAPPING_
instance OVERLAPPABLE_ instance OVERLAPPABLE_
( MimeRender ctype a, ReflectMethod method, ( MimeRender ctype a, ReflectMethod method,
FramingRender framing ctype, ToStreamGenerator f a FramingRender framing ctype, ToStreamGenerator b a
) => HasServer (Stream method framing ctype (f a)) context where ) => HasServer (Stream method framing ctype b) context where
type ServerT (Stream method framing ctype (f a)) m = m (f a) type ServerT (Stream method framing ctype b) m = m b
hoistServerWithContext _ _ nt s = nt s hoistServerWithContext _ _ nt s = nt s
route Proxy _ = streamRouter ([],) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype) route Proxy _ = streamRouter ([],) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
@ -295,23 +295,23 @@ instance OVERLAPPABLE_
instance OVERLAPPING_ instance OVERLAPPING_
( MimeRender ctype a, ReflectMethod method, ( MimeRender ctype a, ReflectMethod method,
FramingRender framing ctype, ToStreamGenerator f a, FramingRender framing ctype, ToStreamGenerator b a,
GetHeaders (Headers h (f a)) GetHeaders (Headers h b)
) => HasServer (Stream method framing ctype (Headers h (f a))) context where ) => HasServer (Stream method framing ctype (Headers h b)) context where
type ServerT (Stream method framing ctype (Headers h (f a))) m = m (Headers h (f a)) type ServerT (Stream method framing ctype (Headers h b)) m = m (Headers h b)
hoistServerWithContext _ _ nt s = nt s hoistServerWithContext _ _ nt s = nt s
route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype) route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
where method = reflectMethod (Proxy :: Proxy method) where method = reflectMethod (Proxy :: Proxy method)
streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator f a) => streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>
(b -> ([(HeaderName, B.ByteString)], f a)) (c -> ([(HeaderName, B.ByteString)], b))
-> Method -> Method
-> Proxy framing -> Proxy framing
-> Proxy ctype -> Proxy ctype
-> Delayed env (Handler b) -> Delayed env (Handler c)
-> Router env -> Router env
streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \env request respond -> streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \env request respond ->
let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request

View file

@ -2,6 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@ -38,13 +39,13 @@ type StreamGet = Stream 'GET
type StreamPost = Stream 'POST type StreamPost = Stream 'POST
-- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation). -- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation).
newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()} newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}
-- | ToStreamGenerator is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly as endpoints. -- | ToStreamGenerator is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly as endpoints.
class ToStreamGenerator f a where class ToStreamGenerator a b | a -> b where
toStreamGenerator :: f a -> StreamGenerator a toStreamGenerator :: a -> StreamGenerator b
instance ToStreamGenerator StreamGenerator a instance ToStreamGenerator (StreamGenerator a) a
where toStreamGenerator x = x where toStreamGenerator x = x
-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing. -- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.