git.iko.soy/typeable/wai
on master help sign in
Merge pull request #50 from maoe/feature/eventsource-other-interfaces

Add new API for EventSource

commit0c9354608e71f7ae144f6081f8b8ca5b7d58b59b authorMichael Snoyman <michael@snoyman.com> dateMon 13 Feb 2012, 03:04 (15 years ago) parent458c95cb7a08aa
2 files changed+74−13
compare with master
unifiedsplit
wai-eventsource/src/Main.hs+27−6 wai-eventsource/src/Network/Wai/EventSource.hs+47−7
wai-eventsource/src/Main.hs+27−6
@@ -3,6 +3,7 @@ module Main where
33
44import Control.Monad
55import Control.Concurrent (forkIO, threadDelay)
6+import Control.Monad.Trans (liftIO)
67import Control.Concurrent.Chan
78import Network.Wai.Handler.Warp (run)
89import Network.Wai.Middleware.Gzip (gzip, def)
@@ -10,6 +11,7 @@ import Network.Wai
1011import Network.HTTP.Types (statusOK)
1112import Data.Time.Clock.POSIX
1213import Blaze.ByteString.Builder.Char.Utf8 (fromString)
14+import qualified Data.Conduit as C
1315
1416import Network.Wai.EventSource
1517
@@ -17,19 +19,38 @@ app :: Chan ServerEvent -> Application
1719app chan req =
1820 case pathInfo req of
1921 [] -> return $ ResponseFile statusOK [("Content-Type", "text/html")] "static/index.html" Nothing
20− ["es"] -> eventSourceApp chan req
22+ ["esold"] -> eventSourceApp chan req
23+ ["eschan"] -> eventSourceAppChan chan req
24+ ["esio"] -> eventSourceAppIO eventIO req
25+ ["essrc"] -> eventSourceAppSource eventSource req
2126 _ -> error "unexpected pathInfo"
2227
23−
24−source :: Chan ServerEvent -> IO ()
25−source chan = forever $ do
28+eventChan :: Chan ServerEvent -> IO ()
29+eventChan chan = forever $ do
2630 threadDelay 1000000
2731 time <- getPOSIXTime
2832 writeChan chan (ServerEvent Nothing Nothing [fromString . show $ time])
2933
34+eventIO :: IO ServerEvent
35+eventIO = do
36+ threadDelay 1000000
37+ time <- getPOSIXTime
38+ return $ ServerEvent (Just $ fromString "io")
39+ Nothing
40+ [fromString . show $ time]
41+
42+eventSource :: C.Source IO ServerEvent
43+eventSource = C.sourceState () (const pull)
44+ where
45+ pull = do
46+ time <- liftIO $ do
47+ threadDelay 1000000
48+ getPOSIXTime
49+ return $ C.StateOpen () $ ServerEvent (Just $ fromString "source")
50+ Nothing
51+ [fromString . show $ time]
3052
31−main :: IO ()
3253main = do
3354 chan <- newChan
34− _ <- forkIO . source $ chan
55+ _ <- forkIO . eventChan $ chan
3556 run 8000 (gzip def $ app chan)
wai-eventsource/src/Network/Wai/EventSource.hs+47−7
@@ -1,13 +1,18 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Network.Wai.EventSource (
33 ServerEvent(..),
4− eventSourceApp
4+ eventSourceApp,
5+ eventSourceAppChan,
6+ eventSourceAppSource,
7+ eventSourceAppIO
58 ) where
69
710import Blaze.ByteString.Builder (Builder)
811import Control.Concurrent.Chan (Chan, dupChan, readChan)
912import Control.Monad.IO.Class (liftIO)
13+import Data.Conduit (($=))
1014import qualified Data.Conduit as C
15+import qualified Data.Conduit.List as CL
1116import Network.HTTP.Types (statusOK)
1217import Network.Wai (Application, Response(..))
1318
@@ -16,15 +21,31 @@ import Network.Wai.EventSource.EventStream
1621-- | Make a new WAI EventSource application reading events from
1722-- the given channel.
1823eventSourceApp :: Chan ServerEvent -> Application
19−eventSourceApp chan _ = do
24+eventSourceApp = eventSourceAppChan
25+{-# DEPRECATED eventSourceApp "Use evnetSourceAppChan instead." #-}
26+
27+-- | Make a new WAI EventSource application reading events from
28+-- the given channel.
29+eventSourceAppChan :: Chan ServerEvent -> Application
30+eventSourceAppChan chan _ = do
2031 chan' <- liftIO $ dupChan chan
21− return $ res chan'
32+ return $ response chanToSource chan'
2233
23−res :: Chan ServerEvent -> Response
24−res chan = ResponseSource statusOK [("Content-Type", "text/event-stream")] $ resE chan
34+-- | Make a new WAI EventSource application reading events from
35+-- the given source.
36+eventSourceAppSource :: C.Source IO ServerEvent -> Application
37+eventSourceAppSource src _ = return $ response sourceToSource src
2538
26−resE :: Chan ServerEvent -> C.Source IO (C.Flush Builder)
27−resE chan =
39+-- | Make a new WAI EventSource application reading events from
40+-- the given IO action.
41+eventSourceAppIO :: IO ServerEvent -> Application
42+eventSourceAppIO act _ = return $ response ioToSource act
43+
44+response :: (a -> C.Source IO (C.Flush Builder)) -> a -> Response
45+response f a = ResponseSource statusOK [("Content-Type", "text/event-stream")] $ f a
46+
47+chanToSource :: Chan ServerEvent -> C.Source IO (C.Flush Builder)
48+chanToSource chan =
2849 C.sourceState Nothing pull
2950 where
3051 pull Nothing = do
@@ -33,3 +54,22 @@ resE chan =
3354 Nothing -> C.StateClosed
3455 Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)
3556 pull (Just x) = return $ C.StateOpen Nothing x
57+
58+ioToSource :: IO ServerEvent -> C.Source IO (C.Flush Builder)
59+ioToSource act =
60+ C.sourceState Nothing pull
61+ where
62+ pull Nothing = do
63+ x <- liftIO act
64+ return $ case eventToBuilder x of
65+ Nothing -> C.StateClosed
66+ Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)
67+ pull (Just x) = return $ C.StateOpen Nothing x
68+
69+sourceToSource :: C.Source IO ServerEvent -> C.Source IO (C.Flush Builder)
70+sourceToSource src = src $= CL.concatMap eventToFlushBuilder
71+ where
72+ eventToFlushBuilder event =
73+ case eventToBuilder event of
74+ Nothing -> []
75+ Just x -> [C.Chunk x, C.Flush]