@@ -5,63 +5,34 @@
55module Network.Wai.EventSource (
66 ServerEvent(..),
77 eventSourceAppChan,
8− eventSourceAppSource,
9− eventSourceAppIO,
10− sourceToSource
8+ eventSourceAppIO
119 ) where
1210
1311import Blaze.ByteString.Builder (Builder)
12+import Data.Function (fix)
1413import Control.Concurrent.Chan (Chan, dupChan, readChan)
1514import Control.Monad.IO.Class (liftIO)
16−import Data.Conduit
17−import qualified Data.Conduit.List as CL
1815import Network.HTTP.Types (status200)
19−import Network.Wai (Application, Response, responseSource)
16+import Network.Wai (Application, Response, responseStream)
2017
2118import Network.Wai.EventSource.EventStream
2219
2320-- | Make a new WAI EventSource application reading events from
2421-- the given channel.
2522eventSourceAppChan :: Chan ServerEvent -> Application
26−eventSourceAppChan chan _ = do
27− chan' <- liftIO $ dupChan chan
28− return $ response chanToSource chan'
29−
30−-- | Make a new WAI EventSource application reading events from
31−-- the given source.
32−eventSourceAppSource :: Source IO ServerEvent -> Application
33−eventSourceAppSource src _ = return $ response sourceToSource src
23+eventSourceAppChan chan req sendResponse = do
24+ chan' <- liftIO $ dupChan chan
25+ eventSourceAppIO (readChan chan') req sendResponse
3426
3527-- | Make a new WAI EventSource application reading events from
3628-- the given IO action.
3729eventSourceAppIO :: IO ServerEvent -> Application
38−eventSourceAppIO act _ = return $ response ioToSource act
39−
40−response :: (a -> Source IO (Flush Builder)) -> a -> Response
41−response f a = responseSource status200 [("Content-Type", "text/event-stream")] $ f a
42−
43−chanToSource :: Chan ServerEvent -> Source IO (Flush Builder)
44−chanToSource = ioToSource . readChan
45−
46−ioToSource :: IO ServerEvent -> Source IO (Flush Builder)
47−ioToSource act =
48− loop
49− where
50− loop = do
51− x <- liftIO act
52− case eventToBuilder x of
53− Nothing -> return ()
54− Just y -> do
55− yield $ Chunk y
56− yield Flush
57− loop
58−
59−-- | Convert a ServerEvent source into a Builder source of serialized
60−-- events.
61−sourceToSource :: Monad m => Source m ServerEvent -> Source m (Flush Builder)
62−sourceToSource src = src $= CL.concatMap eventToFlushBuilder
63− where
64− eventToFlushBuilder event =
65− case eventToBuilder event of
66− Nothing -> []
67− Just x -> [Chunk x, Flush]
30+eventSourceAppIO src _ sendResponse =
31+ sendResponse $ responseStream
32+ status200
33+ [("Content-Type", "text/event-stream")]
34+ $ \sendChunk flush -> fix $ \loop -> do
35+ se <- src
36+ case eventToBuilder se of
37+ Nothing -> return ()
38+ Just b -> sendChunk b >> flush >> loop