module Network.Wai.EventSource (
ServerEvent(..),
eventSourceAppChan,
eventSourceAppSource,
eventSourceAppIO,
sourceToSource
) where
import Blaze.ByteString.Builder (Builder)
import Control.Concurrent.Chan (Chan, dupChan, readChan)
import Control.Monad.IO.Class (liftIO)
import Data.Conduit
import qualified Data.Conduit.List as CL
import Network.HTTP.Types (status200)
import Network.Wai (Application, Response, responseSource)
import Network.Wai.EventSource.EventStream
eventSourceAppChan :: Chan ServerEvent -> Application
eventSourceAppChan chan _ = do
chan' <- liftIO $ dupChan chan
return $ response chanToSource chan'
eventSourceAppSource :: Source IO ServerEvent -> Application
eventSourceAppSource src _ = return $ response sourceToSource src
eventSourceAppIO :: IO ServerEvent -> Application
eventSourceAppIO act _ = return $ response ioToSource act
response :: (a -> Source IO (Flush Builder)) -> a -> Response
response f a = responseSource status200 [("Content-Type", "text/event-stream")] $ f a
chanToSource :: Chan ServerEvent -> Source IO (Flush Builder)
chanToSource = ioToSource . readChan
ioToSource :: IO ServerEvent -> Source IO (Flush Builder)
ioToSource act =
loop
where
loop = do
x <- liftIO act
case eventToBuilder x of
Nothing -> return ()
Just y -> do
yield $ Chunk y
yield Flush
loop
sourceToSource :: Monad m => Source m ServerEvent -> Source m (Flush Builder)
sourceToSource src = src $= CL.concatMap eventToFlushBuilder
where
eventToFlushBuilder event =
case eventToBuilder event of
Nothing -> []
Just x -> [Chunk x, Flush]