module Network.Wai.EventSource (
ServerEvent(..),
eventSourceAppChan,
eventSourceAppIO,
eventStreamAppRaw
) where
import Data.Function (fix)
import Control.Concurrent.Chan (Chan, dupChan, readChan)
import Control.Monad.IO.Class (liftIO)
import Network.HTTP.Types (status200, hContentType)
import Network.Wai (Application, responseStream)
import Network.Wai.EventSource.EventStream
eventSourceAppChan :: Chan ServerEvent -> Application
eventSourceAppChan :: Chan ServerEvent -> Application
eventSourceAppChan chan :: Chan ServerEvent
chan req :: Request
req sendResponse :: Response -> IO ResponseReceived
sendResponse = do
Chan ServerEvent
chan' <- IO (Chan ServerEvent) -> IO (Chan ServerEvent)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chan ServerEvent) -> IO (Chan ServerEvent))
-> IO (Chan ServerEvent) -> IO (Chan ServerEvent)
forall a b. (a -> b) -> a -> b
$ Chan ServerEvent -> IO (Chan ServerEvent)
forall a. Chan a -> IO (Chan a)
dupChan Chan ServerEvent
chan
IO ServerEvent -> Application
eventSourceAppIO (Chan ServerEvent -> IO ServerEvent
forall a. Chan a -> IO a
readChan Chan ServerEvent
chan') Request
req Response -> IO ResponseReceived
sendResponse
eventSourceAppIO :: IO ServerEvent -> Application
eventSourceAppIO :: IO ServerEvent -> Application
eventSourceAppIO src :: IO ServerEvent
src _ sendResponse :: Response -> IO ResponseReceived
sendResponse =
Response -> IO ResponseReceived
sendResponse (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> StreamingBody -> Response
responseStream
Status
status200
[(HeaderName
hContentType, "text/event-stream")]
(StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \sendChunk :: Builder -> IO ()
sendChunk flush :: IO ()
flush -> do
IO ()
flush
(IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \loop :: IO ()
loop -> do
ServerEvent
se <- IO ServerEvent
src
case ServerEvent -> Maybe Builder
eventToBuilder ServerEvent
se of
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just b :: Builder
b -> Builder -> IO ()
sendChunk Builder
b IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
flush IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
loop
eventStreamAppRaw :: ((ServerEvent -> IO()) -> IO () -> IO ()) -> Application
eventStreamAppRaw :: ((ServerEvent -> IO ()) -> IO () -> IO ()) -> Application
eventStreamAppRaw handler :: (ServerEvent -> IO ()) -> IO () -> IO ()
handler _ sendResponse :: Response -> IO ResponseReceived
sendResponse =
Response -> IO ResponseReceived
sendResponse (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> StreamingBody -> Response
responseStream
Status
status200
[(HeaderName
hContentType, "text/event-stream")]
(StreamingBody -> Response) -> StreamingBody -> Response
forall a b. (a -> b) -> a -> b
$ \sendChunk :: Builder -> IO ()
sendChunk flush :: IO ()
flush -> (ServerEvent -> IO ()) -> IO () -> IO ()
handler ((Builder -> IO ()) -> ServerEvent -> IO ()
forall (m :: * -> *).
Monad m =>
(Builder -> m ()) -> ServerEvent -> m ()
sendEvent Builder -> IO ()
sendChunk) IO ()
flush
where
sendEvent :: (Builder -> m ()) -> ServerEvent -> m ()
sendEvent sendChunk :: Builder -> m ()
sendChunk event :: ServerEvent
event =
case ServerEvent -> Maybe Builder
eventToBuilder ServerEvent
event of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just b :: Builder
b -> Builder -> m ()
sendChunk Builder
b