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

View file

@ -2,6 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
@ -41,10 +42,10 @@ type StreamPost = Stream 'POST
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.
class ToStreamGenerator f a where
toStreamGenerator :: f a -> StreamGenerator a
class ToStreamGenerator a b | a -> b where
toStreamGenerator :: a -> StreamGenerator b
instance ToStreamGenerator StreamGenerator a
instance ToStreamGenerator (StreamGenerator a) a
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.